Commit | Line | Data |
---|---|---|
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, |
d7a0267c | 4 | ;; 2005, 2006, 2007 Free Software Foundation, Inc. |
2cb842ae | 5 | |
07239461 VJL |
6 | ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br> |
7 | ;; Kenichi Handa <handa@m17n.org> (multi-byte characters) | |
8 | ;; Maintainer: Kenichi Handa <handa@m17n.org> (multi-byte characters) | |
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 | ;; | |
6fb87e51 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 | ;; |
6fb87e51 | 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, | |
6fb87e51 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 | ;; |
6fb87e51 | 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 | ;; | |
6fb87e51 | 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 GM |
93 | (eval-and-compile |
94 | (require 'ps-print) | |
95 | ||
96 | ;; to avoid XEmacs compilation gripes | |
97 | (defvar leading-code-private-22 157) | |
98 | (or (fboundp 'charset-bytes) | |
99 | (defun charset-bytes (charset) 1)) ; ascii | |
100 | (or (fboundp 'charset-dimension) | |
101 | (defun charset-dimension (charset) 1)) ; ascii | |
102 | (or (fboundp 'charset-id) | |
103 | (defun charset-id (charset) 0)) ; ascii | |
104 | (or (fboundp 'charset-width) | |
105 | (defun charset-width (charset) 1)) ; ascii | |
106 | (or (fboundp 'find-charset-region) | |
107 | (defun find-charset-region (beg end &optional table) | |
108 | (list 'ascii))) | |
dc2f8de4 GM |
109 | (or (fboundp 'char-valid-p) |
110 | (defun char-valid-p (char) | |
111 | (< (following-char) 256))) | |
922be019 GM |
112 | (or (fboundp 'split-char) |
113 | (defun split-char (char) | |
114 | (list (if (char-valid-p char) | |
115 | 'ascii | |
116 | 'unknow) | |
117 | char))) | |
118 | (or (fboundp 'char-width) | |
119 | (defun char-width (char) 1)) ; ascii | |
120 | (or (fboundp 'chars-in-region) | |
121 | (defun chars-in-region (beg end) | |
122 | (- (max beg end) (min beg end)))) | |
123 | (or (fboundp 'forward-point) | |
124 | (defun forward-point (arg) | |
125 | (save-excursion | |
126 | (let ((count (abs arg)) | |
127 | (step (if (zerop arg) | |
128 | 0 | |
129 | (/ arg arg)))) | |
130 | (while (and (> count 0) | |
131 | (< (point-min) (point)) (< (point) (point-max))) | |
132 | (forward-char step) | |
133 | (setq count (1- count))) | |
134 | (+ (point) (* count step)))))) | |
135 | (or (fboundp 'decompose-composite-char) | |
136 | (defun decompose-composite-char (char &optional type | |
137 | with-composition-rule) | |
138 | nil)) | |
139 | (or (fboundp 'encode-coding-string) | |
140 | (defun encode-coding-string (string coding-system &optional nocopy) | |
141 | (if nocopy | |
142 | string | |
143 | (copy-sequence string)))) | |
144 | (or (fboundp 'coding-system-p) | |
145 | (defun coding-system-p (obj) nil)) | |
146 | (or (fboundp 'ccl-execute-on-string) | |
147 | (defun ccl-execute-on-string (ccl-prog status str | |
148 | &optional contin unibyte-p) | |
149 | str)) | |
150 | (or (fboundp 'define-ccl-program) | |
151 | (defmacro define-ccl-program (name ccl-program &optional doc) | |
dc2f8de4 GM |
152 | `(defconst ,name nil ,doc))) |
153 | (or (fboundp 'multibyte-string-p) | |
154 | (defun multibyte-string-p (str) | |
155 | (let ((len (length str)) | |
156 | (i 0) | |
157 | multibyte) | |
158 | (while (and (< i len) (not (setq multibyte (> (aref str i) 255)))) | |
159 | (setq i (1+ i))) | |
160 | multibyte))) | |
161 | (or (fboundp 'string-make-multibyte) | |
d0d08a25 EZ |
162 | (defalias 'string-make-multibyte 'copy-sequence)) |
163 | (or (fboundp 'encode-char) | |
164 | (defun encode-char (ch ccs) | |
4abc74e8 | 165 | ch))) |
2cb842ae | 166 | |
c276ee05 | 167 | |
3ea591bd KH |
168 | ;;;###autoload |
169 | (defcustom ps-multibyte-buffer nil | |
6fb87e51 | 170 | "*Specifies the multi-byte buffer handling. |
3ea591bd KH |
171 | |
172 | Valid values are: | |
173 | ||
38f4a790 SM |
174 | nil This is the value to use the default settings; |
175 | by default, this only works to print buffers with | |
176 | only ASCII and Latin characters. But this default | |
177 | setting can be changed by setting the variable | |
3ea591bd KH |
178 | `ps-mule-font-info-database-default' differently. |
179 | The initial value of this variable is | |
180 | `ps-mule-font-info-database-latin' (see | |
181 | documentation). | |
182 | ||
38f4a790 | 183 | `non-latin-printer' This is the value to use when you have a Japanese |
3ea591bd KH |
184 | or Korean PostScript printer and want to print |
185 | buffer with ASCII, Latin-1, Japanese (JISX0208 and | |
186 | JISX0201-Kana) and Korean characters. At present, | |
13d41029 VJL |
187 | it was not tested with the Korean characters |
188 | printing. If you have a korean PostScript printer, | |
189 | please, test it. | |
3ea591bd | 190 | |
38f4a790 | 191 | `bdf-font' This is the value to use when you want to print |
3ea591bd KH |
192 | buffer with BDF fonts. BDF fonts include both latin |
193 | and non-latin fonts. BDF (Bitmap Distribution | |
194 | Format) is a format used for distributing X's font | |
195 | source file. BDF fonts are included in | |
922be019 | 196 | `intlfonts-1.2' which is a collection of X11 fonts |
3ea591bd KH |
197 | for all characters supported by Emacs. In order to |
198 | use this value, be sure to have installed | |
922be019 | 199 | `intlfonts-1.2' and set the variable |
3ea591bd KH |
200 | `bdf-directory-list' appropriately (see ps-bdf.el for |
201 | documentation of this variable). | |
202 | ||
38f4a790 | 203 | `bdf-font-except-latin' This is like `bdf-font' except that it uses |
3ea591bd KH |
204 | PostScript default fonts to print ASCII and Latin-1 |
205 | characters. This is convenient when you want or | |
206 | need to use both latin and non-latin characters on | |
207 | the same buffer. See `ps-font-family', | |
208 | `ps-header-font-family' and `ps-font-info-database'. | |
209 | ||
210 | Any other value is treated as nil." | |
9909b395 GM |
211 | :type '(choice (const non-latin-printer) (const bdf-font) |
212 | (const bdf-font-except-latin) (const :tag "nil" nil)) | |
3ea591bd | 213 | :group 'ps-print-font) |
c276ee05 | 214 | |
2cb842ae KH |
215 | (defvar ps-mule-font-info-database |
216 | nil | |
217 | "Alist of charsets with the corresponding font information. | |
218 | Each element has the form: | |
219 | ||
220 | (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...) | |
221 | ||
222 | Where | |
223 | ||
224 | CHARSET is a charset (symbol) for this font family, | |
225 | ||
226 | FONT-TYPE is a font type: normal, bold, italic, or bold-italic. | |
227 | ||
68fbea3a | 228 | FONT-SRC is a font source: builtin, bdf, vflib, or nil. |
2cb842ae | 229 | |
922be019 | 230 | If FONT-SRC is builtin, FONT-NAME is a built-in PostScript font name. |
2cb842ae | 231 | |
5d5bea97 EZ |
232 | If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of |
233 | alternative font names. To use this font, the external library `ps-bdf' | |
234 | is required. | |
2cb842ae KH |
235 | |
236 | If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows. | |
237 | To use this font, the external library `vflib' is required. | |
238 | ||
239 | If FONT-SRC is nil, a proper ASCII font in the variable | |
240 | `ps-font-info-database' is used. This is useful for Latin-1 characters. | |
241 | ||
242 | ENCODING is a coding system to encode a string of characters of CHARSET into a | |
243 | proper string matching an encoding of the specified font. ENCODING may be a | |
244 | function that does this encoding. In this case, the function is called with | |
245 | one argument, the string to encode, and it should return an encoded string. | |
246 | ||
247 | BYTES specifies how many bytes each character has in the encoded byte | |
248 | sequence; it should be 1 or 2. | |
249 | ||
250 | All multi-byte characters are printed by fonts specified in this database | |
251 | regardless of a font family of ASCII characters. The exception is Latin-1 | |
252 | characters which are printed by the same font as ASCII characters, thus obey | |
253 | font family. | |
254 | ||
255 | See also the variable `ps-font-info-database'.") | |
256 | ||
257 | (defconst ps-mule-font-info-database-latin | |
258 | '((latin-iso8859-1 | |
259 | (normal nil nil iso-latin-1))) | |
260 | "Sample setting of `ps-mule-font-info-database' to use latin fonts.") | |
261 | ||
c276ee05 | 262 | (defcustom ps-mule-font-info-database-default |
2a772306 | 263 | ps-mule-font-info-database-latin |
2c0ebf75 | 264 | "*The default setting to use when `ps-multibyte-buffer' is nil." |
8fdd56af | 265 | :type '(symbol :tag "Multi-Byte Buffer Database Font Default") |
c276ee05 | 266 | :group 'ps-print-font) |
00cbf820 | 267 | |
2cb842ae KH |
268 | (defconst ps-mule-font-info-database-ps |
269 | '((katakana-jisx0201 | |
270 | (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1) | |
271 | (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1) | |
272 | (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)) | |
273 | (latin-jisx0201 | |
f58395f6 | 274 | (normal builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1) |
2cb842ae KH |
275 | (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1)) |
276 | (japanese-jisx0208 | |
277 | (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2) | |
278 | (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2)) | |
279 | (korean-ksc5601 | |
f58395f6 KH |
280 | (normal builtin "Munhwa-Regular-KSC-EUC-H" ps-mule-encode-7bit 2) |
281 | (bold builtin "Munhwa-Bold-KSC-EUC-H" ps-mule-encode-7bit 2)) | |
2cb842ae KH |
282 | ) |
283 | "Sample setting of the `ps-mule-font-info-database' to use builtin PS font. | |
284 | ||
285 | Currently, data for Japanese and Korean PostScript printers are listed.") | |
286 | ||
287 | (defconst ps-mule-font-info-database-bdf | |
288 | '((ascii | |
5d5bea97 | 289 | (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") nil 1) |
fb901f73 KH |
290 | (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") nil 1) |
291 | (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") nil 1) | |
292 | (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") nil 1)) | |
2cb842ae | 293 | (latin-iso8859-1 |
fb901f73 | 294 | (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") iso-latin-1 1) |
5d5bea97 EZ |
295 | (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") iso-latin-1 1) |
296 | (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") iso-latin-1 1) | |
297 | (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") iso-latin-1 1)) | |
2cb842ae | 298 | (latin-iso8859-2 |
5d5bea97 | 299 | (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf") iso-latin-2 1)) |
2cb842ae | 300 | (latin-iso8859-3 |
5d5bea97 | 301 | (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf") iso-latin-3 1)) |
2cb842ae | 302 | (latin-iso8859-4 |
5d5bea97 | 303 | (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf") iso-latin-4 1)) |
2cb842ae | 304 | (thai-tis620 |
5d5bea97 | 305 | (normal bdf ("thai24.bdf" "thai-24.bdf") thai-tis620 1)) |
2cb842ae | 306 | (greek-iso8859-7 |
5d5bea97 | 307 | (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") greek-iso-8bit 1)) |
2cb842ae KH |
308 | ;; (arabic-iso8859-6 nil) ; not yet available |
309 | (hebrew-iso8859-8 | |
5d5bea97 | 310 | (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") hebrew-iso-8bit 1)) |
2cb842ae KH |
311 | (katakana-jisx0201 |
312 | (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1)) | |
313 | (latin-jisx0201 | |
314 | (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1)) | |
315 | (cyrillic-iso8859-5 | |
5d5bea97 | 316 | (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") cyrillic-iso-8bit 1)) |
2cb842ae | 317 | (latin-iso8859-9 |
5d5bea97 | 318 | (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-latin-5 1)) |
2cb842ae KH |
319 | (japanese-jisx0208-1978 |
320 | (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2)) | |
321 | (chinese-gb2312 | |
322 | (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2)) | |
323 | (japanese-jisx0208 | |
324 | (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2)) | |
325 | (korean-ksc5601 | |
326 | (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2)) | |
327 | (japanese-jisx0212 | |
5d5bea97 | 328 | (normal bdf ("jksp40.bdf" "jisksp40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 329 | (chinese-cns11643-1 |
5d5bea97 | 330 | (normal bdf ("cns1-40.bdf" "cns-1-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 331 | (chinese-cns11643-2 |
5d5bea97 | 332 | (normal bdf ("cns2-40.bdf" "cns-2-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae KH |
333 | (chinese-big5-1 |
334 | (normal bdf "taipei24.bdf" chinese-big5 2)) | |
335 | (chinese-big5-2 | |
336 | (normal bdf "taipei24.bdf" chinese-big5 2)) | |
337 | (chinese-sisheng | |
2dedd03c | 338 | (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-7bit 1)) |
2cb842ae | 339 | (ipa |
5d5bea97 | 340 | (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1)) |
2cb842ae | 341 | (vietnamese-viscii-lower |
5d5bea97 | 342 | (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1)) |
2cb842ae | 343 | (vietnamese-viscii-upper |
5d5bea97 | 344 | (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1)) |
2cb842ae | 345 | (arabic-digit |
5d5bea97 | 346 | (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf") ps-mule-encode-7bit 1)) |
2cb842ae | 347 | (arabic-1-column |
5d5bea97 | 348 | (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf") ps-mule-encode-7bit 1)) |
2cb842ae KH |
349 | ;; (ascii-right-to-left nil) ; not yet available |
350 | (lao | |
5d5bea97 | 351 | (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") lao 1)) |
2cb842ae | 352 | (arabic-2-column |
5d5bea97 | 353 | (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1)) |
2cb842ae | 354 | (indian-is13194 |
24c0fd39 | 355 | (normal bdf ("isci24-mule.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1)) |
2cb842ae | 356 | (indian-1-column |
5d5bea97 | 357 | (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 358 | (tibetan-1-column |
5d5bea97 | 359 | (normal bdf ("tib1c24-mule.bdf" "mule-tibmdx-1col-24.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 360 | (ethiopic |
5d5bea97 | 361 | (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") ps-mule-encode-ethiopic 2)) |
2cb842ae | 362 | (chinese-cns11643-3 |
5d5bea97 | 363 | (normal bdf ("cns3-40.bdf" "cns-3-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 364 | (chinese-cns11643-4 |
5d5bea97 | 365 | (normal bdf ("cns4-40.bdf" "cns-4-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 366 | (chinese-cns11643-5 |
5d5bea97 | 367 | (normal bdf ("cns5-40.bdf" "cns-5-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 368 | (chinese-cns11643-6 |
5d5bea97 | 369 | (normal bdf ("cns6-40.bdf" "cns-6-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 370 | (chinese-cns11643-7 |
5d5bea97 | 371 | (normal bdf ("cns7-40.bdf" "cns-7-40.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 372 | (indian-2-column |
5d5bea97 | 373 | (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2)) |
2cb842ae | 374 | (tibetan |
8cf74617 | 375 | (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf") |
d0d08a25 EZ |
376 | ps-mule-encode-7bit 2)) |
377 | (mule-unicode-0100-24ff | |
378 | (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2)) | |
379 | (mule-unicode-2500-33ff | |
380 | (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2)) | |
381 | (mule-unicode-e000-ffff | |
382 | (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2))) | |
2cb842ae KH |
383 | "Sample setting of the `ps-mule-font-info-database' to use BDF fonts. |
384 | BDF (Bitmap Distribution Format) is a format used for distributing X's font | |
385 | source file. | |
386 | ||
d0d08a25 EZ |
387 | Current default value list for BDF fonts is included in `intlfonts-1.2' |
388 | which is a collection of X11 fonts for all characters supported by Emacs. | |
2cb842ae | 389 | |
d0d08a25 EZ |
390 | Using this list as default value to `ps-mule-font-info-database', all |
391 | characters including ASCII and Latin-1 are printed by BDF fonts. | |
2cb842ae KH |
392 | |
393 | See also `ps-mule-font-info-database-ps-bdf'.") | |
394 | ||
395 | (defconst ps-mule-font-info-database-ps-bdf | |
396 | (cons (car ps-mule-font-info-database-latin) | |
397 | (cdr (cdr ps-mule-font-info-database-bdf))) | |
398 | "Sample setting of the `ps-mule-font-info-database' to use BDF fonts. | |
399 | ||
d0d08a25 EZ |
400 | Current default value list for BDF fonts is included in `intlfonts-1.2' |
401 | which is a collection of X11 fonts for all characters supported by Emacs. | |
2cb842ae | 402 | |
d0d08a25 EZ |
403 | Using this list as default value to `ps-mule-font-info-database', all |
404 | characters except ASCII and Latin-1 characters are printed with BDF fonts. | |
405 | ASCII and Latin-1 characters are printed with PostScript font specified | |
406 | by `ps-font-family' and `ps-header-font-family'. | |
2cb842ae KH |
407 | |
408 | See also `ps-mule-font-info-database-bdf'.") | |
409 | ||
410 | ;; Two typical encoding functions for PostScript fonts. | |
411 | ||
412 | (defun ps-mule-encode-7bit (string) | |
413 | (ps-mule-encode-bit string 0)) | |
414 | ||
415 | (defun ps-mule-encode-8bit (string) | |
416 | (ps-mule-encode-bit string 128)) | |
417 | ||
418 | (defun ps-mule-encode-bit (string delta) | |
419 | (let* ((dim (charset-dimension (char-charset (string-to-char string)))) | |
38f4a790 SM |
420 | (len (length string)) |
421 | (str (make-string (* len dim) 0)) | |
2cb842ae KH |
422 | (j 0)) |
423 | (if (= dim 1) | |
38f4a790 SM |
424 | ;; (apply 'string |
425 | ;; (mapcar (lambda (c) (+ (nth 1 (split-char c)) delta)) | |
426 | ;; string)) | |
427 | (dotimes (i len) | |
428 | (aset str i | |
429 | (+ (nth 1 (split-char (aref string i))) delta))) | |
430 | ;; (mapconcat (lambda (c) | |
431 | ;; (let ((split (split-char c))) | |
432 | ;; (string (+ (nth 1 split) delta) | |
433 | ;; (+ (nth 2 split) delta)))) | |
434 | ;; string "") | |
435 | (dotimes (i len) | |
c52da52a | 436 | (let ((split (split-char (aref string i)))) |
2cb842ae KH |
437 | (aset str j (+ (nth 1 split) delta)) |
438 | (aset str (1+ j) (+ (nth 2 split) delta)) | |
38f4a790 | 439 | (setq j (+ j 2))))) |
2cb842ae KH |
440 | str)) |
441 | ||
442 | ;; Special encoding function for Ethiopic. | |
c276ee05 KH |
443 | (if (boundp 'mule-version) ; only if mule package is loaded |
444 | (define-ccl-program ccl-encode-ethio-unicode | |
445 | `(1 | |
446 | ((read r2) | |
447 | (loop | |
448 | (if (r2 == ,leading-code-private-22) | |
449 | ((read r0) | |
450 | (if (r0 == ,(charset-id 'ethiopic)) | |
451 | ((read r1 r2) | |
452 | (r1 &= 127) (r2 &= 127) | |
453 | (call ccl-encode-ethio-font) | |
454 | (write r1) | |
455 | (write-read-repeat r2)) | |
456 | ((write r2 r0) | |
457 | (repeat)))) | |
458 | (write-read-repeat r2)))))) | |
459 | ;; to avoid compilation gripes | |
460 | (defvar ccl-encode-ethio-unicode nil)) | |
461 | ||
38f4a790 SM |
462 | (defalias 'ps-mule-encode-ethiopic |
463 | (if (boundp 'mule-version) | |
464 | ;; Bound mule-version. | |
465 | (lambda (string) | |
466 | (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode) | |
467 | (make-vector 9 nil) | |
468 | string)) | |
469 | ;; Unbound mule-version. | |
470 | #'identity)) | |
2cb842ae | 471 | |
d0d08a25 EZ |
472 | ;; Special encoding for mule-unicode-* characters. |
473 | (defun ps-mule-encode-ucs2 (string) | |
c52da52a | 474 | (let* ((len (length string)) |
d0d08a25 | 475 | (str (make-string (* 2 len) 0)) |
d0d08a25 EZ |
476 | (j 0) |
477 | ch hi lo) | |
38f4a790 | 478 | (dotimes (i len) |
c52da52a | 479 | (setq ch (encode-char (aref string i) 'ucs) |
d0d08a25 EZ |
480 | hi (lsh ch -8) |
481 | lo (logand ch 255)) | |
482 | (aset str j hi) | |
483 | (aset str (1+ j) lo) | |
38f4a790 | 484 | (setq j (+ j 2))) |
d0d08a25 EZ |
485 | str)) |
486 | ||
2cb842ae KH |
487 | ;; A charset which we are now processing. |
488 | (defvar ps-mule-current-charset nil) | |
489 | ||
490 | (defun ps-mule-get-font-spec (charset font-type) | |
491 | "Return FONT-SPEC for printing characters CHARSET with FONT-TYPE. | |
492 | FONT-SPEC is a list that has the form: | |
493 | ||
494 | (FONT-SRC FONT-NAME ENCODING BYTES) | |
495 | ||
496 | FONT-SPEC is extracted from `ps-mule-font-info-database'. | |
497 | ||
498 | See the documentation of `ps-mule-font-info-database' for the meaning of each | |
499 | element of the list." | |
500 | (let ((slot (cdr (assq charset ps-mule-font-info-database)))) | |
501 | (and slot | |
502 | (cdr (or (assq font-type slot) | |
503 | (and (eq font-type 'bold-italic) | |
504 | (or (assq 'bold slot) (assq 'italic slot))) | |
505 | (assq 'normal slot)))))) | |
506 | ||
507 | ;; Functions to access each element of FONT-SPEC. | |
508 | (defsubst ps-mule-font-spec-src (font-spec) (car font-spec)) | |
509 | (defsubst ps-mule-font-spec-name (font-spec) (nth 1 font-spec)) | |
510 | (defsubst ps-mule-font-spec-encoding (font-spec) (nth 2 font-spec)) | |
511 | (defsubst ps-mule-font-spec-bytes (font-spec) (nth 3 font-spec)) | |
512 | ||
513 | (defsubst ps-mule-printable-p (charset) | |
514 | "Non-nil if characters in CHARSET is printable." | |
51bb954e KH |
515 | ;; ASCII and Latin-1 are always printable. |
516 | (or (eq charset 'ascii) | |
517 | (eq charset 'latin-iso8859-1) | |
518 | (ps-mule-get-font-spec charset 'normal))) | |
2cb842ae KH |
519 | |
520 | (defconst ps-mule-external-libraries | |
521 | '((builtin nil nil | |
522 | nil nil nil) | |
2c0ebf75 VJL |
523 | (bdf ps-bdf nil |
524 | bdf-generate-prologue bdf-generate-font bdf-generate-glyphs) | |
525 | (pcf nil nil | |
526 | pcf-generate-prologue pcf-generate-font pcf-generate-glyphs) | |
527 | (vflib nil nil | |
528 | vflib-generate-prologue vflib-generate-font vflib-generate-glyphs)) | |
529 | "Alist of external libraries information to support PostScript printing. | |
2cb842ae KH |
530 | Each element has the form: |
531 | ||
2c0ebf75 VJL |
532 | (FONT-SRC FEATURE INITIALIZED-P |
533 | PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC) | |
2cb842ae KH |
534 | |
535 | FONT-SRC is the font source: builtin, bdf, pcf, or vflib. | |
536 | ||
537 | FEATURE is the feature that provide a facility to handle FONT-SRC. Except for | |
538 | `builtin' FONT-SRC, this feature is automatically `require'd before handling | |
539 | FONT-SRC. Currently, we only have the feature `ps-bdf'. | |
540 | ||
541 | INITIALIZED-P indicates if this library is initialized or not. | |
542 | ||
543 | PROLOGUE-FUNC is a function to generate PostScript code which define several | |
544 | PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is | |
545 | called with no argument, and should return a list of strings. | |
546 | ||
2c0ebf75 VJL |
547 | FONT-FUNC is a function to generate PostScript code which define a new font. |
548 | It is called with one argument FONT-SPEC, and should return a list of strings. | |
2cb842ae KH |
549 | |
550 | GLYPHS-FUNC is a function to generate PostScript code which define glyphs of | |
551 | characters. It is called with three arguments FONT-SPEC, CODE-LIST, and BYTES, | |
552 | and should return a list of strings.") | |
553 | ||
554 | (defun ps-mule-init-external-library (font-spec) | |
555 | "Initialize external library specified by FONT-SPEC for PostScript printing. | |
556 | See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning." | |
557 | (let* ((font-src (ps-mule-font-spec-src font-spec)) | |
558 | (slot (assq font-src ps-mule-external-libraries))) | |
559 | (or (not font-src) | |
560 | (nth 2 slot) | |
561 | (let ((func (nth 3 slot))) | |
562 | (if func | |
563 | (progn | |
d0da93b3 | 564 | (require (nth 1 slot)) |
2cb842ae KH |
565 | (ps-output-prologue (funcall func)))) |
566 | (setcar (nthcdr 2 slot) t))))) | |
567 | ||
568 | ;; Cached glyph information of fonts, alist of: | |
569 | ;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...) | |
570 | ;; cache CODE0 CODE1 ...) | |
571 | (defvar ps-mule-font-cache nil) | |
572 | ||
922be019 GM |
573 | (defun ps-mule-generate-font (font-spec charset &optional header-p) |
574 | "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET. | |
575 | ||
576 | If optional 3rd arg HEADER-P is non-nil, generate codes to define a header | |
577 | font." | |
5d5bea97 EZ |
578 | (let* ((font-name (ps-mule-font-spec-name font-spec)) |
579 | (font-name (if (consp font-name) (car font-name) font-name)) | |
580 | (font-cache (assoc font-name ps-mule-font-cache)) | |
2cb842ae | 581 | (font-src (ps-mule-font-spec-src font-spec)) |
2cb842ae | 582 | (func (nth 4 (assq font-src ps-mule-external-libraries))) |
922be019 GM |
583 | (font-size (if header-p (if (eq ps-current-font 0) |
584 | ps-header-title-font-size-internal | |
585 | ps-header-font-size-internal) | |
586 | ps-font-size-internal)) | |
587 | (current-font (+ ps-current-font (if header-p 10 0))) | |
2cb842ae | 588 | (scaled-font-name |
922be019 GM |
589 | (cond (header-p |
590 | (format "h%d" ps-current-font)) | |
591 | ((eq charset 'ascii) | |
592 | (format "f%d" ps-current-font)) | |
593 | (t | |
594 | (format "f%02x-%d" (charset-id charset) ps-current-font))))) | |
2cb842ae KH |
595 | (and func (not font-cache) |
596 | (ps-output-prologue (funcall func charset font-spec))) | |
597 | (ps-output-prologue | |
598 | (list (format "/%s %f /%s Def%sFontMule\n" | |
922be019 GM |
599 | scaled-font-name font-size font-name |
600 | (if (or header-p | |
601 | (eq ps-mule-current-charset 'ascii)) | |
602 | "Ascii" "")))) | |
2cb842ae KH |
603 | (if font-cache |
604 | (setcar (cdr font-cache) | |
922be019 | 605 | (cons (cons current-font scaled-font-name) |
2cb842ae KH |
606 | (nth 1 font-cache))) |
607 | (setq font-cache (list font-name | |
922be019 | 608 | (list (cons current-font scaled-font-name)) |
2cb842ae KH |
609 | 'cache) |
610 | ps-mule-font-cache (cons font-cache ps-mule-font-cache))) | |
611 | font-cache)) | |
612 | ||
613 | (defun ps-mule-generate-glyphs (font-spec code-list) | |
614 | "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC." | |
615 | (let* ((font-src (ps-mule-font-spec-src font-spec)) | |
616 | (func (nth 5 (assq font-src ps-mule-external-libraries)))) | |
617 | (and func | |
618 | (ps-output-prologue | |
619 | (funcall func font-spec code-list | |
620 | (ps-mule-font-spec-bytes font-spec)))))) | |
621 | ||
922be019 GM |
622 | (defun ps-mule-prepare-font (font-spec string charset |
623 | &optional no-setfont header-p) | |
2cb842ae KH |
624 | "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC. |
625 | ||
626 | The generated code is inserted on prologue part except the code that sets the | |
627 | current font (using PostScript procedure `FM'). | |
628 | ||
922be019 GM |
629 | If optional 4th arg NO-SETFONT is non-nil, don't generate the code for setting |
630 | the current font. | |
631 | ||
632 | If optional 5th arg HEADER-P is non-nil, generate a code for setting a header | |
633 | font." | |
5d5bea97 EZ |
634 | (let* ((font-name (ps-mule-font-spec-name font-spec)) |
635 | (font-name (if (consp font-name) (car font-name) font-name)) | |
922be019 | 636 | (current-font (+ ps-current-font (if header-p 10 0))) |
5d5bea97 | 637 | (font-cache (assoc font-name ps-mule-font-cache))) |
922be019 GM |
638 | (or (and font-cache (assq current-font (nth 1 font-cache))) |
639 | (setq font-cache (ps-mule-generate-font font-spec charset header-p))) | |
2cb842ae | 640 | (or no-setfont |
922be019 | 641 | (let ((new-font (cdr (assq current-font (nth 1 font-cache))))) |
2cb842ae KH |
642 | (or (equal new-font ps-last-font) |
643 | (progn | |
644 | (ps-output (format "/%s FM\n" new-font)) | |
645 | (setq ps-last-font new-font))))) | |
646 | (if (nth 5 (assq (ps-mule-font-spec-src font-spec) | |
647 | ps-mule-external-libraries)) | |
648 | ;; We have to generate PostScript codes which define glyphs. | |
649 | (let* ((cached-codes (nthcdr 2 font-cache)) | |
650 | (bytes (ps-mule-font-spec-bytes font-spec)) | |
651 | (len (length string)) | |
652 | (i 0) | |
653 | newcodes code) | |
654 | (while (< i len) | |
655 | (setq code (if (= bytes 1) | |
656 | (aref string i) | |
657 | (+ (* (aref string i) 256) (aref string (1+ i))))) | |
658 | (or (memq code cached-codes) | |
659 | (progn | |
660 | (setq newcodes (cons code newcodes)) | |
661 | (setcdr cached-codes (cons code (cdr cached-codes))))) | |
662 | (setq i (+ i bytes))) | |
663 | (and newcodes | |
664 | (ps-mule-generate-glyphs font-spec newcodes)))))) | |
665 | ||
666 | ;;;###autoload | |
667 | (defun ps-mule-prepare-ascii-font (string) | |
668 | "Setup special ASCII font for STRING. | |
669 | STRING should contain only ASCII characters." | |
670 | (let ((font-spec | |
671 | (ps-mule-get-font-spec | |
672 | 'ascii | |
673 | (car (nth ps-current-font (ps-font-alist 'ps-font-for-text)))))) | |
674 | (and font-spec | |
675 | (ps-mule-prepare-font font-spec string 'ascii)))) | |
676 | ||
677 | ;;;###autoload | |
678 | (defun ps-mule-set-ascii-font () | |
679 | (unless (eq ps-mule-current-charset 'ascii) | |
680 | (ps-set-font ps-current-font) | |
681 | (setq ps-mule-current-charset 'ascii))) | |
682 | ||
683 | ;; List of charsets of multi-byte characters in a text being printed. | |
684 | ;; If the text doesn't contain any multi-byte characters (i.e. only ASCII), | |
685 | ;; the value is nil. | |
686 | (defvar ps-mule-charset-list nil) | |
687 | ||
688 | ;; This is a PostScript code inserted in the header of generated PostScript. | |
689 | (defconst ps-mule-prologue | |
690 | "%%%% Start of Mule Section | |
691 | ||
692 | %% Working dictionary for general use. | |
693 | /MuleDict 10 dict def | |
694 | ||
bc4c1aae KH |
695 | %% Adjust /RelativeCompose properly by checking /BaselineOffset. |
696 | /AdjustRelativeCompose { % fontdict |- fontdict | |
697 | dup length 2 add dict begin | |
698 | { 1 index /FID ne { def } { pop pop } ifelse } forall | |
699 | currentdict /BaselineOffset known { | |
922be019 | 700 | BaselineOffset false eq { /BaselineOffset 0 def } if |
bc4c1aae KH |
701 | } { |
702 | /BaselineOffset 0 def | |
703 | } ifelse | |
704 | currentdict /RelativeCompose known not { | |
b77e0a82 | 705 | /RelativeCompose [ 0 0.1 ] def |
bc4c1aae KH |
706 | } { |
707 | RelativeCompose false ne { | |
3ea591bd KH |
708 | [ BaselineOffset RelativeCompose BaselineOffset add |
709 | [ FontMatrix { FontSize div } forall ] transform ] | |
710 | /RelativeCompose exch def | |
bc4c1aae KH |
711 | } if |
712 | } ifelse | |
713 | currentdict | |
714 | end | |
715 | } def | |
716 | ||
2cb842ae KH |
717 | %% Define already scaled font for non-ASCII character sets. |
718 | /DefFontMule { % fontname size basefont |- -- | |
bc4c1aae | 719 | findfont exch scalefont AdjustRelativeCompose definefont pop |
2cb842ae KH |
720 | } bind def |
721 | ||
722 | %% Define already scaled font for ASCII character sets. | |
723 | /DefAsciiFontMule { % fontname size basefont |- | |
724 | MuleDict begin | |
725 | findfont dup /Encoding get /ISOLatin1Encoding exch def | |
bc4c1aae | 726 | exch scalefont AdjustRelativeCompose reencodeFontISO |
2cb842ae KH |
727 | end |
728 | } def | |
729 | ||
d0da93b3 KH |
730 | /CurrentFont false def |
731 | ||
732 | %% Set the specified font to use. | |
733 | %% For non-ASCII font, don't install Ascent, etc. | |
2cb842ae | 734 | /FM { % fontname |- -- |
d0da93b3 KH |
735 | /font exch def |
736 | font /f0 eq font /f1 eq font /f2 eq font /f3 eq or or or { | |
737 | font F | |
738 | } { | |
739 | font findfont setfont | |
740 | } ifelse | |
2cb842ae KH |
741 | } bind def |
742 | ||
743 | %% Show vacant box for characters which don't have appropriate font. | |
744 | /SB { % count column |- -- | |
745 | SpaceWidth mul /w exch def | |
746 | 1 exch 1 exch { %for | |
747 | pop | |
748 | gsave | |
749 | 0 setlinewidth | |
750 | 0 Descent rmoveto w 0 rlineto | |
751 | 0 LineHeight rlineto w neg 0 rlineto closepath stroke | |
752 | grestore | |
753 | w 0 rmoveto | |
754 | } for | |
755 | } bind def | |
756 | ||
d0da93b3 KH |
757 | %% Flag to tell if we are now handling a composition. This is |
758 | %% defined here because both composition handler and bitmap font | |
2cb842ae | 759 | %% handler require it. |
d0da93b3 | 760 | /Composing false def |
2cb842ae KH |
761 | |
762 | %%%% End of Mule Section | |
763 | ||
764 | " | |
765 | "PostScript code for printing multi-byte characters.") | |
766 | ||
767 | (defvar ps-mule-prologue-generated nil) | |
768 | ||
769 | (defun ps-mule-prologue-generated () | |
770 | (unless ps-mule-prologue-generated | |
771 | (ps-output-prologue ps-mule-prologue) | |
772 | (setq ps-mule-prologue-generated t))) | |
773 | ||
d0da93b3 | 774 | (defun ps-mule-find-wrappoint (from to char-width &optional composition) |
2cb842ae KH |
775 | "Find the longest sequence which is printable in the current line. |
776 | ||
d0da93b3 KH |
777 | The search starts at FROM and goes until TO. |
778 | ||
779 | Optional 4th arg COMPOSITION, if non-nil, is information of | |
780 | composition starting at FROM. | |
781 | ||
922be019 | 782 | If COMPOSITION is nil, it is assumed that all characters between FROM |
d0da93b3 KH |
783 | and TO belong to a charset in `ps-mule-current-charset'. Otherwise, |
784 | it is assumed that all characters between FROM and TO belong to the | |
785 | same composition. | |
2cb842ae KH |
786 | |
787 | CHAR-WIDTH is the average width of ASCII characters in the current font. | |
788 | ||
789 | Returns the value: | |
790 | ||
791 | (ENDPOS . RUN-WIDTH) | |
792 | ||
793 | Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of | |
794 | the sequence." | |
d0da93b3 | 795 | (if (or composition (eq ps-mule-current-charset 'composition)) |
2cb842ae | 796 | ;; We must draw one char by one. |
d0da93b3 KH |
797 | (let ((run-width (if composition |
798 | (nth 5 composition) | |
799 | (* (char-width (char-after from)) char-width)))) | |
2cb842ae KH |
800 | (if (> run-width ps-width-remaining) |
801 | (cons from ps-width-remaining) | |
d0da93b3 KH |
802 | (cons (if composition |
803 | (nth 1 composition) | |
c52da52a | 804 | (1+ from)) |
d0da93b3 | 805 | run-width))) |
2cb842ae KH |
806 | ;; We assume that all characters in this range have the same width. |
807 | (setq char-width (* char-width (charset-width ps-mule-current-charset))) | |
3e621022 | 808 | (let ((run-width (* (abs (- from to)) char-width))) |
2cb842ae KH |
809 | (if (> run-width ps-width-remaining) |
810 | (cons (min to | |
811 | (save-excursion | |
812 | (goto-char from) | |
813 | (forward-point | |
814 | (truncate (/ ps-width-remaining char-width))))) | |
815 | ps-width-remaining) | |
816 | (cons to run-width))))) | |
817 | ||
818 | ;;;###autoload | |
819 | (defun ps-mule-plot-string (from to &optional bg-color) | |
922be019 | 820 | "Generate PostScript code for plotting characters in the region FROM and TO. |
2cb842ae KH |
821 | |
822 | It is assumed that all characters in this region belong to the same charset. | |
823 | ||
824 | Optional argument BG-COLOR specifies background color. | |
825 | ||
826 | Returns the value: | |
827 | ||
828 | (ENDPOS . RUN-WIDTH) | |
829 | ||
830 | Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of | |
831 | the sequence." | |
eab4bb89 KH |
832 | (let ((ch (char-after from))) |
833 | (setq ps-mule-current-charset | |
834 | (char-charset (or (aref ps-print-translation-table ch) ch)))) | |
2cb842ae KH |
835 | (let* ((wrappoint (ps-mule-find-wrappoint |
836 | from to (ps-avg-char-width 'ps-font-for-text))) | |
837 | (to (car wrappoint)) | |
838 | (font-type (car (nth ps-current-font | |
839 | (ps-font-alist 'ps-font-for-text)))) | |
840 | (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)) | |
841 | (string (buffer-substring-no-properties from to))) | |
eab4bb89 KH |
842 | (dotimes (i (length string)) |
843 | (let ((ch (aref ps-print-translation-table (aref string i)))) | |
844 | (if ch | |
845 | (aset string i ch)))) | |
2cb842ae KH |
846 | (cond |
847 | ((= from to) | |
848 | ;; We can't print any more characters in the current line. | |
849 | nil) | |
850 | ||
851 | (font-spec | |
852 | ;; We surely have a font for printing this character set. | |
853 | (ps-output-string (ps-mule-string-encoding font-spec string)) | |
854 | (ps-output " S\n")) | |
855 | ||
856 | ((eq ps-mule-current-charset 'latin-iso8859-1) | |
857 | ;; Latin-1 can be printed by a normal ASCII font. | |
858 | (ps-output-string (ps-mule-string-ascii string)) | |
859 | (ps-output " S\n")) | |
860 | ||
d0da93b3 | 861 | ;; This case is obsolete for Emacs 21. |
2cb842ae | 862 | ((eq ps-mule-current-charset 'composition) |
c52da52a | 863 | (ps-mule-plot-composition from (1+ from) bg-color)) |
2cb842ae KH |
864 | |
865 | (t | |
866 | ;; No way to print this charset. Just show a vacant box of an | |
867 | ;; appropriate width. | |
868 | (ps-output (format "%d %d SB\n" | |
869 | (length string) | |
870 | (if (eq ps-mule-current-charset 'composition) | |
871 | (char-width (char-after from)) | |
872 | (charset-width ps-mule-current-charset)))))) | |
873 | wrappoint)) | |
874 | ||
d0da93b3 KH |
875 | ;;;###autoload |
876 | (defun ps-mule-plot-composition (from to &optional bg-color) | |
922be019 | 877 | "Generate PostScript code for plotting composition in the region FROM and TO. |
d0da93b3 KH |
878 | |
879 | It is assumed that all characters in this region belong to the same | |
880 | composition. | |
881 | ||
882 | Optional argument BG-COLOR specifies background color. | |
883 | ||
884 | Returns the value: | |
885 | ||
886 | (ENDPOS . RUN-WIDTH) | |
887 | ||
888 | Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of | |
889 | the sequence." | |
890 | (let* ((composition (find-composition from nil nil t)) | |
891 | (wrappoint (ps-mule-find-wrappoint | |
892 | from to (ps-avg-char-width 'ps-font-for-text) | |
893 | composition)) | |
894 | (to (car wrappoint)) | |
895 | (font-type (car (nth ps-current-font | |
896 | (ps-font-alist 'ps-font-for-text))))) | |
897 | (if (< from to) | |
898 | ;; We can print this composition in the current line. | |
899 | (let ((components (nth 2 composition))) | |
900 | (ps-mule-plot-components | |
901 | (ps-mule-prepare-font-for-components components font-type) | |
902 | (if (nth 3 composition) "RLC" "RBC")))) | |
903 | wrappoint)) | |
904 | ||
905 | ;; Prepare font of FONT-TYPE for printing COMPONENTS. By side effect, | |
906 | ;; change character elements in COMPONENTS to the form: | |
907 | ;; ENCODED-STRING or (FONTNAME . ENCODED-STRING) | |
908 | ;; and change rule elements to the encoded value (integer). | |
909 | ;; The latter form is used if we much change font for the character. | |
910 | ||
911 | (defun ps-mule-prepare-font-for-components (components font-type) | |
38f4a790 SM |
912 | (dotimes (i (length components)) |
913 | (let ((elt (aref components i))) | |
d0da93b3 KH |
914 | (if (consp elt) |
915 | ;; ELT is a composition rule. | |
916 | (setq elt (encode-composition-rule elt)) | |
917 | ;; ELT is a glyph character. | |
918 | (let* ((charset (char-charset elt)) | |
919 | (font (or (eq charset ps-mule-current-charset) | |
920 | (if (eq charset 'ascii) | |
921 | (format "/f%d" ps-current-font) | |
922 | (format "/f%02x-%d" | |
923 | (charset-id charset) ps-current-font)))) | |
924 | str) | |
925 | (setq ps-mule-current-charset charset | |
926 | str (ps-mule-string-encoding | |
927 | (ps-mule-get-font-spec charset font-type) | |
928 | (char-to-string elt) | |
929 | 'no-setfont)) | |
930 | (if (stringp font) | |
931 | (setq elt (cons font str) ps-last-font font) | |
932 | (setq elt str)))) | |
38f4a790 | 933 | (aset components i elt))) |
d0da93b3 KH |
934 | components) |
935 | ||
936 | (defun ps-mule-plot-components (components tail) | |
937 | (let ((elt (aref components 0)) | |
938 | (len (length components)) | |
939 | (i 1)) | |
940 | (ps-output "[ ") | |
941 | (if (stringp elt) | |
942 | (ps-output-string elt) | |
943 | (ps-output (car elt) " ") | |
944 | (ps-output-string (cdr elt))) | |
945 | (while (< i len) | |
946 | (setq elt (aref components i) i (1+ i)) | |
947 | (ps-output " ") | |
948 | (cond ((stringp elt) | |
949 | (ps-output-string elt)) | |
950 | ((consp elt) | |
951 | (ps-output (car elt) " ") | |
952 | (ps-output-string (cdr elt))) | |
953 | (t ; i.e. (integerp elt) | |
954 | (ps-output (format "%d" elt))))) | |
955 | (ps-output " ] " tail "\n"))) | |
956 | ||
2cb842ae KH |
957 | ;; Composite font support |
958 | ||
d0da93b3 | 959 | (defvar ps-mule-composition-prologue-generated nil) |
2cb842ae | 960 | |
d0da93b3 | 961 | (defconst ps-mule-composition-prologue |
922be019 | 962 | "%%%% Character composition handler |
d0da93b3 | 963 | /RelativeCompositionSkip 0.4 def |
2cb842ae KH |
964 | |
965 | %% Get a bounding box (relative to currentpoint) of STR. | |
966 | /GetPathBox { % str |- -- | |
967 | gsave | |
968 | currentfont /FontType get 3 eq { %ifelse | |
969 | stringwidth pop pop | |
970 | } { | |
bc4c1aae | 971 | currentpoint /y exch def /x exch def |
2cb842ae | 972 | false charpath flattenpath pathbbox |
bc4c1aae KH |
973 | y sub /URY exch def x sub /URX exch def |
974 | y sub /LLY exch def x sub /LLX exch def | |
2cb842ae KH |
975 | } ifelse |
976 | grestore | |
977 | } bind def | |
978 | ||
d0da93b3 KH |
979 | %% Apply effects (underline, strikeout, overline, box) to the |
980 | %% rectangle specified by TOP BOTTOM LEFT RIGHT. | |
981 | /SpecialEffect { % -- |- -- | |
982 | currentpoint dup TOP add /yy exch def BOTTOM add /YY exch def | |
983 | dup LEFT add /xx exch def RIGHT add /XX exch def | |
984 | %% Adjust positions for future shadowing. | |
985 | Effect 8 and 0 ne { | |
986 | /yy yy Yshadow add def | |
987 | /XX XX Xshadow add def | |
988 | } if | |
989 | Effect 1 and 0 ne { UnderlinePosition Hline } if % underline | |
990 | Effect 2 and 0 ne { StrikeoutPosition Hline } if % strikeout | |
991 | Effect 4 and 0 ne { OverlinePosition Hline } if % overline | |
992 | bg { % background | |
993 | true | |
994 | Effect 16 and 0 ne {SpaceBackground doBox} { xx yy XX YY doRect} ifelse | |
995 | } if | |
996 | Effect 16 and 0 ne { false 0 doBox } if % box | |
997 | } def | |
2cb842ae | 998 | |
d0da93b3 KH |
999 | %% Show STR with effects (shadow, outline). |
1000 | /ShowWithEffect { % str |- -- | |
1001 | Effect 8 and 0 ne { dup doShadow } if | |
1002 | Effect 32 and 0 ne { true doOutline } { show } ifelse | |
1003 | } def | |
2cb842ae | 1004 | |
922be019 GM |
1005 | %% Draw COMPONENTS which have the form [ font0? [str0 xoff0 yoff0] ... ]. |
1006 | /ShowComponents { % components |- - | |
d0da93b3 KH |
1007 | LEFT 0 lt { LEFT neg 0 rmoveto } if |
1008 | { | |
1009 | dup type /nametype eq { % font | |
1010 | FM | |
1011 | } { % [ str xoff yoff ] | |
1012 | gsave | |
1013 | aload pop rmoveto ShowWithEffect | |
1014 | grestore | |
1015 | } ifelse | |
1016 | } forall | |
1017 | RIGHT 0 rmoveto | |
1018 | } def | |
1019 | ||
1020 | %% Show relative composition. | |
1021 | /RLC { % [ font0? str0 font1? str1 ... fontN? strN ] |- -- | |
1022 | /components exch def | |
1023 | /Composing true def | |
1024 | /first true def | |
2cb842ae | 1025 | gsave |
d0da93b3 KH |
1026 | [ components { |
1027 | /elt exch def | |
1028 | elt type /nametype eq { % font | |
1029 | elt dup FM | |
1030 | } { first { % first string | |
1031 | /first false def | |
1032 | elt GetPathBox | |
1033 | %% Bounding box of overall glyphs. | |
1034 | /LEFT LLX def | |
1035 | /RIGHT URX def | |
1036 | /TOP URY def | |
1037 | /BOTTOM LLY def | |
1038 | currentfont /RelativeCompose known { | |
1039 | /relative currentfont /RelativeCompose get def | |
2f3a9d50 KH |
1040 | relative false eq { |
1041 | %% Disable relative composition by setting sufficiently low | |
1042 | %% and high positions. | |
1043 | /relative [ -100000 100000 ] def | |
1044 | } if | |
d0da93b3 | 1045 | } { |
d0da93b3 KH |
1046 | /relative [ -100000 100000 ] def |
1047 | } ifelse | |
1048 | [ elt 0 0 ] | |
1049 | } { % other strings | |
1050 | elt GetPathBox | |
1051 | [ elt % str | |
1052 | LLX 0 lt { RIGHT } { 0 } ifelse % xoff | |
1053 | LLY relative 1 get ge { % compose on TOP | |
1054 | TOP LLY sub RelativeCompositionSkip add % yoff | |
1055 | /TOP TOP URY LLY sub add RelativeCompositionSkip add def | |
1056 | } { URY relative 0 get le { % compose under BOTTOM | |
1057 | BOTTOM URY sub RelativeCompositionSkip sub % yoff | |
1058 | /BOTTOM BOTTOM URY LLY sub sub | |
1059 | RelativeCompositionSkip sub def | |
1060 | } { | |
1061 | 0 % yoff | |
1062 | URY TOP gt { /TOP URY def } if | |
1063 | LLY BOTTOM lt { /BOTTOM LLY def } if | |
1064 | } ifelse } ifelse | |
1065 | ] | |
1066 | URX RIGHT gt { /RIGHT URX def } if | |
1067 | } ifelse } ifelse | |
1068 | } forall ] /components exch def | |
2cb842ae | 1069 | grestore |
2cb842ae | 1070 | |
d0da93b3 KH |
1071 | %% Reflect special effects. |
1072 | SpecialEffect | |
1073 | ||
1074 | %% Draw components while ignoring effects other than shadow and outline. | |
1075 | components ShowComponents | |
1076 | /Composing false def | |
1077 | ||
1078 | } def | |
1079 | ||
1080 | %% Show rule-base composition. | |
1081 | /RBC { % [ font0? str0 rule1 font1? str1 rule2 ... strN ] |- -- | |
1082 | /components exch def | |
1083 | /Composing true def | |
1084 | /first true def | |
2cb842ae | 1085 | gsave |
d0da93b3 KH |
1086 | [ components { |
1087 | /elt exch def | |
1088 | elt type /nametype eq { % font | |
1089 | elt dup FM | |
1090 | } { elt type /integertype eq { % rule | |
1091 | %% This RULE decoding should be compatible with macro | |
922be019 | 1092 | %% COMPOSITION_DECODE_RULE in emacs/src/composite.h. |
d0da93b3 KH |
1093 | elt 12 idiv dup 3 mod /grefx exch def 3 idiv /grefy exch def |
1094 | elt 12 mod dup 3 mod /nrefx exch def 3 idiv /nrefy exch def | |
1095 | } { first { % first string | |
1096 | /first false def | |
1097 | elt GetPathBox | |
1098 | %% Bounding box of overall glyphs. | |
1099 | /LEFT LLX def | |
1100 | /RIGHT URX def | |
1101 | /TOP URY def | |
1102 | /BOTTOM LLY def | |
1103 | /WIDTH RIGHT LEFT sub def | |
1104 | [ elt 0 0 ] | |
1105 | } { % other strings | |
1106 | elt GetPathBox | |
1107 | /width URX LLX sub def | |
1108 | /height URY LLY sub def | |
1109 | /left LEFT [ 0 WIDTH 2 div WIDTH ] grefx get add | |
1110 | [ 0 width 2 div width ] nrefx get sub def | |
1111 | /bottom [ TOP 0 BOTTOM TOP BOTTOM add 2 div ] grefy get | |
1112 | [ height LLY neg 0 height 2 div ] nrefy get sub def | |
1113 | %% Update bounding box | |
1114 | left LEFT lt { /LEFT left def } if | |
1115 | left width add RIGHT gt { /RIGHT left width add def } if | |
1116 | /WIDTH RIGHT LEFT sub def | |
1117 | bottom BOTTOM lt { /BOTTOM bottom def } if | |
1118 | bottom height add TOP gt { /TOP bottom height add def } if | |
1119 | [ elt left LLX sub bottom LLY sub ] | |
1120 | } ifelse } ifelse } ifelse | |
1121 | } forall ] /components exch def | |
2cb842ae | 1122 | grestore |
64ed6f71 | 1123 | |
d0da93b3 KH |
1124 | %% Reflect special effects. |
1125 | SpecialEffect | |
64ed6f71 | 1126 | |
d0da93b3 KH |
1127 | %% Draw components while ignoring effects other than shadow and outline. |
1128 | components ShowComponents | |
1129 | ||
1130 | /Composing false def | |
1131 | } def | |
1132 | %%%% End of character composition handler | |
2cb842ae KH |
1133 | |
1134 | " | |
922be019 | 1135 | "PostScript code for printing character composition.") |
2cb842ae KH |
1136 | |
1137 | (defun ps-mule-string-ascii (str) | |
1138 | (ps-set-font ps-current-font) | |
1139 | (string-as-unibyte (encode-coding-string str 'iso-latin-1))) | |
1140 | ||
d0da93b3 | 1141 | ;; Encode STR for a font specified by FONT-SPEC and return the result. |
934dd726 | 1142 | ;; If necessary, it generates the PostScript code for the font and glyphs to |
922be019 GM |
1143 | ;; print STR. If optional 4th arg HEADER-P is non-nil, it is assumed that STR |
1144 | ;; is for headers. | |
1145 | (defun ps-mule-string-encoding (font-spec str &optional no-setfont header-p) | |
2cb842ae KH |
1146 | (let ((encoding (ps-mule-font-spec-encoding font-spec))) |
1147 | (setq str | |
1148 | (string-as-unibyte | |
1149 | (cond ((coding-system-p encoding) | |
1150 | (encode-coding-string str encoding)) | |
1151 | ((functionp encoding) | |
1152 | (funcall encoding str)) | |
1153 | (encoding | |
1154 | (error "Invalid coding system or function: %s" encoding)) | |
1155 | (t | |
1156 | str)))) | |
1157 | (if (ps-mule-font-spec-src font-spec) | |
922be019 GM |
1158 | (ps-mule-prepare-font font-spec str ps-mule-current-charset |
1159 | (or no-setfont header-p) | |
1160 | header-p) | |
d0da93b3 KH |
1161 | (or no-setfont |
1162 | (ps-set-font ps-current-font))) | |
2cb842ae KH |
1163 | str)) |
1164 | ||
1165 | ;; Bitmap font support | |
1166 | ||
1167 | (defvar ps-mule-bitmap-prologue-generated nil) | |
1168 | ||
1169 | (defconst ps-mule-bitmap-prologue | |
1170 | "%%%% Bitmap font handler | |
1171 | ||
1172 | /str7 7 string def % working area | |
1173 | ||
1174 | %% We grow the dictionary one bunch (1024 entries) by one. | |
1175 | /BitmapDictArray 256 array def | |
1176 | /BitmapDictLength 1024 def | |
1177 | /BitmapDictIndex -1 def | |
1178 | ||
1179 | /NewBitmapDict { % -- |- -- | |
1180 | /BitmapDictIndex BitmapDictIndex 1 add def | |
1181 | BitmapDictArray BitmapDictIndex BitmapDictLength dict put | |
1182 | } bind def | |
1183 | ||
1184 | %% Make at least one dictionary. | |
1185 | NewBitmapDict | |
1186 | ||
1187 | /AddBitmap { % gloval-charname bitmap-data |- -- | |
1188 | BitmapDictArray BitmapDictIndex get | |
1189 | dup length BitmapDictLength ge { | |
1190 | pop | |
1191 | NewBitmapDict | |
1192 | BitmapDictArray BitmapDictIndex get | |
1193 | } if | |
1194 | 3 1 roll put | |
1195 | } bind def | |
1196 | ||
1197 | /GetBitmap { % gloval-charname |- bitmap-data | |
1198 | 0 1 BitmapDictIndex { BitmapDictArray exch get begin } for | |
1199 | load | |
1200 | 0 1 BitmapDictIndex { pop end } for | |
1201 | } bind def | |
1202 | ||
1203 | %% Return a global character name which can be used as a key in the | |
1204 | %% bitmap dictionary. | |
1205 | /GlobalCharName { % fontidx code1 code2 |- gloval-charname | |
1206 | exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put | |
1207 | str7 cvn | |
1208 | } bind def | |
1209 | ||
1210 | %% Character code holder for a 2-byte character. | |
1211 | /FirstCode -1 def | |
1212 | ||
1213 | %% Glyph rendering procedure | |
1214 | /BuildGlyphCommon { % fontdict charname |- -- | |
1215 | 1 index /FontDimension get 1 eq { /FirstCode 0 store } if | |
1216 | NameIndexDict exch get % STACK: fontdict charcode | |
1217 | FirstCode 0 lt { %ifelse | |
1218 | %% This is the first byte of a 2-byte character. Just | |
1219 | %% remember it for the moment. | |
1220 | /FirstCode exch store | |
1221 | pop | |
1222 | 0 0 setcharwidth | |
1223 | } { | |
1224 | 1 index /FontSize get /size exch def | |
1225 | 1 index /FontSpaceWidthRatio get /ratio exch def | |
1226 | 1 index /FontIndex get exch FirstCode exch | |
1227 | GlobalCharName GetBitmap /bmp exch def | |
1228 | %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ] | |
d0da93b3 | 1229 | Composing { %ifelse |
2cb842ae KH |
1230 | /FontMatrix get [ exch { size div } forall ] /mtrx exch def |
1231 | bmp 3 get bmp 4 get mtrx transform | |
bc4c1aae | 1232 | /LLY exch def /LLX exch def |
2cb842ae | 1233 | bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform |
bc4c1aae | 1234 | /URY exch def /URX exch def |
2cb842ae KH |
1235 | } { |
1236 | pop | |
1237 | } ifelse | |
1238 | /FirstCode -1 store | |
1239 | ||
e06fd465 | 1240 | bmp 0 get size div 0 % wx wy |
2cb842ae KH |
1241 | setcharwidth % We can't use setcachedevice here. |
1242 | ||
1243 | bmp 1 get 0 gt bmp 2 get 0 gt and { | |
1244 | bmp 1 get bmp 2 get % width height | |
1245 | true % polarity | |
1246 | [ size 0 0 size neg bmp 3 get neg bmp 2 get bmp 4 get add ] % matrix | |
1247 | bmp 5 1 getinterval cvx % datasrc | |
1248 | imagemask | |
1249 | } if | |
1250 | } ifelse | |
1251 | } bind def | |
1252 | ||
1253 | /BuildCharCommon { | |
1254 | 1 index /Encoding get exch get | |
1255 | 1 index /BuildGlyph get exec | |
1256 | } bind def | |
1257 | ||
922be019 | 1258 | %% Bitmap font creator |
2cb842ae KH |
1259 | |
1260 | %% Common Encoding shared by all bitmap fonts. | |
1261 | /EncodingCommon 256 array def | |
1262 | %% Mapping table from character name to character code. | |
1263 | /NameIndexDict 256 dict def | |
1264 | 0 1 255 { %for | |
1265 | /idx exch def | |
1266 | /idxname idx 256 add 16 (XXX) cvrs dup 0 67 put cvn def % `C' == 67 | |
1267 | EncodingCommon idx idxname put | |
1268 | NameIndexDict idxname idx put | |
1269 | } for | |
1270 | ||
1271 | /GlobalFontIndex 0 def | |
1272 | ||
1273 | %% fontname dim col fontsize relative-compose baseline-offset fbbx |- -- | |
1274 | /BitmapFont { | |
1275 | 15 dict begin | |
1276 | /FontBBox exch def | |
1277 | /BaselineOffset exch def | |
1278 | /RelativeCompose exch def | |
1279 | /FontSize exch def | |
1280 | /FontBBox [ FontBBox { FontSize div } forall ] def | |
1281 | FontBBox 2 get FontBBox 0 get sub exch div | |
1282 | /FontSpaceWidthRatio exch def | |
1283 | /FontDimension exch def | |
1284 | /FontIndex GlobalFontIndex def | |
1285 | /FontType 3 def | |
1286 | /FontMatrix matrix def | |
1287 | /Encoding EncodingCommon def | |
1288 | /BuildGlyph { BuildGlyphCommon } def | |
1289 | /BuildChar { BuildCharCommon } def | |
1290 | currentdict end | |
1291 | definefont pop | |
1292 | /GlobalFontIndex GlobalFontIndex 1 add def | |
1293 | } bind def | |
1294 | ||
1295 | %% Define a new bitmap font. | |
1296 | %% fontname dim col fontsize relative-compose baseline-offset fbbx |- -- | |
1297 | /NF { | |
1298 | /fbbx exch def | |
1299 | %% Convert BDF's FontBoundingBox to PostScript's FontBBox | |
1300 | [ fbbx 2 get fbbx 3 get | |
1301 | fbbx 2 get fbbx 0 get add fbbx 3 get fbbx 1 get add ] | |
1302 | BitmapFont | |
1303 | } bind def | |
1304 | ||
1305 | %% Define a glyph for the specified font and character. | |
1306 | /NG { % fontname charcode bitmap-data |- -- | |
1307 | /bmp exch def | |
1308 | exch findfont dup /BaselineOffset get bmp 4 get add bmp exch 4 exch put | |
1309 | /FontIndex get exch | |
1310 | dup 256 idiv exch 256 mod GlobalCharName | |
1311 | bmp AddBitmap | |
1312 | } bind def | |
1313 | %%%% End of bitmap font handler | |
1314 | ||
1315 | ") | |
1316 | ||
1317 | ;; External library support. | |
1318 | ||
1319 | ;; The following three functions are to be called from external | |
1320 | ;; libraries which support bitmap fonts (e.g. `bdf') to get | |
1321 | ;; appropriate PostScript code. | |
1322 | ||
1323 | (defun ps-mule-generate-bitmap-prologue () | |
1324 | (unless ps-mule-bitmap-prologue-generated | |
1325 | (setq ps-mule-bitmap-prologue-generated t) | |
1326 | (list ps-mule-bitmap-prologue))) | |
1327 | ||
1328 | (defun ps-mule-generate-bitmap-font (&rest args) | |
1329 | (list (apply 'format "/%s %d %d %f %S %d %S NF\n" args))) | |
1330 | ||
1331 | (defun ps-mule-generate-bitmap-glyph (font-name code dwidth bbx bitmap) | |
1332 | (format "/%s %d [ %d %d %d %d %d <%s> ] NG\n" | |
1333 | font-name code | |
1334 | dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3) | |
1335 | bitmap)) | |
1336 | ||
1337 | ;; Mule specific initializers. | |
1338 | ||
1339 | ;;;###autoload | |
1340 | (defun ps-mule-initialize () | |
1341 | "Initialize global data for printing multi-byte characters." | |
1342 | (setq ps-mule-font-cache nil | |
1343 | ps-mule-prologue-generated nil | |
d0da93b3 | 1344 | ps-mule-composition-prologue-generated nil |
2cb842ae KH |
1345 | ps-mule-bitmap-prologue-generated nil) |
1346 | (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil)) | |
1347 | ps-mule-external-libraries)) | |
1348 | ||
922be019 GM |
1349 | (defvar ps-mule-header-charsets nil) |
1350 | ||
1351 | ;;;###autoload | |
1352 | (defun ps-mule-encode-header-string (string fonttag) | |
1353 | "Generate PostScript code for ploting STRING by font FONTTAG. | |
1354 | FONTTAG should be a string \"/h0\" or \"/h1\"." | |
8b313639 GM |
1355 | (setq string (cond ((not (stringp string)) |
1356 | "") | |
1357 | ((multibyte-string-p string) | |
1358 | (copy-sequence string)) | |
1359 | (t | |
1360 | (string-make-multibyte string)))) | |
922be019 GM |
1361 | (when ps-mule-header-charsets |
1362 | (if (eq (car ps-mule-header-charsets) 'latin-iso8859-1) | |
1363 | ;; Latin1 characters can be printed by the standard PostScript | |
1364 | ;; font. Converts the other non-ASCII characters to `?'. | |
38f4a790 SM |
1365 | (let ((len (length string))) |
1366 | (dotimes (i len) | |
922be019 | 1367 | (or (memq (char-charset (aref string i)) '(ascii latin-iso8859-1)) |
38f4a790 | 1368 | (aset string i ??))) |
922be019 GM |
1369 | (setq string (encode-coding-string string 'iso-latin-1))) |
1370 | ;; We must prepare a font for the first non-ASCII and non-Latin1 | |
1371 | ;; character in STRING. | |
1372 | (let* ((ps-current-font (if (string= fonttag "/h0") 0 1)) | |
1373 | (ps-mule-current-charset (car ps-mule-header-charsets)) | |
1374 | (font-type (car (nth ps-current-font | |
1375 | (ps-font-alist 'ps-font-for-header)))) | |
1376 | (font-spec (ps-mule-get-font-spec ps-mule-current-charset | |
1377 | font-type))) | |
1378 | (if (or (not font-spec) | |
1379 | (/= (charset-dimension ps-mule-current-charset) 1)) | |
1380 | ;; We don't have a proper font, or we can't print them on | |
1381 | ;; header because this kind of charset is not ASCII | |
1382 | ;; compatible. | |
38f4a790 SM |
1383 | (let ((len (length string))) |
1384 | (dotimes (i len) | |
922be019 GM |
1385 | (or (memq (char-charset (aref string i)) |
1386 | '(ascii latin-iso8859-1)) | |
38f4a790 | 1387 | (aset string i ??))) |
922be019 GM |
1388 | (setq string (encode-coding-string string 'iso-latin-1))) |
1389 | (let ((charsets (list 'ascii (car ps-mule-header-charsets))) | |
38f4a790 SM |
1390 | (len (length string))) |
1391 | (dotimes (i len) | |
922be019 | 1392 | (or (memq (char-charset (aref string i)) charsets) |
38f4a790 | 1393 | (aset string i ??)))) |
922be019 GM |
1394 | (setq string (ps-mule-string-encoding font-spec string nil t)))))) |
1395 | string) | |
1396 | ||
ca69e8aa KH |
1397 | (defun ps-mule-show-warning (charsets from to header-footer-list) |
1398 | (let ((table (make-category-table)) | |
1399 | (buf (current-buffer)) | |
72ab3a72 | 1400 | (max-unprintable-chars 15) |
ca69e8aa KH |
1401 | char-pos-list) |
1402 | (define-category ?u "Unprintable charset" table) | |
1403 | (dolist (cs charsets) | |
1404 | (modify-category-entry (make-char cs) ?u table)) | |
1405 | (with-category-table table | |
1406 | (save-excursion | |
1407 | (goto-char from) | |
72ab3a72 | 1408 | (while (and (<= (length char-pos-list) max-unprintable-chars) |
ca69e8aa | 1409 | (re-search-forward "\\cu" to t)) |
070860c3 KH |
1410 | (or (aref ps-print-translation-table (preceding-char)) |
1411 | (push (cons (preceding-char) (1- (point))) char-pos-list))))) | |
ca69e8aa KH |
1412 | (with-output-to-temp-buffer "*Warning*" |
1413 | (with-current-buffer standard-output | |
1414 | (when char-pos-list | |
1415 | (let ((func #'(lambda (buf pos) | |
1416 | (when (buffer-live-p buf) | |
1417 | (pop-to-buffer buf) | |
72ab3a72 KH |
1418 | (goto-char pos)))) |
1419 | (more nil)) | |
1420 | (if (>= (length char-pos-list) max-unprintable-chars) | |
1421 | (setq char-pos-list (cdr char-pos-list) | |
1422 | more t)) | |
ca69e8aa | 1423 | (insert "These characters in the buffer can't be printed:\n") |
72ab3a72 | 1424 | (dolist (elt (nreverse char-pos-list)) |
ca69e8aa KH |
1425 | (insert " ") |
1426 | (insert-text-button (string (car elt)) | |
1427 | :type 'help-xref | |
1428 | 'help-echo | |
1429 | "mouse-2, RET: jump to this character" | |
1430 | 'help-function func | |
1431 | 'help-args (list buf (cdr elt))) | |
1432 | (insert ",")) | |
72ab3a72 KH |
1433 | (if more |
1434 | (insert " and more...") | |
1435 | ;; Delete the last comma. | |
1436 | (delete-char -1)) | |
ca69e8aa KH |
1437 | (insert "\nClick them to jump to the buffer position,\n" |
1438 | (substitute-command-keys "\ | |
1439 | or \\[universal-argument] \\[what-cursor-position] will give information about them.\n")))) | |
1440 | ||
1441 | (with-category-table table | |
38f4a790 | 1442 | (let (string-list) |
ca69e8aa KH |
1443 | (dolist (elt header-footer-list) |
1444 | (when (stringp elt) | |
1445 | (when (string-match "\\cu+" elt) | |
1446 | (setq elt (copy-sequence elt)) | |
1447 | (put-text-property (match-beginning 0) (match-end 0) | |
1448 | 'face 'highlight elt) | |
1449 | (while (string-match "\\cu+" elt (match-end 0)) | |
1450 | (put-text-property (match-beginning 0) (match-end 0) | |
1451 | 'face 'highlight elt)) | |
1452 | (push elt string-list)))) | |
1453 | (when string-list | |
1454 | (insert | |
1455 | "These highlighted characters in header/footer can't be printed:\n") | |
1456 | (dolist (elt string-list) | |
1457 | (insert " " elt "\n"))))))))) | |
922be019 | 1458 | |
2cb842ae KH |
1459 | ;;;###autoload |
1460 | (defun ps-mule-begin-job (from to) | |
1461 | "Start printing job for multi-byte chars between FROM and TO. | |
2c0ebf75 | 1462 | It checks if all multi-byte characters in the region are printable or not." |
2cb842ae | 1463 | (setq ps-mule-charset-list nil |
922be019 | 1464 | ps-mule-header-charsets nil |
2cb842ae KH |
1465 | ps-mule-font-info-database |
1466 | (cond ((eq ps-multibyte-buffer 'non-latin-printer) | |
1467 | ps-mule-font-info-database-ps) | |
1468 | ((eq ps-multibyte-buffer 'bdf-font) | |
1469 | ps-mule-font-info-database-bdf) | |
1470 | ((eq ps-multibyte-buffer 'bdf-font-except-latin) | |
1471 | ps-mule-font-info-database-ps-bdf) | |
1472 | (t | |
d7d83b6e | 1473 | ps-mule-font-info-database-default))) |
2cb842ae KH |
1474 | (and (boundp 'enable-multibyte-characters) |
1475 | enable-multibyte-characters | |
1476 | ;; Initialize `ps-mule-charset-list'. If some characters aren't | |
1477 | ;; printable, warn it. | |
ca69e8aa KH |
1478 | (let ((header-footer-list (ps-header-footer-string)) |
1479 | unprintable-charsets) | |
1480 | (setq ps-mule-charset-list | |
1481 | (delq 'ascii (delq 'eight-bit-control | |
1482 | (delq 'eight-bit-graphic | |
eab4bb89 KH |
1483 | (find-charset-region |
1484 | from to ps-print-translation-table)))) | |
ca69e8aa KH |
1485 | ps-mule-header-charsets |
1486 | (delq 'ascii (delq 'eight-bit-control | |
1487 | (delq 'eight-bit-graphic | |
1488 | (find-charset-string | |
1489 | (mapconcat | |
eab4bb89 KH |
1490 | 'identity header-footer-list "") |
1491 | ps-print-translation-table))))) | |
ca69e8aa KH |
1492 | (dolist (cs ps-mule-charset-list) |
1493 | (or (ps-mule-printable-p cs) | |
1494 | (push cs unprintable-charsets))) | |
1495 | (dolist (cs ps-mule-header-charsets) | |
1496 | (or (ps-mule-printable-p cs) | |
1497 | (memq cs unprintable-charsets) | |
1498 | (push cs unprintable-charsets))) | |
1499 | (when unprintable-charsets | |
1500 | (ps-mule-show-warning unprintable-charsets from to | |
1501 | header-footer-list) | |
1502 | (or | |
1503 | (y-or-n-p "Font for some characters not found, continue anyway? ") | |
1504 | (error "Printing cancelled"))) | |
1505 | ||
1506 | (or ps-mule-composition-prologue-generated | |
1507 | (let ((use-composition (nth 2 (find-composition from to)))) | |
1508 | (or use-composition | |
1509 | (let (str) | |
1510 | (while header-footer-list | |
1511 | (setq str (car header-footer-list)) | |
1512 | (if (and (stringp str) | |
1513 | (nth 2 (find-composition 0 (length str) str))) | |
1514 | (setq use-composition t | |
1515 | header-footer-list nil) | |
1516 | (setq header-footer-list (cdr header-footer-list)))))) | |
1517 | (when use-composition | |
1518 | (progn | |
1519 | (ps-mule-prologue-generated) | |
1520 | (ps-output-prologue ps-mule-composition-prologue) | |
1521 | (setq ps-mule-composition-prologue-generated t))))))) | |
2cb842ae KH |
1522 | |
1523 | (setq ps-mule-current-charset 'ascii) | |
1524 | ||
922be019 | 1525 | (if (or ps-mule-charset-list ps-mule-header-charsets) |
ca69e8aa | 1526 | (dolist (elt (append ps-mule-header-charsets ps-mule-charset-list)) |
2cb842ae | 1527 | (ps-mule-prologue-generated) |
ca69e8aa | 1528 | (ps-mule-init-external-library (ps-mule-get-font-spec elt 'normal)))) |
2cb842ae KH |
1529 | |
1530 | ;; If ASCII font is also specified in ps-mule-font-info-database, | |
922be019 | 1531 | ;; use it instead of what specified in ps-font-info-database. |
2cb842ae KH |
1532 | (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal))) |
1533 | (if font-spec | |
1534 | (progn | |
1535 | (ps-mule-prologue-generated) | |
1536 | (ps-mule-init-external-library font-spec) | |
38f4a790 SM |
1537 | (let ((ps-current-font 0)) |
1538 | (dolist (font (ps-font-alist 'ps-font-for-text)) | |
2cb842ae | 1539 | ;; Be sure to download a glyph for SPACE in advance. |
38f4a790 | 1540 | (ps-mule-prepare-font (ps-mule-get-font-spec 'ascii font) |
2cb842ae | 1541 | " " 'ascii 'no-setfont) |
38f4a790 | 1542 | (setq ps-current-font (1+ ps-current-font))))))) |
2cb842ae | 1543 | |
922be019 | 1544 | ;; If the header contains non-ASCII and non-Latin1 characters, prepare a font |
0cf0138e | 1545 | ;; and glyphs for the first occurrence of such characters. |
922be019 | 1546 | (if (and ps-mule-header-charsets |
ca69e8aa KH |
1547 | (not (eq (car ps-mule-header-charsets) 'latin-iso8859-1)) |
1548 | (= (charset-dimension (car ps-mule-header-charsets)) 1)) | |
922be019 GM |
1549 | (let ((font-spec (ps-mule-get-font-spec (car ps-mule-header-charsets) |
1550 | 'normal))) | |
1551 | (if font-spec | |
1552 | ;; Be sure to download glyphs for "0123456789/" in advance for page | |
1553 | ;; numbering. | |
1554 | (let ((ps-current-font 0)) | |
1555 | (ps-mule-prepare-font font-spec "0123456789/" 'ascii t t))))) | |
1556 | ||
2cb842ae KH |
1557 | (if ps-mule-charset-list |
1558 | ;; We must change this regexp for multi-byte buffer. | |
1559 | (setq ps-control-or-escape-regexp | |
1560 | (cond ((eq ps-print-control-characters '8-bit) | |
1561 | "[^\040-\176]") | |
1562 | ((eq ps-print-control-characters 'control-8-bit) | |
1563 | (string-as-multibyte "[^\040-\176\240-\377]")) | |
1564 | ((eq ps-print-control-characters 'control) | |
1565 | (string-as-multibyte "[^\040-\176\200-\377]")) | |
16c1fb84 | 1566 | (t (string-as-multibyte "[^\000-\011\013\015-\377]")))))) |
2cb842ae KH |
1567 | |
1568 | ;;;###autoload | |
1569 | (defun ps-mule-begin-page () | |
1570 | (setq ps-mule-current-charset 'ascii)) | |
1571 | ||
1572 | ||
1573 | (provide 'ps-mule) | |
1574 | ||
413d6d87 SM |
1575 | ;; Local Variables: |
1576 | ;; generated-autoload-file: "ps-print.el" | |
1577 | ;; End: | |
1578 | ||
1579 | ;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe | |
2cb842ae | 1580 | ;;; ps-mule.el ends here |