Commit | Line | Data |
---|---|---|
2cb842ae KH |
1 | ;;; ps-mule.el --- Provide multi-byte character facility to ps-print. |
2 | ||
3 | ;; Copyright (C) 1998 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br> | |
6 | ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) | |
7 | ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters) | |
8 | ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br> | |
9 | ;; Keywords: print, PostScript, multibyte, mule | |
10 | ;; Time-stamp: <98/12/15 14:04:50 handa> | |
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 | |
16 | ;; the Free Software Foundation; either version 2, or (at your option) | |
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 | |
26 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
27 | ;; Boston, MA 02111-1307, USA. | |
28 | ||
29 | ;;; Commentary: | |
30 | ||
31 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
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 | ;; | |
49 | ;; nil This is the value to use when you are printing | |
50 | ;; buffer with only ASCII and Latin characters. | |
51 | ;; | |
52 | ;; `non-latin-printer' This is the value to use when you have a japanese | |
53 | ;; or korean PostScript printer and want to print | |
54 | ;; buffer with ASCII, Latin-1, Japanese (JISX0208 and | |
55 | ;; JISX0201-Kana) and Korean characters. At present, | |
56 | ;; it was not tested the Korean characters printing. | |
57 | ;; If you have a korean PostScript printer, please, | |
58 | ;; test it. | |
59 | ;; | |
60 | ;; `bdf-font' This is the value to use when you want to print | |
61 | ;; buffer with BDF fonts. BDF fonts include both latin | |
62 | ;; and non-latin fonts. BDF (Bitmap Distribution | |
63 | ;; Format) is a format used for distributing X's font | |
64 | ;; source file. BDF fonts are included in | |
65 | ;; `intlfonts-1.1' which is a collection of X11 fonts | |
66 | ;; for all characters supported by Emacs. In order to | |
67 | ;; use this value, be sure to have installed | |
68 | ;; `intlfonts-1.1' and set the variable | |
69 | ;; `bdf-directory-list' appropriately (see ps-bdf.el | |
70 | ;; for documentation of this variable). | |
71 | ;; | |
72 | ;; `bdf-font-except-latin' This is like `bdf-font' except that it is used | |
73 | ;; PostScript default fonts to print ASCII and Latin-1 | |
74 | ;; characters. This is convenient when you want or | |
75 | ;; need to use both latin and non-latin characters on | |
76 | ;; the same buffer. See `ps-font-family', | |
77 | ;; `ps-header-font-family' and `ps-font-info-database'. | |
78 | ;; | |
79 | ;; Any other value is treated as nil. | |
80 | ;; | |
81 | ;; The default is nil. | |
82 | ;; | |
83 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
84 | ||
85 | ;;; Code: | |
86 | ||
87 | (eval-and-compile (require 'ps-print)) | |
88 | ||
89 | ;;;###autoload | |
90 | (defcustom ps-multibyte-buffer nil | |
91 | "*Specifies the multi-byte buffer handling. | |
92 | ||
93 | Valid values are: | |
94 | ||
00cbf820 KH |
95 | nil This is the value to use the default settings which |
96 | is by default for printing buffer with only ASCII | |
97 | and Latin characters. The default setting can be | |
98 | changed by setting the variable | |
99 | `ps-mule-font-info-database-default' differently. | |
100 | The initial value of this variable is | |
101 | `ps-mule-font-info-database-latin' (which see). | |
102 | ||
103 | `non-latin-printer' This is the value to use when you have a Japanese | |
104 | or Korean PostScript printer and want to print | |
2cb842ae KH |
105 | buffer with ASCII, Latin-1, Japanese (JISX0208 and |
106 | JISX0201-Kana) and Korean characters. At present, | |
107 | it was not tested the Korean characters printing. | |
108 | If you have a korean PostScript printer, please, | |
109 | test it. | |
110 | ||
111 | `bdf-font' This is the value to use when you want to print | |
112 | buffer with BDF fonts. BDF fonts include both latin | |
113 | and non-latin fonts. BDF (Bitmap Distribution | |
114 | Format) is a format used for distributing X's font | |
115 | source file. BDF fonts are included in | |
116 | `intlfonts-1.1' which is a collection of X11 fonts | |
117 | for all characters supported by Emacs. In order to | |
118 | use this value, be sure to have installed | |
119 | `intlfonts-1.1' and set the variable | |
120 | `bdf-directory-list' appropriately (see ps-bdf.el for | |
121 | documentation of this variable). | |
122 | ||
123 | `bdf-font-except-latin' This is like `bdf-font' except that it is used | |
124 | PostScript default fonts to print ASCII and Latin-1 | |
125 | characters. This is convenient when you want or | |
126 | need to use both latin and non-latin characters on | |
127 | the same buffer. See `ps-font-family', | |
128 | `ps-header-font-family' and `ps-font-info-database'. | |
129 | ||
130 | Any other value is treated as nil." | |
131 | :type '(choice (const non-latin-printer) (const bdf-font) | |
132 | (const bdf-font-except-latin) (other :tag "nil" nil)) | |
133 | :group 'ps-print-font) | |
134 | ||
135 | ;; For Emacs 20.2 and the earlier version. | |
136 | (eval-and-compile | |
137 | (if (not (string< mule-version "4.0")) | |
138 | (progn | |
139 | (defalias 'ps-mule-next-point '1+) | |
140 | (defalias 'ps-mule-chars-in-string 'length) | |
141 | (defalias 'ps-mule-string-char 'aref) | |
142 | (defsubst ps-mule-next-index (str i) (1+ i))) | |
143 | (defun ps-mule-next-point (arg) | |
144 | (save-excursion (goto-char arg) (forward-char 1) (point))) | |
145 | (defun ps-mule-chars-in-string (string) | |
146 | (/ (length string) | |
147 | (charset-bytes (char-charset (string-to-char string))))) | |
148 | (defun ps-mule-string-char (string idx) | |
149 | (string-to-char (substring string idx))) | |
150 | (defun ps-mule-next-index (string i) | |
151 | (+ i (charset-bytes (char-charset (string-to-char string)))))) | |
152 | ) | |
153 | ||
154 | (defvar ps-mule-font-info-database | |
155 | nil | |
156 | "Alist of charsets with the corresponding font information. | |
157 | Each element has the form: | |
158 | ||
159 | (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...) | |
160 | ||
161 | Where | |
162 | ||
163 | CHARSET is a charset (symbol) for this font family, | |
164 | ||
165 | FONT-TYPE is a font type: normal, bold, italic, or bold-italic. | |
166 | ||
167 | FONT-SRC is a font source: builtin, ps-bdf, vflib, or nil. | |
168 | ||
169 | If FONT-SRC is builtin, FONT-NAME is a buitin PostScript font name. | |
170 | ||
5d5bea97 EZ |
171 | If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of |
172 | alternative font names. To use this font, the external library `ps-bdf' | |
173 | is required. | |
2cb842ae KH |
174 | |
175 | If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows. | |
176 | To use this font, the external library `vflib' is required. | |
177 | ||
178 | If FONT-SRC is nil, a proper ASCII font in the variable | |
179 | `ps-font-info-database' is used. This is useful for Latin-1 characters. | |
180 | ||
181 | ENCODING is a coding system to encode a string of characters of CHARSET into a | |
182 | proper string matching an encoding of the specified font. ENCODING may be a | |
183 | function that does this encoding. In this case, the function is called with | |
184 | one argument, the string to encode, and it should return an encoded string. | |
185 | ||
186 | BYTES specifies how many bytes each character has in the encoded byte | |
187 | sequence; it should be 1 or 2. | |
188 | ||
189 | All multi-byte characters are printed by fonts specified in this database | |
190 | regardless of a font family of ASCII characters. The exception is Latin-1 | |
191 | characters which are printed by the same font as ASCII characters, thus obey | |
192 | font family. | |
193 | ||
194 | See also the variable `ps-font-info-database'.") | |
195 | ||
196 | (defconst ps-mule-font-info-database-latin | |
197 | '((latin-iso8859-1 | |
198 | (normal nil nil iso-latin-1))) | |
199 | "Sample setting of `ps-mule-font-info-database' to use latin fonts.") | |
200 | ||
00cbf820 KH |
201 | (defvar ps-mule-font-info-database-default |
202 | ps-mule-font-info-database-default | |
203 | "The default setting to use if `ps-multibyte-buffer' (which see) is nil.") | |
204 | ||
2cb842ae KH |
205 | (defconst ps-mule-font-info-database-ps |
206 | '((katakana-jisx0201 | |
207 | (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1) | |
208 | (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1) | |
209 | (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)) | |
210 | (latin-jisx0201 | |
211 | (normat builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1) | |
212 | (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1)) | |
213 | (japanese-jisx0208 | |
214 | (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2) | |
215 | (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2)) | |
216 | (korean-ksc5601 | |
217 | (normal builtin "Batang-Medium-KSC-H" ps-mule-encode-7bit 2) | |
218 | (bold builtin " Gulim-Medium-KSC-H" ps-mule-encode-7bit 2)) | |
219 | ) | |
220 | "Sample setting of the `ps-mule-font-info-database' to use builtin PS font. | |
221 | ||
222 | Currently, data for Japanese and Korean PostScript printers are listed.") | |
223 | ||
224 | (defconst ps-mule-font-info-database-bdf | |
225 | '((ascii | |
5d5bea97 | 226 | (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") nil 1) |
fb901f73 KH |
227 | (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") nil 1) |
228 | (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") nil 1) | |
229 | (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") nil 1)) | |
2cb842ae | 230 | (latin-iso8859-1 |
fb901f73 | 231 | (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") iso-latin-1 1) |
5d5bea97 EZ |
232 | (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") iso-latin-1 1) |
233 | (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") iso-latin-1 1) | |
234 | (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") iso-latin-1 1)) | |
2cb842ae | 235 | (latin-iso8859-2 |
5d5bea97 | 236 | (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf") iso-latin-2 1)) |
2cb842ae | 237 | (latin-iso8859-3 |
5d5bea97 | 238 | (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf") iso-latin-3 1)) |
2cb842ae | 239 | (latin-iso8859-4 |
5d5bea97 | 240 | (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf") iso-latin-4 1)) |
2cb842ae | 241 | (thai-tis620 |
5d5bea97 | 242 | (normal bdf ("thai24.bdf" "thai-24.bdf") thai-tis620 1)) |
2cb842ae | 243 | (greek-iso8859-7 |
5d5bea97 | 244 | (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") greek-iso-8bit 1)) |
2cb842ae KH |
245 | ;; (arabic-iso8859-6 nil) ; not yet available |
246 | (hebrew-iso8859-8 | |
5d5bea97 | 247 | (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") hebrew-iso-8bit 1)) |
2cb842ae KH |
248 | (katakana-jisx0201 |
249 | (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1)) | |
250 | (latin-jisx0201 | |
251 | (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1)) | |
252 | (cyrillic-iso8859-5 | |
5d5bea97 | 253 | (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") cyrillic-iso-8bit 1)) |
2cb842ae | 254 | (latin-iso8859-9 |
5d5bea97 | 255 | (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-latin-5 1)) |
2cb842ae KH |
256 | (japanese-jisx0208-1978 |
257 | (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2)) | |
258 | (chinese-gb2312 | |
259 | (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2)) | |
260 | (japanese-jisx0208 | |
261 | (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2)) | |
262 | (korean-ksc5601 | |
263 | (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2)) | |
264 | (japanese-jisx0212 | |
5d5bea97 | 265 | (normal bdf ("jksp40.bdf" "jisksp40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 266 | (chinese-cns11643-1 |
5d5bea97 | 267 | (normal bdf ("cns1-40.bdf" "cns-1-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 268 | (chinese-cns11643-2 |
5d5bea97 | 269 | (normal bdf ("cns2-40.bdf" "cns-2-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae KH |
270 | (chinese-big5-1 |
271 | (normal bdf "taipei24.bdf" chinese-big5 2)) | |
272 | (chinese-big5-2 | |
273 | (normal bdf "taipei24.bdf" chinese-big5 2)) | |
274 | (chinese-sisheng | |
5d5bea97 | 275 | (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-8bit 1)) |
2cb842ae | 276 | (ipa |
5d5bea97 | 277 | (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1)) |
2cb842ae | 278 | (vietnamese-viscii-lower |
5d5bea97 | 279 | (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1)) |
2cb842ae | 280 | (vietnamese-viscii-upper |
5d5bea97 | 281 | (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1)) |
2cb842ae | 282 | (arabic-digit |
5d5bea97 | 283 | (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf") ps-mule-encode-7bit 1)) |
2cb842ae | 284 | (arabic-1-column |
5d5bea97 | 285 | (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf") ps-mule-encode-7bit 1)) |
2cb842ae KH |
286 | ;; (ascii-right-to-left nil) ; not yet available |
287 | (lao | |
5d5bea97 | 288 | (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") lao 1)) |
2cb842ae | 289 | (arabic-2-column |
5d5bea97 | 290 | (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1)) |
2cb842ae | 291 | (indian-is13194 |
5d5bea97 | 292 | (normal bdf ("isci24-etl.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1)) |
2cb842ae | 293 | (indian-1-column |
5d5bea97 | 294 | (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 295 | (tibetan-1-column |
5d5bea97 | 296 | (normal bdf ("tib1c24-mule.bdf" "mule-tibmdx-1col-24.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 297 | (ethiopic |
5d5bea97 | 298 | (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") ps-mule-encode-ethiopic 2)) |
2cb842ae | 299 | (chinese-cns11643-3 |
5d5bea97 | 300 | (normal bdf ("cns3-40.bdf" "cns-3-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 301 | (chinese-cns11643-4 |
5d5bea97 | 302 | (normal bdf ("cns4-40.bdf" "cns-4-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 303 | (chinese-cns11643-5 |
5d5bea97 | 304 | (normal bdf ("cns5-40.bdf" "cns-5-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 305 | (chinese-cns11643-6 |
5d5bea97 | 306 | (normal bdf ("cns6-40.bdf" "cns-6-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 307 | (chinese-cns11643-7 |
5d5bea97 | 308 | (normal bdf ("cns7-40.bdf" "cns-7-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 309 | (indian-2-column |
5d5bea97 | 310 | (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 311 | (tibetan |
5d5bea97 | 312 | (normal bdf ("tib24-mule.bdf" "mule-tibmdx-24.bdf") ps-mule-encode-7bit 2))) |
2cb842ae KH |
313 | "Sample setting of the `ps-mule-font-info-database' to use BDF fonts. |
314 | BDF (Bitmap Distribution Format) is a format used for distributing X's font | |
315 | source file. | |
316 | ||
317 | Current default value list for BDF fonts is included in `intlfonts-1.1' which is | |
318 | a collection of X11 fonts for all characters supported by Emacs. | |
319 | ||
320 | Using this list as default value to `ps-mule-font-info-database', all characters | |
321 | including ASCII and Latin-1 are printed by BDF fonts. | |
322 | ||
323 | See also `ps-mule-font-info-database-ps-bdf'.") | |
324 | ||
325 | (defconst ps-mule-font-info-database-ps-bdf | |
326 | (cons (car ps-mule-font-info-database-latin) | |
327 | (cdr (cdr ps-mule-font-info-database-bdf))) | |
328 | "Sample setting of the `ps-mule-font-info-database' to use BDF fonts. | |
329 | ||
330 | Current default value list for BDF fonts is included in `intlfonts-1.1' which is | |
331 | a collection of X11 fonts for all characters supported by Emacs. | |
332 | ||
333 | Using this list as default value to `ps-mule-font-info-database', all characters | |
334 | except ASCII and Latin-1 characters are printed by BDF fonts. ASCII and Latin-1 | |
335 | characters are printed by PostScript font specified by `ps-font-family' and | |
336 | `ps-header-font-family'. | |
337 | ||
338 | See also `ps-mule-font-info-database-bdf'.") | |
339 | ||
340 | ;; Two typical encoding functions for PostScript fonts. | |
341 | ||
342 | (defun ps-mule-encode-7bit (string) | |
343 | (ps-mule-encode-bit string 0)) | |
344 | ||
345 | (defun ps-mule-encode-8bit (string) | |
346 | (ps-mule-encode-bit string 128)) | |
347 | ||
348 | (defun ps-mule-encode-bit (string delta) | |
349 | (let* ((dim (charset-dimension (char-charset (string-to-char string)))) | |
350 | (len (* (ps-mule-chars-in-string string) dim)) | |
351 | (str (make-string len 0)) | |
352 | (i 0) | |
353 | (j 0)) | |
354 | (if (= dim 1) | |
355 | (while (< j len) | |
356 | (aset str j | |
357 | (+ (nth 1 (split-char (ps-mule-string-char string i))) delta)) | |
358 | (setq i (ps-mule-next-index string i) | |
359 | j (1+ j))) | |
360 | (while (< j len) | |
361 | (let ((split (split-char (ps-mule-string-char string i)))) | |
362 | (aset str j (+ (nth 1 split) delta)) | |
363 | (aset str (1+ j) (+ (nth 2 split) delta)) | |
364 | (setq i (ps-mule-next-index string i) | |
365 | j (+ j 2))))) | |
366 | str)) | |
367 | ||
368 | ;; Special encoding function for Ethiopic. | |
369 | (define-ccl-program ccl-encode-ethio-unicode | |
370 | `(1 | |
371 | ((read r2) | |
372 | (loop | |
373 | (if (r2 == ,leading-code-private-22) | |
374 | ((read r0) | |
375 | (if (r0 == ,(charset-id 'ethiopic)) | |
376 | ((read r1 r2) | |
377 | (r1 &= 127) (r2 &= 127) | |
378 | (call ccl-encode-ethio-font) | |
379 | (write r1) | |
380 | (write-read-repeat r2)) | |
381 | ((write r2 r0) | |
382 | (repeat)))) | |
383 | (write-read-repeat r2)))))) | |
384 | ||
385 | (defun ps-mule-encode-ethiopic (string) | |
386 | (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode) | |
387 | (make-vector 9 nil) | |
388 | string)) | |
389 | ||
390 | ;; A charset which we are now processing. | |
391 | (defvar ps-mule-current-charset nil) | |
392 | ||
393 | (defun ps-mule-get-font-spec (charset font-type) | |
394 | "Return FONT-SPEC for printing characters CHARSET with FONT-TYPE. | |
395 | FONT-SPEC is a list that has the form: | |
396 | ||
397 | (FONT-SRC FONT-NAME ENCODING BYTES) | |
398 | ||
399 | FONT-SPEC is extracted from `ps-mule-font-info-database'. | |
400 | ||
401 | See the documentation of `ps-mule-font-info-database' for the meaning of each | |
402 | element of the list." | |
403 | (let ((slot (cdr (assq charset ps-mule-font-info-database)))) | |
404 | (and slot | |
405 | (cdr (or (assq font-type slot) | |
406 | (and (eq font-type 'bold-italic) | |
407 | (or (assq 'bold slot) (assq 'italic slot))) | |
408 | (assq 'normal slot)))))) | |
409 | ||
410 | ;; Functions to access each element of FONT-SPEC. | |
411 | (defsubst ps-mule-font-spec-src (font-spec) (car font-spec)) | |
412 | (defsubst ps-mule-font-spec-name (font-spec) (nth 1 font-spec)) | |
413 | (defsubst ps-mule-font-spec-encoding (font-spec) (nth 2 font-spec)) | |
414 | (defsubst ps-mule-font-spec-bytes (font-spec) (nth 3 font-spec)) | |
415 | ||
416 | (defsubst ps-mule-printable-p (charset) | |
417 | "Non-nil if characters in CHARSET is printable." | |
418 | (ps-mule-get-font-spec charset 'normal)) | |
419 | ||
420 | (defconst ps-mule-external-libraries | |
421 | '((builtin nil nil | |
422 | nil nil nil) | |
423 | (bdf ps-bdf nil | |
424 | bdf-generate-prologue bdf-generate-font bdf-generate-glyphs) | |
425 | (pcf nil nil | |
426 | pcf-generate-prologue pcf-generate-font pcf-generate-glyphs) | |
427 | (vflib nil nil | |
428 | vflib-generate-prologue vflib-generate-font vflib-generate-glyphs)) | |
429 | "Alist of information of external libraries to support PostScript printing. | |
430 | Each element has the form: | |
431 | ||
432 | (FONT-SRC FEATURE INITIALIZED-P PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC) | |
433 | ||
434 | FONT-SRC is the font source: builtin, bdf, pcf, or vflib. | |
435 | ||
436 | FEATURE is the feature that provide a facility to handle FONT-SRC. Except for | |
437 | `builtin' FONT-SRC, this feature is automatically `require'd before handling | |
438 | FONT-SRC. Currently, we only have the feature `ps-bdf'. | |
439 | ||
440 | INITIALIZED-P indicates if this library is initialized or not. | |
441 | ||
442 | PROLOGUE-FUNC is a function to generate PostScript code which define several | |
443 | PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is | |
444 | called with no argument, and should return a list of strings. | |
445 | ||
446 | FONT-FUNC is a function to generate PostScript code which define a new font. It | |
447 | is called with one argument FONT-SPEC, and should return a list of strings. | |
448 | ||
449 | GLYPHS-FUNC is a function to generate PostScript code which define glyphs of | |
450 | characters. It is called with three arguments FONT-SPEC, CODE-LIST, and BYTES, | |
451 | and should return a list of strings.") | |
452 | ||
453 | (defun ps-mule-init-external-library (font-spec) | |
454 | "Initialize external library specified by FONT-SPEC for PostScript printing. | |
455 | See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning." | |
456 | (let* ((font-src (ps-mule-font-spec-src font-spec)) | |
457 | (slot (assq font-src ps-mule-external-libraries))) | |
458 | (or (not font-src) | |
459 | (nth 2 slot) | |
460 | (let ((func (nth 3 slot))) | |
461 | (if func | |
462 | (progn | |
463 | (or (featurep (nth 1 slot)) (require (nth 1 slot))) | |
464 | (ps-output-prologue (funcall func)))) | |
465 | (setcar (nthcdr 2 slot) t))))) | |
466 | ||
467 | ;; Cached glyph information of fonts, alist of: | |
468 | ;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...) | |
469 | ;; cache CODE0 CODE1 ...) | |
470 | (defvar ps-mule-font-cache nil) | |
471 | ||
472 | (defun ps-mule-generate-font (font-spec charset) | |
473 | "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET." | |
5d5bea97 EZ |
474 | (let* ((font-name (ps-mule-font-spec-name font-spec)) |
475 | (font-name (if (consp font-name) (car font-name) font-name)) | |
476 | (font-cache (assoc font-name ps-mule-font-cache)) | |
2cb842ae | 477 | (font-src (ps-mule-font-spec-src font-spec)) |
2cb842ae KH |
478 | (func (nth 4 (assq font-src ps-mule-external-libraries))) |
479 | (scaled-font-name | |
480 | (if (eq charset 'ascii) | |
481 | (format "f%d" ps-current-font) | |
482 | (format "f%02x-%d" | |
483 | (charset-id charset) ps-current-font)))) | |
484 | (and func (not font-cache) | |
485 | (ps-output-prologue (funcall func charset font-spec))) | |
486 | (ps-output-prologue | |
487 | (list (format "/%s %f /%s Def%sFontMule\n" | |
488 | scaled-font-name ps-font-size font-name | |
489 | (if (eq ps-mule-current-charset 'ascii) "Ascii" "")))) | |
490 | (if font-cache | |
491 | (setcar (cdr font-cache) | |
492 | (cons (cons ps-current-font scaled-font-name) | |
493 | (nth 1 font-cache))) | |
494 | (setq font-cache (list font-name | |
495 | (list (cons ps-current-font scaled-font-name)) | |
496 | 'cache) | |
497 | ps-mule-font-cache (cons font-cache ps-mule-font-cache))) | |
498 | font-cache)) | |
499 | ||
500 | (defun ps-mule-generate-glyphs (font-spec code-list) | |
501 | "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC." | |
502 | (let* ((font-src (ps-mule-font-spec-src font-spec)) | |
503 | (func (nth 5 (assq font-src ps-mule-external-libraries)))) | |
504 | (and func | |
505 | (ps-output-prologue | |
506 | (funcall func font-spec code-list | |
507 | (ps-mule-font-spec-bytes font-spec)))))) | |
508 | ||
509 | (defun ps-mule-prepare-font (font-spec string charset &optional no-setfont) | |
510 | "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC. | |
511 | ||
512 | The generated code is inserted on prologue part except the code that sets the | |
513 | current font (using PostScript procedure `FM'). | |
514 | ||
515 | If optional arg NO-SETFONT is non-nil, don't generate the code for setting the | |
516 | current font." | |
5d5bea97 EZ |
517 | (let* ((font-name (ps-mule-font-spec-name font-spec)) |
518 | (font-name (if (consp font-name) (car font-name) font-name)) | |
519 | (font-cache (assoc font-name ps-mule-font-cache))) | |
2cb842ae KH |
520 | (or (and font-cache (assq ps-current-font (nth 1 font-cache))) |
521 | (setq font-cache (ps-mule-generate-font font-spec charset))) | |
522 | (or no-setfont | |
523 | (let ((new-font (cdr (assq ps-current-font (nth 1 font-cache))))) | |
524 | (or (equal new-font ps-last-font) | |
525 | (progn | |
526 | (ps-output (format "/%s FM\n" new-font)) | |
527 | (setq ps-last-font new-font))))) | |
528 | (if (nth 5 (assq (ps-mule-font-spec-src font-spec) | |
529 | ps-mule-external-libraries)) | |
530 | ;; We have to generate PostScript codes which define glyphs. | |
531 | (let* ((cached-codes (nthcdr 2 font-cache)) | |
532 | (bytes (ps-mule-font-spec-bytes font-spec)) | |
533 | (len (length string)) | |
534 | (i 0) | |
535 | newcodes code) | |
536 | (while (< i len) | |
537 | (setq code (if (= bytes 1) | |
538 | (aref string i) | |
539 | (+ (* (aref string i) 256) (aref string (1+ i))))) | |
540 | (or (memq code cached-codes) | |
541 | (progn | |
542 | (setq newcodes (cons code newcodes)) | |
543 | (setcdr cached-codes (cons code (cdr cached-codes))))) | |
544 | (setq i (+ i bytes))) | |
545 | (and newcodes | |
546 | (ps-mule-generate-glyphs font-spec newcodes)))))) | |
547 | ||
548 | ;;;###autoload | |
549 | (defun ps-mule-prepare-ascii-font (string) | |
550 | "Setup special ASCII font for STRING. | |
551 | STRING should contain only ASCII characters." | |
552 | (let ((font-spec | |
553 | (ps-mule-get-font-spec | |
554 | 'ascii | |
555 | (car (nth ps-current-font (ps-font-alist 'ps-font-for-text)))))) | |
556 | (and font-spec | |
557 | (ps-mule-prepare-font font-spec string 'ascii)))) | |
558 | ||
559 | ;;;###autoload | |
560 | (defun ps-mule-set-ascii-font () | |
561 | (unless (eq ps-mule-current-charset 'ascii) | |
562 | (ps-set-font ps-current-font) | |
563 | (setq ps-mule-current-charset 'ascii))) | |
564 | ||
565 | ;; List of charsets of multi-byte characters in a text being printed. | |
566 | ;; If the text doesn't contain any multi-byte characters (i.e. only ASCII), | |
567 | ;; the value is nil. | |
568 | (defvar ps-mule-charset-list nil) | |
569 | ||
570 | ;; This is a PostScript code inserted in the header of generated PostScript. | |
571 | (defconst ps-mule-prologue | |
572 | "%%%% Start of Mule Section | |
573 | ||
574 | %% Working dictionary for general use. | |
575 | /MuleDict 10 dict def | |
576 | ||
577 | %% Define already scaled font for non-ASCII character sets. | |
578 | /DefFontMule { % fontname size basefont |- -- | |
579 | findfont exch scalefont definefont pop | |
580 | } bind def | |
581 | ||
582 | %% Define already scaled font for ASCII character sets. | |
583 | /DefAsciiFontMule { % fontname size basefont |- | |
584 | MuleDict begin | |
585 | findfont dup /Encoding get /ISOLatin1Encoding exch def | |
586 | exch scalefont reencodeFontISO | |
587 | end | |
588 | } def | |
589 | ||
590 | %% Set the specified non-ASCII font to use. It doesn't install | |
591 | %% Ascent, etc. | |
592 | /FM { % fontname |- -- | |
593 | findfont setfont | |
594 | } bind def | |
595 | ||
596 | %% Show vacant box for characters which don't have appropriate font. | |
597 | /SB { % count column |- -- | |
598 | SpaceWidth mul /w exch def | |
599 | 1 exch 1 exch { %for | |
600 | pop | |
601 | gsave | |
602 | 0 setlinewidth | |
603 | 0 Descent rmoveto w 0 rlineto | |
604 | 0 LineHeight rlineto w neg 0 rlineto closepath stroke | |
605 | grestore | |
606 | w 0 rmoveto | |
607 | } for | |
608 | } bind def | |
609 | ||
610 | %% Flag to tell if we are now handling a composite character. This is | |
611 | %% defined here because both composite character handler and bitmap font | |
612 | %% handler require it. | |
613 | /Cmpchar false def | |
614 | ||
615 | %%%% End of Mule Section | |
616 | ||
617 | " | |
618 | "PostScript code for printing multi-byte characters.") | |
619 | ||
620 | (defvar ps-mule-prologue-generated nil) | |
621 | ||
622 | (defun ps-mule-prologue-generated () | |
623 | (unless ps-mule-prologue-generated | |
624 | (ps-output-prologue ps-mule-prologue) | |
625 | (setq ps-mule-prologue-generated t))) | |
626 | ||
627 | (defun ps-mule-find-wrappoint (from to char-width) | |
628 | "Find the longest sequence which is printable in the current line. | |
629 | ||
630 | The search starts at FROM and goes until TO. It is assumed that all characters | |
631 | between FROM and TO belong to a charset in `ps-mule-current-charset'. | |
632 | ||
633 | CHAR-WIDTH is the average width of ASCII characters in the current font. | |
634 | ||
635 | Returns the value: | |
636 | ||
637 | (ENDPOS . RUN-WIDTH) | |
638 | ||
639 | Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of | |
640 | the sequence." | |
641 | (if (eq ps-mule-current-charset 'composition) | |
642 | ;; We must draw one char by one. | |
643 | (let ((run-width (* (char-width (char-after from)) char-width))) | |
644 | (if (> run-width ps-width-remaining) | |
645 | (cons from ps-width-remaining) | |
646 | (cons (ps-mule-next-point from) run-width))) | |
647 | ;; We assume that all characters in this range have the same width. | |
648 | (setq char-width (* char-width (charset-width ps-mule-current-charset))) | |
649 | (let ((run-width (* (chars-in-region from to) char-width))) | |
650 | (if (> run-width ps-width-remaining) | |
651 | (cons (min to | |
652 | (save-excursion | |
653 | (goto-char from) | |
654 | (forward-point | |
655 | (truncate (/ ps-width-remaining char-width))))) | |
656 | ps-width-remaining) | |
657 | (cons to run-width))))) | |
658 | ||
659 | ;;;###autoload | |
660 | (defun ps-mule-plot-string (from to &optional bg-color) | |
661 | "Generate PostScript code for ploting characters in the region FROM and TO. | |
662 | ||
663 | It is assumed that all characters in this region belong to the same charset. | |
664 | ||
665 | Optional argument BG-COLOR specifies background color. | |
666 | ||
667 | Returns the value: | |
668 | ||
669 | (ENDPOS . RUN-WIDTH) | |
670 | ||
671 | Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of | |
672 | the sequence." | |
673 | (setq ps-mule-current-charset (charset-after from)) | |
674 | (let* ((wrappoint (ps-mule-find-wrappoint | |
675 | from to (ps-avg-char-width 'ps-font-for-text))) | |
676 | (to (car wrappoint)) | |
677 | (font-type (car (nth ps-current-font | |
678 | (ps-font-alist 'ps-font-for-text)))) | |
679 | (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)) | |
680 | (string (buffer-substring-no-properties from to))) | |
681 | (cond | |
682 | ((= from to) | |
683 | ;; We can't print any more characters in the current line. | |
684 | nil) | |
685 | ||
686 | (font-spec | |
687 | ;; We surely have a font for printing this character set. | |
688 | (ps-output-string (ps-mule-string-encoding font-spec string)) | |
689 | (ps-output " S\n")) | |
690 | ||
691 | ((eq ps-mule-current-charset 'latin-iso8859-1) | |
692 | ;; Latin-1 can be printed by a normal ASCII font. | |
693 | (ps-output-string (ps-mule-string-ascii string)) | |
694 | (ps-output " S\n")) | |
695 | ||
696 | ((eq ps-mule-current-charset 'composition) | |
697 | (let* ((ch (char-after from)) | |
698 | (width (char-width ch)) | |
699 | (ch-list (decompose-composite-char ch 'list t))) | |
700 | (if (consp (nth 1 ch-list)) | |
701 | (ps-mule-plot-rule-cmpchar ch-list width font-type) | |
702 | (ps-mule-plot-cmpchar ch-list width t font-type)))) | |
703 | ||
704 | (t | |
705 | ;; No way to print this charset. Just show a vacant box of an | |
706 | ;; appropriate width. | |
707 | (ps-output (format "%d %d SB\n" | |
708 | (length string) | |
709 | (if (eq ps-mule-current-charset 'composition) | |
710 | (char-width (char-after from)) | |
711 | (charset-width ps-mule-current-charset)))))) | |
712 | wrappoint)) | |
713 | ||
714 | ;; Composite font support | |
715 | ||
716 | (defvar ps-mule-cmpchar-prologue-generated nil) | |
717 | ||
718 | (defconst ps-mule-cmpchar-prologue | |
719 | "%%%% Composite character handler | |
720 | /CmpcharWidth 0 def | |
721 | /CmpcharRelativeCompose 0 def | |
722 | /CmpcharRelativeSkip 0.4 def | |
723 | ||
724 | %% Get a bounding box (relative to currentpoint) of STR. | |
725 | /GetPathBox { % str |- -- | |
726 | gsave | |
727 | currentfont /FontType get 3 eq { %ifelse | |
728 | stringwidth pop pop | |
729 | } { | |
730 | currentpoint /y exch def pop | |
731 | false charpath flattenpath pathbbox | |
732 | y sub /URY exch def pop | |
733 | y sub /LLY exch def pop | |
734 | } ifelse | |
735 | grestore | |
736 | } bind def | |
737 | ||
738 | %% Beginning of composite char. | |
739 | /BC { % str xoff width |- -- | |
740 | /Cmpchar true def | |
741 | /CmpcharWidth exch def | |
742 | currentfont /RelativeCompose known { | |
743 | /CmpcharRelativeCompose currentfont /RelativeCompose get def | |
744 | } { | |
745 | /CmpcharRelativeCompose false def | |
746 | } ifelse | |
747 | /bgsave bg def /bgcolorsave bgcolor def | |
748 | /Effectsave Effect def | |
749 | gsave % Reflect effect only at first | |
750 | /Effect Effect 1 2 add 4 add 16 add and def | |
751 | /f0 findfont setfont ( ) 0 CmpcharWidth getinterval S | |
752 | grestore | |
753 | /Effect Effectsave 8 32 add and def % enable only shadow and outline | |
754 | false BG | |
755 | gsave SpaceWidth mul 0 rmoveto dup GetPathBox S grestore | |
756 | /y currentpoint exch pop def | |
757 | /HIGH URY y add def /LOW LLY y add def | |
758 | } bind def | |
759 | ||
760 | %% End of composite char. | |
761 | /EC { % -- |- -- | |
762 | /bg bgsave def /bgcolor bgcolorsave def | |
763 | /Effect Effectsave def | |
764 | /Cmpchar false def | |
765 | CmpcharWidth SpaceWidth mul 0 rmoveto | |
766 | } bind def | |
767 | ||
768 | %% Rule base composition | |
769 | /RBC { % str xoff gref nref |- -- | |
770 | /nref exch def /gref exch def | |
771 | gsave | |
772 | SpaceWidth mul 0 rmoveto | |
773 | dup | |
774 | GetPathBox | |
775 | [ HIGH currentpoint exch pop LOW HIGH LOW add 2 div ] gref get | |
776 | [ URY LLY sub LLY neg 0 URY LLY sub 2 div ] nref get | |
777 | sub /btm exch def | |
778 | /top btm URY LLY sub add def | |
779 | top HIGH gt { /HIGH top def } if | |
780 | btm LOW lt { /LOW btm def } if | |
781 | currentpoint pop btm LLY sub moveto | |
782 | S | |
783 | grestore | |
784 | } bind def | |
785 | ||
786 | %% Relative composition | |
787 | /RLC { % str |- -- | |
788 | gsave | |
789 | dup GetPathBox | |
790 | CmpcharRelativeCompose type /integertype eq { | |
791 | LLY CmpcharRelativeCompose gt { % compose on top | |
792 | currentpoint pop HIGH LLY sub CmpcharRelativeSkip add moveto | |
793 | /HIGH HIGH URY LLY sub add CmpcharRelativeSkip add def | |
794 | } { URY 0 le { % compose under bottom | |
795 | currentpoint pop LOW LLY add CmpcharRelativeSkip sub moveto | |
796 | /LOW LOW URY LLY sub sub CmpcharRelativeSkip sub def | |
797 | } if } ifelse } if | |
798 | S | |
799 | grestore | |
800 | } bind def | |
801 | %%%% End of composite character handler | |
802 | ||
803 | " | |
804 | "PostScript code for printing composite characters.") | |
805 | ||
806 | (defun ps-mule-plot-rule-cmpchar (ch-rule-list total-width font-type) | |
807 | (let ((leftmost 0.0) | |
808 | (rightmost (float (char-width (car ch-rule-list)))) | |
809 | (the-list (cons '(3 . 3) ch-rule-list)) | |
810 | cmpchar-elements) | |
811 | (while the-list | |
812 | (let* ((this (car the-list)) | |
813 | (gref (car this)) | |
814 | (nref (cdr this)) | |
815 | ;; X-axis info (0:left, 1:center, 2:right) | |
816 | (gref-x (% gref 3)) | |
817 | (nref-x (% nref 3)) | |
818 | ;; Y-axis info (0:top, 1:base, 2:bottom, 3:center) | |
819 | (gref-y (if (= gref 4) 3 (/ gref 3))) | |
820 | (nref-y (if (= nref 4) 3 (/ nref 3))) | |
821 | (char (car (cdr the-list))) | |
822 | (width (float (char-width char))) | |
823 | left) | |
824 | (setq left (+ leftmost | |
825 | (* (- rightmost leftmost) gref-x 0.5) | |
826 | (- (* nref-x width 0.5))) | |
827 | cmpchar-elements (cons (list char left gref-y nref-y) | |
828 | cmpchar-elements) | |
829 | leftmost (min left leftmost) | |
830 | rightmost (max (+ left width) rightmost) | |
831 | the-list (nthcdr 2 the-list)))) | |
832 | (if (< leftmost 0) | |
833 | (let ((the-list cmpchar-elements) | |
834 | elt) | |
835 | (while the-list | |
836 | (setq elt (car the-list) | |
837 | the-list (cdr the-list)) | |
838 | (setcar (cdr elt) (- (nth 1 elt) leftmost))))) | |
839 | (ps-mule-plot-cmpchar (nreverse cmpchar-elements) | |
840 | total-width nil font-type))) | |
841 | ||
842 | (defun ps-mule-plot-cmpchar (elements total-width relativep font-type) | |
843 | (let* ((elt (car elements)) | |
844 | (ch (if relativep elt (car elt)))) | |
845 | (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type)) | |
846 | (ps-output (format " %d %d BC " | |
847 | (if relativep 0 (nth 1 elt)) | |
848 | total-width)) | |
849 | (while (setq elements (cdr elements)) | |
850 | (setq elt (car elements) | |
851 | ch (if relativep elt (car elt))) | |
852 | (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type)) | |
853 | (ps-output (if relativep | |
854 | " RLC " | |
855 | (format " %d %d %d RBC " | |
856 | (nth 1 elt) (nth 2 elt) (nth 3 elt)))))) | |
857 | (ps-output "EC\n")) | |
858 | ||
859 | (defun ps-mule-prepare-cmpchar-font (char font-type) | |
860 | (let* ((ps-mule-current-charset (char-charset char)) | |
861 | (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))) | |
862 | (cond (font-spec | |
863 | (ps-mule-string-encoding font-spec (char-to-string char))) | |
864 | ||
865 | ((eq ps-mule-current-charset 'latin-iso8859-1) | |
866 | (ps-mule-string-ascii (char-to-string char))) | |
867 | ||
868 | (t | |
869 | ;; No font for CHAR. | |
870 | (ps-set-font ps-current-font) | |
871 | " ")))) | |
872 | ||
873 | (defun ps-mule-string-ascii (str) | |
874 | (ps-set-font ps-current-font) | |
875 | (string-as-unibyte (encode-coding-string str 'iso-latin-1))) | |
876 | ||
877 | (defun ps-mule-string-encoding (font-spec str) | |
878 | (let ((encoding (ps-mule-font-spec-encoding font-spec))) | |
879 | (setq str | |
880 | (string-as-unibyte | |
881 | (cond ((coding-system-p encoding) | |
882 | (encode-coding-string str encoding)) | |
883 | ((functionp encoding) | |
884 | (funcall encoding str)) | |
885 | (encoding | |
886 | (error "Invalid coding system or function: %s" encoding)) | |
887 | (t | |
888 | str)))) | |
889 | (if (ps-mule-font-spec-src font-spec) | |
890 | (ps-mule-prepare-font font-spec str ps-mule-current-charset) | |
891 | (ps-set-font ps-current-font)) | |
892 | str)) | |
893 | ||
894 | ;; Bitmap font support | |
895 | ||
896 | (defvar ps-mule-bitmap-prologue-generated nil) | |
897 | ||
898 | (defconst ps-mule-bitmap-prologue | |
899 | "%%%% Bitmap font handler | |
900 | ||
901 | /str7 7 string def % working area | |
902 | ||
903 | %% We grow the dictionary one bunch (1024 entries) by one. | |
904 | /BitmapDictArray 256 array def | |
905 | /BitmapDictLength 1024 def | |
906 | /BitmapDictIndex -1 def | |
907 | ||
908 | /NewBitmapDict { % -- |- -- | |
909 | /BitmapDictIndex BitmapDictIndex 1 add def | |
910 | BitmapDictArray BitmapDictIndex BitmapDictLength dict put | |
911 | } bind def | |
912 | ||
913 | %% Make at least one dictionary. | |
914 | NewBitmapDict | |
915 | ||
916 | /AddBitmap { % gloval-charname bitmap-data |- -- | |
917 | BitmapDictArray BitmapDictIndex get | |
918 | dup length BitmapDictLength ge { | |
919 | pop | |
920 | NewBitmapDict | |
921 | BitmapDictArray BitmapDictIndex get | |
922 | } if | |
923 | 3 1 roll put | |
924 | } bind def | |
925 | ||
926 | /GetBitmap { % gloval-charname |- bitmap-data | |
927 | 0 1 BitmapDictIndex { BitmapDictArray exch get begin } for | |
928 | load | |
929 | 0 1 BitmapDictIndex { pop end } for | |
930 | } bind def | |
931 | ||
932 | %% Return a global character name which can be used as a key in the | |
933 | %% bitmap dictionary. | |
934 | /GlobalCharName { % fontidx code1 code2 |- gloval-charname | |
935 | exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put | |
936 | str7 cvn | |
937 | } bind def | |
938 | ||
939 | %% Character code holder for a 2-byte character. | |
940 | /FirstCode -1 def | |
941 | ||
942 | %% Glyph rendering procedure | |
943 | /BuildGlyphCommon { % fontdict charname |- -- | |
944 | 1 index /FontDimension get 1 eq { /FirstCode 0 store } if | |
945 | NameIndexDict exch get % STACK: fontdict charcode | |
946 | FirstCode 0 lt { %ifelse | |
947 | %% This is the first byte of a 2-byte character. Just | |
948 | %% remember it for the moment. | |
949 | /FirstCode exch store | |
950 | pop | |
951 | 0 0 setcharwidth | |
952 | } { | |
953 | 1 index /FontSize get /size exch def | |
954 | 1 index /FontSpaceWidthRatio get /ratio exch def | |
955 | 1 index /FontIndex get exch FirstCode exch | |
956 | GlobalCharName GetBitmap /bmp exch def | |
957 | %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ] | |
958 | Cmpchar { %ifelse | |
959 | /FontMatrix get [ exch { size div } forall ] /mtrx exch def | |
960 | bmp 3 get bmp 4 get mtrx transform | |
961 | /LLY exch def pop | |
962 | bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform | |
963 | /URY exch def pop | |
964 | } { | |
965 | pop | |
966 | } ifelse | |
967 | /FirstCode -1 store | |
968 | ||
969 | bmp 0 get SpaceWidthRatio ratio div mul size div 0 % wx wy | |
970 | setcharwidth % We can't use setcachedevice here. | |
971 | ||
972 | bmp 1 get 0 gt bmp 2 get 0 gt and { | |
973 | bmp 1 get bmp 2 get % width height | |
974 | true % polarity | |
975 | [ size 0 0 size neg bmp 3 get neg bmp 2 get bmp 4 get add ] % matrix | |
976 | bmp 5 1 getinterval cvx % datasrc | |
977 | imagemask | |
978 | } if | |
979 | } ifelse | |
980 | } bind def | |
981 | ||
982 | /BuildCharCommon { | |
983 | 1 index /Encoding get exch get | |
984 | 1 index /BuildGlyph get exec | |
985 | } bind def | |
986 | ||
987 | %% Bitmap font creater | |
988 | ||
989 | %% Common Encoding shared by all bitmap fonts. | |
990 | /EncodingCommon 256 array def | |
991 | %% Mapping table from character name to character code. | |
992 | /NameIndexDict 256 dict def | |
993 | 0 1 255 { %for | |
994 | /idx exch def | |
995 | /idxname idx 256 add 16 (XXX) cvrs dup 0 67 put cvn def % `C' == 67 | |
996 | EncodingCommon idx idxname put | |
997 | NameIndexDict idxname idx put | |
998 | } for | |
999 | ||
1000 | /GlobalFontIndex 0 def | |
1001 | ||
1002 | %% fontname dim col fontsize relative-compose baseline-offset fbbx |- -- | |
1003 | /BitmapFont { | |
1004 | 15 dict begin | |
1005 | /FontBBox exch def | |
1006 | /BaselineOffset exch def | |
1007 | /RelativeCompose exch def | |
1008 | /FontSize exch def | |
1009 | /FontBBox [ FontBBox { FontSize div } forall ] def | |
1010 | FontBBox 2 get FontBBox 0 get sub exch div | |
1011 | /FontSpaceWidthRatio exch def | |
1012 | /FontDimension exch def | |
1013 | /FontIndex GlobalFontIndex def | |
1014 | /FontType 3 def | |
1015 | /FontMatrix matrix def | |
1016 | /Encoding EncodingCommon def | |
1017 | /BuildGlyph { BuildGlyphCommon } def | |
1018 | /BuildChar { BuildCharCommon } def | |
1019 | currentdict end | |
1020 | definefont pop | |
1021 | /GlobalFontIndex GlobalFontIndex 1 add def | |
1022 | } bind def | |
1023 | ||
1024 | %% Define a new bitmap font. | |
1025 | %% fontname dim col fontsize relative-compose baseline-offset fbbx |- -- | |
1026 | /NF { | |
1027 | /fbbx exch def | |
1028 | %% Convert BDF's FontBoundingBox to PostScript's FontBBox | |
1029 | [ fbbx 2 get fbbx 3 get | |
1030 | fbbx 2 get fbbx 0 get add fbbx 3 get fbbx 1 get add ] | |
1031 | BitmapFont | |
1032 | } bind def | |
1033 | ||
1034 | %% Define a glyph for the specified font and character. | |
1035 | /NG { % fontname charcode bitmap-data |- -- | |
1036 | /bmp exch def | |
1037 | exch findfont dup /BaselineOffset get bmp 4 get add bmp exch 4 exch put | |
1038 | /FontIndex get exch | |
1039 | dup 256 idiv exch 256 mod GlobalCharName | |
1040 | bmp AddBitmap | |
1041 | } bind def | |
1042 | %%%% End of bitmap font handler | |
1043 | ||
1044 | ") | |
1045 | ||
1046 | ;; External library support. | |
1047 | ||
1048 | ;; The following three functions are to be called from external | |
1049 | ;; libraries which support bitmap fonts (e.g. `bdf') to get | |
1050 | ;; appropriate PostScript code. | |
1051 | ||
1052 | (defun ps-mule-generate-bitmap-prologue () | |
1053 | (unless ps-mule-bitmap-prologue-generated | |
1054 | (setq ps-mule-bitmap-prologue-generated t) | |
1055 | (list ps-mule-bitmap-prologue))) | |
1056 | ||
1057 | (defun ps-mule-generate-bitmap-font (&rest args) | |
1058 | (list (apply 'format "/%s %d %d %f %S %d %S NF\n" args))) | |
1059 | ||
1060 | (defun ps-mule-generate-bitmap-glyph (font-name code dwidth bbx bitmap) | |
1061 | (format "/%s %d [ %d %d %d %d %d <%s> ] NG\n" | |
1062 | font-name code | |
1063 | dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3) | |
1064 | bitmap)) | |
1065 | ||
1066 | ;; Mule specific initializers. | |
1067 | ||
1068 | ;;;###autoload | |
1069 | (defun ps-mule-initialize () | |
1070 | "Initialize global data for printing multi-byte characters." | |
1071 | (setq ps-mule-font-cache nil | |
1072 | ps-mule-prologue-generated nil | |
1073 | ps-mule-cmpchar-prologue-generated nil | |
1074 | ps-mule-bitmap-prologue-generated nil) | |
1075 | (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil)) | |
1076 | ps-mule-external-libraries)) | |
1077 | ||
1078 | ;;;###autoload | |
1079 | (defun ps-mule-begin-job (from to) | |
1080 | "Start printing job for multi-byte chars between FROM and TO. | |
1081 | This checks if all multi-byte characters in the region are printable or not." | |
1082 | (setq ps-mule-charset-list nil | |
1083 | ps-mule-font-info-database | |
1084 | (cond ((eq ps-multibyte-buffer 'non-latin-printer) | |
1085 | ps-mule-font-info-database-ps) | |
1086 | ((eq ps-multibyte-buffer 'bdf-font) | |
1087 | ps-mule-font-info-database-bdf) | |
1088 | ((eq ps-multibyte-buffer 'bdf-font-except-latin) | |
1089 | ps-mule-font-info-database-ps-bdf) | |
1090 | (t | |
1091 | ps-mule-font-info-database-latin))) | |
1092 | (and (boundp 'enable-multibyte-characters) | |
1093 | enable-multibyte-characters | |
1094 | ;; Initialize `ps-mule-charset-list'. If some characters aren't | |
1095 | ;; printable, warn it. | |
1096 | (let ((charsets (find-charset-region from to))) | |
f37bad85 KH |
1097 | (setq charsets (delq 'ascii (delq 'unknown (delq nil charsets))) |
1098 | ps-mule-charset-list charsets) | |
2cb842ae KH |
1099 | (save-excursion |
1100 | (goto-char from) | |
1101 | (and (search-forward "\200" to t) | |
1102 | (setq ps-mule-charset-list | |
1103 | (cons 'composition ps-mule-charset-list)))) | |
1104 | (while charsets | |
1105 | (setq charsets | |
1106 | (cond | |
1107 | ((or (eq (car charsets) 'composition) | |
1108 | (ps-mule-printable-p (car charsets))) | |
1109 | (cdr charsets)) | |
1110 | ((y-or-n-p | |
1111 | "Font for some characters not found, continue anyway? ") | |
1112 | nil) | |
1113 | (t | |
1114 | (error "Printing cancelled"))))))) | |
1115 | ||
1116 | (setq ps-mule-current-charset 'ascii) | |
1117 | ||
1118 | (if ps-mule-charset-list | |
1119 | (let ((the-list ps-mule-charset-list) | |
1120 | font-spec elt) | |
1121 | (ps-mule-prologue-generated) | |
1122 | ;; If external functions are necessary, generate prologues for them. | |
1123 | (while the-list | |
1124 | (setq elt (car the-list) | |
1125 | the-list (cdr the-list)) | |
1126 | (cond ((and (eq elt 'composition) | |
1127 | (not ps-mule-cmpchar-prologue-generated)) | |
1128 | (ps-output-prologue ps-mule-cmpchar-prologue) | |
1129 | (setq ps-mule-cmpchar-prologue-generated t)) | |
1130 | ((setq font-spec (ps-mule-get-font-spec elt 'normal)) | |
1131 | (ps-mule-init-external-library font-spec)))))) | |
1132 | ||
1133 | ;; If ASCII font is also specified in ps-mule-font-info-database, | |
1134 | ;; use it istead of what specified in ps-font-info-database. | |
1135 | (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal))) | |
1136 | (if font-spec | |
1137 | (progn | |
1138 | (ps-mule-prologue-generated) | |
1139 | (ps-mule-init-external-library font-spec) | |
1140 | (let ((font (ps-font-alist 'ps-font-for-text)) | |
1141 | (ps-current-font 0)) | |
1142 | (while font | |
1143 | ;; Be sure to download a glyph for SPACE in advance. | |
1144 | (ps-mule-prepare-font (ps-mule-get-font-spec 'ascii (car font)) | |
1145 | " " 'ascii 'no-setfont) | |
1146 | (setq font (cdr font) | |
1147 | ps-current-font (1+ ps-current-font))))))) | |
1148 | ||
1149 | (if ps-mule-charset-list | |
1150 | ;; We must change this regexp for multi-byte buffer. | |
1151 | (setq ps-control-or-escape-regexp | |
1152 | (cond ((eq ps-print-control-characters '8-bit) | |
1153 | "[^\040-\176]") | |
1154 | ((eq ps-print-control-characters 'control-8-bit) | |
1155 | (string-as-multibyte "[^\040-\176\240-\377]")) | |
1156 | ((eq ps-print-control-characters 'control) | |
1157 | (string-as-multibyte "[^\040-\176\200-\377]")) | |
1158 | (t (string-as-multibyte "[^\000-\011\013\015-\377")))))) | |
1159 | ||
1160 | ;;;###autoload | |
1161 | (defun ps-mule-begin-page () | |
1162 | (setq ps-mule-current-charset 'ascii)) | |
1163 | ||
1164 | ||
1165 | (provide 'ps-mule) | |
1166 | ||
1167 | ;;; ps-mule.el ends here |