1 ;;; ps-mule.el --- provide multi-byte character facility to ps-print
3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
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>
10 ;; Keywords: wp, print, PostScript, multibyte, mule
12 ;; This file is part of GNU Emacs.
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)
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.
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., 51 Franklin Street, Fifth Floor,
27 ;; Boston, MA 02110-1301, USA.
31 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
36 ;; This package is used for ps-print to print multi-byte buffer.
38 ;; See also ps-print.el.
41 ;; Printing Multi-byte Buffer
42 ;; --------------------------
44 ;; The variable `ps-multibyte-buffer' specifies the ps-print multi-byte buffer
47 ;; Valid values for `ps-multibyte-buffer' are:
49 ;; nil This is the value to use the default settings which
50 ;; is by default for printing buffer with only ASCII
51 ;; and Latin characters. The default setting can be
52 ;; changed by setting the variable
53 ;; `ps-mule-font-info-database-default' differently.
54 ;; The initial value of this variable is
55 ;; `ps-mule-font-info-database-latin' (see
58 ;; `non-latin-printer' This is the value to use when you have a japanese
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,
62 ;; it was not tested the Korean characters printing.
63 ;; If you have a korean PostScript printer, please,
66 ;; `bdf-font' This is the value to use when you want to print
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
71 ;; `intlfonts-1.2' which is a collection of X11 fonts
72 ;; for all characters supported by Emacs. In order to
73 ;; use this value, be sure to have installed
74 ;; `intlfonts-1.2' and set the variable
75 ;; `bdf-directory-list' appropriately (see ps-bdf.el
76 ;; for documentation of this variable).
78 ;; `bdf-font-except-latin' This is like `bdf-font' except that it is used
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'.
85 ;; Any other value is treated as nil.
87 ;; The default is nil.
89 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
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)
109 (or (fboundp 'char-valid-p)
110 (defun char-valid-p (char)
111 (< (following-char) 256)))
112 (or (fboundp 'split-char)
113 (defun split-char (char)
114 (list (if (char-valid-p 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)
126 (let ((count (abs arg))
127 (step (if (zerop arg)
130 (while (and (> count 0)
131 (< (point-min) (point)) (< (point) (point-max)))
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)
139 (or (fboundp 'encode-coding-string)
140 (defun encode-coding-string (string coding-system &optional nocopy)
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)
150 (or (fboundp 'define-ccl-program)
151 (defmacro define-ccl-program (name ccl-program &optional doc)
152 `(defconst ,name nil ,doc)))
153 (or (fboundp 'multibyte-string-p)
154 (defun multibyte-string-p (str)
155 (let ((len (length str))
158 (while (and (< i len) (not (setq multibyte (> (aref str i) 255))))
161 (or (fboundp 'string-make-multibyte)
162 (defalias 'string-make-multibyte 'copy-sequence))
163 (or (fboundp 'encode-char)
164 (defun encode-char (ch ccs)
169 (defcustom ps-multibyte-buffer nil
170 "Specifies the multi-byte buffer handling.
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
178 `ps-mule-font-info-database-default' differently.
179 The initial value of this variable is
180 `ps-mule-font-info-database-latin' (see
183 `non-latin-printer' This is the value to use when you have a Japanese
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,
187 it was not tested with the Korean characters printing.
188 If you have a korean PostScript printer, please,
191 `bdf-font' This is the value to use when you want to print
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
196 `intlfonts-1.2' which is a collection of X11 fonts
197 for all characters supported by Emacs. In order to
198 use this value, be sure to have installed
199 `intlfonts-1.2' and set the variable
200 `bdf-directory-list' appropriately (see ps-bdf.el for
201 documentation of this variable).
203 `bdf-font-except-latin' This is like `bdf-font' except that it uses
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'.
210 Any other value is treated as nil."
211 :type '(choice (const non-latin-printer) (const bdf-font)
212 (const bdf-font-except-latin) (const :tag "nil" nil))
213 :group 'ps-print-font)
215 (defvar ps-mule-font-info-database
217 "Alist of charsets with the corresponding font information.
218 Each element has the form:
220 (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...)
224 CHARSET is a charset (symbol) for this font family,
226 FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
228 FONT-SRC is a font source: builtin, bdf, vflib, or nil.
230 If FONT-SRC is builtin, FONT-NAME is a built-in PostScript font name.
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'
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.
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.
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.
247 BYTES specifies how many bytes each character has in the encoded byte
248 sequence; it should be 1 or 2.
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
255 See also the variable `ps-font-info-database'.")
257 (defconst ps-mule-font-info-database-latin
259 (normal nil nil iso-latin-1)))
260 "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
262 (defcustom ps-mule-font-info-database-default
263 ps-mule-font-info-database-latin
264 "The default setting to use when `ps-multibyte-buffer' is nil."
265 :type '(symbol :tag "Multi-Byte Buffer Database Font Default")
266 :group 'ps-print-font)
268 (defconst ps-mule-font-info-database-ps
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))
274 (normal builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)
275 (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1))
277 (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2)
278 (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2))
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))
283 "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
285 Currently, data for Japanese and Korean PostScript printers are listed.")
287 (defconst ps-mule-font-info-database-bdf
289 (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") nil 1)
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))
294 (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") iso-latin-1 1)
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))
299 (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf") iso-latin-2 1))
301 (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf") iso-latin-3 1))
303 (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf") iso-latin-4 1))
305 (normal bdf ("thai24.bdf" "thai-24.bdf") thai-tis620 1))
307 (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") greek-iso-8bit 1))
308 ;; (arabic-iso8859-6 nil) ; not yet available
310 (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") hebrew-iso-8bit 1))
312 (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1))
314 (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1))
316 (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") cyrillic-iso-8bit 1))
318 (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-latin-5 1))
319 (japanese-jisx0208-1978
320 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
322 (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2))
324 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
326 (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2))
328 (normal bdf ("jksp40.bdf" "jisksp40.bdf") ps-mule-encode-7bit 2))
330 (normal bdf ("cns1-40.bdf" "cns-1-40.bdf") ps-mule-encode-7bit 2))
332 (normal bdf ("cns2-40.bdf" "cns-2-40.bdf") ps-mule-encode-7bit 2))
334 (normal bdf "taipei24.bdf" chinese-big5 2))
336 (normal bdf "taipei24.bdf" chinese-big5 2))
338 (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-7bit 1))
340 (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1))
341 (vietnamese-viscii-lower
342 (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1))
343 (vietnamese-viscii-upper
344 (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1))
346 (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf") ps-mule-encode-7bit 1))
348 (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf") ps-mule-encode-7bit 1))
349 ;; (ascii-right-to-left nil) ; not yet available
351 (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") lao 1))
353 (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1))
355 (normal bdf ("isci24-mule.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1))
357 (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2))
359 (normal bdf ("tib1c24-mule.bdf" "mule-tibmdx-1col-24.bdf") ps-mule-encode-7bit 2))
361 (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") ps-mule-encode-ethiopic 2))
363 (normal bdf ("cns3-40.bdf" "cns-3-40.bdf") ps-mule-encode-7bit 2))
365 (normal bdf ("cns4-40.bdf" "cns-4-40.bdf") ps-mule-encode-7bit 2))
367 (normal bdf ("cns5-40.bdf" "cns-5-40.bdf") ps-mule-encode-7bit 2))
369 (normal bdf ("cns6-40.bdf" "cns-6-40.bdf") ps-mule-encode-7bit 2))
371 (normal bdf ("cns7-40.bdf" "cns-7-40.bdf") ps-mule-encode-7bit 2))
373 (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2))
375 (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf")
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)))
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
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.
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.
393 See also `ps-mule-font-info-database-ps-bdf'.")
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.
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.
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'.
408 See also `ps-mule-font-info-database-bdf'.")
410 ;; Two typical encoding functions for PostScript fonts.
412 (defun ps-mule-encode-7bit (string)
413 (ps-mule-encode-bit string 0))
415 (defun ps-mule-encode-8bit (string)
416 (ps-mule-encode-bit string 128))
418 (defun ps-mule-encode-bit (string delta)
419 (let* ((dim (charset-dimension (char-charset (string-to-char string))))
420 (len (length string))
421 (str (make-string (* len dim) 0))
425 ;; (mapcar (lambda (c) (+ (nth 1 (split-char c)) delta))
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))))
436 (let ((split (split-char (aref string i))))
437 (aset str j (+ (nth 1 split) delta))
438 (aset str (1+ j) (+ (nth 2 split) delta))
442 ;; Special encoding function for Ethiopic.
443 (if (boundp 'mule-version) ; only if mule package is loaded
444 (define-ccl-program ccl-encode-ethio-unicode
448 (if (r2 == ,leading-code-private-22)
450 (if (r0 == ,(charset-id 'ethiopic))
452 (r1 &= 127) (r2 &= 127)
453 (call ccl-encode-ethio-font)
455 (write-read-repeat r2))
458 (write-read-repeat r2))))))
459 ;; to avoid compilation gripes
460 (defvar ccl-encode-ethio-unicode nil))
462 (defalias 'ps-mule-encode-ethiopic
463 (if (boundp 'mule-version)
464 ;; Bound mule-version.
466 (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
469 ;; Unbound mule-version.
472 ;; Special encoding for mule-unicode-* characters.
473 (defun ps-mule-encode-ucs2 (string)
474 (let* ((len (length string))
475 (str (make-string (* 2 len) 0))
479 (setq ch (encode-char (aref string i) 'ucs)
487 ;; A charset which we are now processing.
488 (defvar ps-mule-current-charset nil)
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:
494 (FONT-SRC FONT-NAME ENCODING BYTES)
496 FONT-SPEC is extracted from `ps-mule-font-info-database'.
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))))
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))))))
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))
513 (defsubst ps-mule-printable-p (charset)
514 "Non-nil if characters in CHARSET is printable."
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)))
520 (defconst ps-mule-external-libraries
524 bdf-generate-prologue bdf-generate-font bdf-generate-glyphs)
526 pcf-generate-prologue pcf-generate-font pcf-generate-glyphs)
528 vflib-generate-prologue vflib-generate-font vflib-generate-glyphs))
529 "Alist of information of external libraries to support PostScript printing.
530 Each element has the form:
532 (FONT-SRC FEATURE INITIALIZED-P PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC)
534 FONT-SRC is the font source: builtin, bdf, pcf, or vflib.
536 FEATURE is the feature that provide a facility to handle FONT-SRC. Except for
537 `builtin' FONT-SRC, this feature is automatically `require'd before handling
538 FONT-SRC. Currently, we only have the feature `ps-bdf'.
540 INITIALIZED-P indicates if this library is initialized or not.
542 PROLOGUE-FUNC is a function to generate PostScript code which define several
543 PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is
544 called with no argument, and should return a list of strings.
546 FONT-FUNC is a function to generate PostScript code which define a new font. It
547 is called with one argument FONT-SPEC, and should return a list of strings.
549 GLYPHS-FUNC is a function to generate PostScript code which define glyphs of
550 characters. It is called with three arguments FONT-SPEC, CODE-LIST, and BYTES,
551 and should return a list of strings.")
553 (defun ps-mule-init-external-library (font-spec)
554 "Initialize external library specified by FONT-SPEC for PostScript printing.
555 See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning."
556 (let* ((font-src (ps-mule-font-spec-src font-spec))
557 (slot (assq font-src ps-mule-external-libraries)))
560 (let ((func (nth 3 slot)))
563 (require (nth 1 slot))
564 (ps-output-prologue (funcall func))))
565 (setcar (nthcdr 2 slot) t)))))
567 ;; Cached glyph information of fonts, alist of:
568 ;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...)
569 ;; cache CODE0 CODE1 ...)
570 (defvar ps-mule-font-cache nil)
572 (defun ps-mule-generate-font (font-spec charset &optional header-p)
573 "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET.
575 If optional 3rd arg HEADER-P is non-nil, generate codes to define a header
577 (let* ((font-name (ps-mule-font-spec-name font-spec))
578 (font-name (if (consp font-name) (car font-name) font-name))
579 (font-cache (assoc font-name ps-mule-font-cache))
580 (font-src (ps-mule-font-spec-src font-spec))
581 (func (nth 4 (assq font-src ps-mule-external-libraries)))
582 (font-size (if header-p (if (eq ps-current-font 0)
583 ps-header-title-font-size-internal
584 ps-header-font-size-internal)
585 ps-font-size-internal))
586 (current-font (+ ps-current-font (if header-p 10 0)))
589 (format "h%d" ps-current-font))
591 (format "f%d" ps-current-font))
593 (format "f%02x-%d" (charset-id charset) ps-current-font)))))
594 (and func (not font-cache)
595 (ps-output-prologue (funcall func charset font-spec)))
597 (list (format "/%s %f /%s Def%sFontMule\n"
598 scaled-font-name font-size font-name
600 (eq ps-mule-current-charset 'ascii))
603 (setcar (cdr font-cache)
604 (cons (cons current-font scaled-font-name)
606 (setq font-cache (list font-name
607 (list (cons current-font scaled-font-name))
609 ps-mule-font-cache (cons font-cache ps-mule-font-cache)))
612 (defun ps-mule-generate-glyphs (font-spec code-list)
613 "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC."
614 (let* ((font-src (ps-mule-font-spec-src font-spec))
615 (func (nth 5 (assq font-src ps-mule-external-libraries))))
618 (funcall func font-spec code-list
619 (ps-mule-font-spec-bytes font-spec))))))
621 (defun ps-mule-prepare-font (font-spec string charset
622 &optional no-setfont header-p)
623 "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC.
625 The generated code is inserted on prologue part except the code that sets the
626 current font (using PostScript procedure `FM').
628 If optional 4th arg NO-SETFONT is non-nil, don't generate the code for setting
631 If optional 5th arg HEADER-P is non-nil, generate a code for setting a header
633 (let* ((font-name (ps-mule-font-spec-name font-spec))
634 (font-name (if (consp font-name) (car font-name) font-name))
635 (current-font (+ ps-current-font (if header-p 10 0)))
636 (font-cache (assoc font-name ps-mule-font-cache)))
637 (or (and font-cache (assq current-font (nth 1 font-cache)))
638 (setq font-cache (ps-mule-generate-font font-spec charset header-p)))
640 (let ((new-font (cdr (assq current-font (nth 1 font-cache)))))
641 (or (equal new-font ps-last-font)
643 (ps-output (format "/%s FM\n" new-font))
644 (setq ps-last-font new-font)))))
645 (if (nth 5 (assq (ps-mule-font-spec-src font-spec)
646 ps-mule-external-libraries))
647 ;; We have to generate PostScript codes which define glyphs.
648 (let* ((cached-codes (nthcdr 2 font-cache))
649 (bytes (ps-mule-font-spec-bytes font-spec))
650 (len (length string))
654 (setq code (if (= bytes 1)
656 (+ (* (aref string i) 256) (aref string (1+ i)))))
657 (or (memq code cached-codes)
659 (setq newcodes (cons code newcodes))
660 (setcdr cached-codes (cons code (cdr cached-codes)))))
661 (setq i (+ i bytes)))
663 (ps-mule-generate-glyphs font-spec newcodes))))))
666 (defun ps-mule-prepare-ascii-font (string)
667 "Setup special ASCII font for STRING.
668 STRING should contain only ASCII characters."
670 (ps-mule-get-font-spec
672 (car (nth ps-current-font (ps-font-alist 'ps-font-for-text))))))
674 (ps-mule-prepare-font font-spec string 'ascii))))
677 (defun ps-mule-set-ascii-font ()
678 (unless (eq ps-mule-current-charset 'ascii)
679 (ps-set-font ps-current-font)
680 (setq ps-mule-current-charset 'ascii)))
682 ;; List of charsets of multi-byte characters in a text being printed.
683 ;; If the text doesn't contain any multi-byte characters (i.e. only ASCII),
685 (defvar ps-mule-charset-list nil)
687 ;; This is a PostScript code inserted in the header of generated PostScript.
688 (defconst ps-mule-prologue
689 "%%%% Start of Mule Section
691 %% Working dictionary for general use.
692 /MuleDict 10 dict def
694 %% Adjust /RelativeCompose properly by checking /BaselineOffset.
695 /AdjustRelativeCompose { % fontdict |- fontdict
696 dup length 2 add dict begin
697 { 1 index /FID ne { def } { pop pop } ifelse } forall
698 currentdict /BaselineOffset known {
699 BaselineOffset false eq { /BaselineOffset 0 def } if
701 /BaselineOffset 0 def
703 currentdict /RelativeCompose known not {
704 /RelativeCompose [ 0 0.1 ] def
706 RelativeCompose false ne {
707 [ BaselineOffset RelativeCompose BaselineOffset add
708 [ FontMatrix { FontSize div } forall ] transform ]
709 /RelativeCompose exch def
716 %% Define already scaled font for non-ASCII character sets.
717 /DefFontMule { % fontname size basefont |- --
718 findfont exch scalefont AdjustRelativeCompose definefont pop
721 %% Define already scaled font for ASCII character sets.
722 /DefAsciiFontMule { % fontname size basefont |-
724 findfont dup /Encoding get /ISOLatin1Encoding exch def
725 exch scalefont AdjustRelativeCompose reencodeFontISO
729 /CurrentFont false def
731 %% Set the specified font to use.
732 %% For non-ASCII font, don't install Ascent, etc.
733 /FM { % fontname |- --
735 font /f0 eq font /f1 eq font /f2 eq font /f3 eq or or or {
738 font findfont setfont
742 %% Show vacant box for characters which don't have appropriate font.
743 /SB { % count column |- --
744 SpaceWidth mul /w exch def
749 0 Descent rmoveto w 0 rlineto
750 0 LineHeight rlineto w neg 0 rlineto closepath stroke
756 %% Flag to tell if we are now handling a composition. This is
757 %% defined here because both composition handler and bitmap font
758 %% handler require it.
761 %%%% End of Mule Section
764 "PostScript code for printing multi-byte characters.")
766 (defvar ps-mule-prologue-generated nil)
768 (defun ps-mule-prologue-generated ()
769 (unless ps-mule-prologue-generated
770 (ps-output-prologue ps-mule-prologue)
771 (setq ps-mule-prologue-generated t)))
773 (defun ps-mule-find-wrappoint (from to char-width &optional composition)
774 "Find the longest sequence which is printable in the current line.
776 The search starts at FROM and goes until TO.
778 Optional 4th arg COMPOSITION, if non-nil, is information of
779 composition starting at FROM.
781 If COMPOSITION is nil, it is assumed that all characters between FROM
782 and TO belong to a charset in `ps-mule-current-charset'. Otherwise,
783 it is assumed that all characters between FROM and TO belong to the
786 CHAR-WIDTH is the average width of ASCII characters in the current font.
792 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
794 (if (or composition (eq ps-mule-current-charset 'composition))
795 ;; We must draw one char by one.
796 (let ((run-width (if composition
798 (* (char-width (char-after from)) char-width))))
799 (if (> run-width ps-width-remaining)
800 (cons from ps-width-remaining)
801 (cons (if composition
805 ;; We assume that all characters in this range have the same width.
806 (setq char-width (* char-width (charset-width ps-mule-current-charset)))
807 (let ((run-width (* (abs (- from to)) char-width)))
808 (if (> run-width ps-width-remaining)
813 (truncate (/ ps-width-remaining char-width)))))
815 (cons to run-width)))))
818 (defun ps-mule-plot-string (from to &optional bg-color)
819 "Generate PostScript code for plotting characters in the region FROM and TO.
821 It is assumed that all characters in this region belong to the same charset.
823 Optional argument BG-COLOR specifies background color.
829 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
831 (let ((ch (char-after from)))
832 (setq ps-mule-current-charset
833 (char-charset (or (aref ps-print-translation-table ch) ch))))
834 (let* ((wrappoint (ps-mule-find-wrappoint
835 from to (ps-avg-char-width 'ps-font-for-text)))
837 (font-type (car (nth ps-current-font
838 (ps-font-alist 'ps-font-for-text))))
839 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))
840 (string (buffer-substring-no-properties from to)))
841 (dotimes (i (length string))
842 (let ((ch (aref ps-print-translation-table (aref string i))))
844 (aset string i ch))))
847 ;; We can't print any more characters in the current line.
851 ;; We surely have a font for printing this character set.
852 (ps-output-string (ps-mule-string-encoding font-spec string))
855 ((eq ps-mule-current-charset 'latin-iso8859-1)
856 ;; Latin-1 can be printed by a normal ASCII font.
857 (ps-output-string (ps-mule-string-ascii string))
860 ;; This case is obsolete for Emacs 21.
861 ((eq ps-mule-current-charset 'composition)
862 (ps-mule-plot-composition from (1+ from) bg-color))
865 ;; No way to print this charset. Just show a vacant box of an
866 ;; appropriate width.
867 (ps-output (format "%d %d SB\n"
869 (if (eq ps-mule-current-charset 'composition)
870 (char-width (char-after from))
871 (charset-width ps-mule-current-charset))))))
875 (defun ps-mule-plot-composition (from to &optional bg-color)
876 "Generate PostScript code for plotting composition in the region FROM and TO.
878 It is assumed that all characters in this region belong to the same
881 Optional argument BG-COLOR specifies background color.
887 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
889 (let* ((composition (find-composition from nil nil t))
890 (wrappoint (ps-mule-find-wrappoint
891 from to (ps-avg-char-width 'ps-font-for-text)
894 (font-type (car (nth ps-current-font
895 (ps-font-alist 'ps-font-for-text)))))
897 ;; We can print this composition in the current line.
898 (let ((components (nth 2 composition)))
899 (ps-mule-plot-components
900 (ps-mule-prepare-font-for-components components font-type)
901 (if (nth 3 composition) "RLC" "RBC"))))
904 ;; Prepare font of FONT-TYPE for printing COMPONENTS. By side effect,
905 ;; change character elements in COMPONENTS to the form:
906 ;; ENCODED-STRING or (FONTNAME . ENCODED-STRING)
907 ;; and change rule elements to the encoded value (integer).
908 ;; The latter form is used if we much change font for the character.
910 (defun ps-mule-prepare-font-for-components (components font-type)
911 (dotimes (i (length components))
912 (let ((elt (aref components i)))
914 ;; ELT is a composition rule.
915 (setq elt (encode-composition-rule elt))
916 ;; ELT is a glyph character.
917 (let* ((charset (char-charset elt))
918 (font (or (eq charset ps-mule-current-charset)
919 (if (eq charset 'ascii)
920 (format "/f%d" ps-current-font)
922 (charset-id charset) ps-current-font))))
924 (setq ps-mule-current-charset charset
925 str (ps-mule-string-encoding
926 (ps-mule-get-font-spec charset font-type)
930 (setq elt (cons font str) ps-last-font font)
932 (aset components i elt)))
935 (defun ps-mule-plot-components (components tail)
936 (let ((elt (aref components 0))
937 (len (length components))
941 (ps-output-string elt)
942 (ps-output (car elt) " ")
943 (ps-output-string (cdr elt)))
945 (setq elt (aref components i) i (1+ i))
948 (ps-output-string elt))
950 (ps-output (car elt) " ")
951 (ps-output-string (cdr elt)))
952 (t ; i.e. (integerp elt)
953 (ps-output (format "%d" elt)))))
954 (ps-output " ] " tail "\n")))
956 ;; Composite font support
958 (defvar ps-mule-composition-prologue-generated nil)
960 (defconst ps-mule-composition-prologue
961 "%%%% Character composition handler
962 /RelativeCompositionSkip 0.4 def
964 %% Get a bounding box (relative to currentpoint) of STR.
965 /GetPathBox { % str |- --
967 currentfont /FontType get 3 eq { %ifelse
970 currentpoint /y exch def /x exch def
971 false charpath flattenpath pathbbox
972 y sub /URY exch def x sub /URX exch def
973 y sub /LLY exch def x sub /LLX exch def
978 %% Apply effects (underline, strikeout, overline, box) to the
979 %% rectangle specified by TOP BOTTOM LEFT RIGHT.
980 /SpecialEffect { % -- |- --
981 currentpoint dup TOP add /yy exch def BOTTOM add /YY exch def
982 dup LEFT add /xx exch def RIGHT add /XX exch def
983 %% Adjust positions for future shadowing.
985 /yy yy Yshadow add def
986 /XX XX Xshadow add def
988 Effect 1 and 0 ne { UnderlinePosition Hline } if % underline
989 Effect 2 and 0 ne { StrikeoutPosition Hline } if % strikeout
990 Effect 4 and 0 ne { OverlinePosition Hline } if % overline
993 Effect 16 and 0 ne {SpaceBackground doBox} { xx yy XX YY doRect} ifelse
995 Effect 16 and 0 ne { false 0 doBox } if % box
998 %% Show STR with effects (shadow, outline).
999 /ShowWithEffect { % str |- --
1000 Effect 8 and 0 ne { dup doShadow } if
1001 Effect 32 and 0 ne { true doOutline } { show } ifelse
1004 %% Draw COMPONENTS which have the form [ font0? [str0 xoff0 yoff0] ... ].
1005 /ShowComponents { % components |- -
1006 LEFT 0 lt { LEFT neg 0 rmoveto } if
1008 dup type /nametype eq { % font
1010 } { % [ str xoff yoff ]
1012 aload pop rmoveto ShowWithEffect
1019 %% Show relative composition.
1020 /RLC { % [ font0? str0 font1? str1 ... fontN? strN ] |- --
1021 /components exch def
1027 elt type /nametype eq { % font
1029 } { first { % first string
1032 %% Bounding box of overall glyphs.
1037 currentfont /RelativeCompose known {
1038 /relative currentfont /RelativeCompose get def
1040 %% Disable relative composition by setting sufficiently low
1041 %% and high positions.
1042 /relative [ -100000 100000 ] def
1045 /relative [ -100000 100000 ] def
1051 LLX 0 lt { RIGHT } { 0 } ifelse % xoff
1052 LLY relative 1 get ge { % compose on TOP
1053 TOP LLY sub RelativeCompositionSkip add % yoff
1054 /TOP TOP URY LLY sub add RelativeCompositionSkip add def
1055 } { URY relative 0 get le { % compose under BOTTOM
1056 BOTTOM URY sub RelativeCompositionSkip sub % yoff
1057 /BOTTOM BOTTOM URY LLY sub sub
1058 RelativeCompositionSkip sub def
1061 URY TOP gt { /TOP URY def } if
1062 LLY BOTTOM lt { /BOTTOM LLY def } if
1065 URX RIGHT gt { /RIGHT URX def } if
1067 } forall ] /components exch def
1070 %% Reflect special effects.
1073 %% Draw components while ignoring effects other than shadow and outline.
1074 components ShowComponents
1075 /Composing false def
1079 %% Show rule-base composition.
1080 /RBC { % [ font0? str0 rule1 font1? str1 rule2 ... strN ] |- --
1081 /components exch def
1087 elt type /nametype eq { % font
1089 } { elt type /integertype eq { % rule
1090 %% This RULE decoding should be compatible with macro
1091 %% COMPOSITION_DECODE_RULE in emacs/src/composite.h.
1092 elt 12 idiv dup 3 mod /grefx exch def 3 idiv /grefy exch def
1093 elt 12 mod dup 3 mod /nrefx exch def 3 idiv /nrefy exch def
1094 } { first { % first string
1097 %% Bounding box of overall glyphs.
1102 /WIDTH RIGHT LEFT sub def
1106 /width URX LLX sub def
1107 /height URY LLY sub def
1108 /left LEFT [ 0 WIDTH 2 div WIDTH ] grefx get add
1109 [ 0 width 2 div width ] nrefx get sub def
1110 /bottom [ TOP 0 BOTTOM TOP BOTTOM add 2 div ] grefy get
1111 [ height LLY neg 0 height 2 div ] nrefy get sub def
1112 %% Update bounding box
1113 left LEFT lt { /LEFT left def } if
1114 left width add RIGHT gt { /RIGHT left width add def } if
1115 /WIDTH RIGHT LEFT sub def
1116 bottom BOTTOM lt { /BOTTOM bottom def } if
1117 bottom height add TOP gt { /TOP bottom height add def } if
1118 [ elt left LLX sub bottom LLY sub ]
1119 } ifelse } ifelse } ifelse
1120 } forall ] /components exch def
1123 %% Reflect special effects.
1126 %% Draw components while ignoring effects other than shadow and outline.
1127 components ShowComponents
1129 /Composing false def
1131 %%%% End of character composition handler
1134 "PostScript code for printing character composition.")
1136 (defun ps-mule-string-ascii (str)
1137 (ps-set-font ps-current-font)
1138 (string-as-unibyte (encode-coding-string str 'iso-latin-1)))
1140 ;; Encode STR for a font specified by FONT-SPEC and return the result.
1141 ;; If necessary, it generates the PostScript code for the font and glyphs to
1142 ;; print STR. If optional 4th arg HEADER-P is non-nil, it is assumed that STR
1144 (defun ps-mule-string-encoding (font-spec str &optional no-setfont header-p)
1145 (let ((encoding (ps-mule-font-spec-encoding font-spec)))
1148 (cond ((coding-system-p encoding)
1149 (encode-coding-string str encoding))
1150 ((functionp encoding)
1151 (funcall encoding str))
1153 (error "Invalid coding system or function: %s" encoding))
1156 (if (ps-mule-font-spec-src font-spec)
1157 (ps-mule-prepare-font font-spec str ps-mule-current-charset
1158 (or no-setfont header-p)
1161 (ps-set-font ps-current-font)))
1164 ;; Bitmap font support
1166 (defvar ps-mule-bitmap-prologue-generated nil)
1168 (defconst ps-mule-bitmap-prologue
1169 "%%%% Bitmap font handler
1171 /str7 7 string def % working area
1173 %% We grow the dictionary one bunch (1024 entries) by one.
1174 /BitmapDictArray 256 array def
1175 /BitmapDictLength 1024 def
1176 /BitmapDictIndex -1 def
1178 /NewBitmapDict { % -- |- --
1179 /BitmapDictIndex BitmapDictIndex 1 add def
1180 BitmapDictArray BitmapDictIndex BitmapDictLength dict put
1183 %% Make at least one dictionary.
1186 /AddBitmap { % gloval-charname bitmap-data |- --
1187 BitmapDictArray BitmapDictIndex get
1188 dup length BitmapDictLength ge {
1191 BitmapDictArray BitmapDictIndex get
1196 /GetBitmap { % gloval-charname |- bitmap-data
1197 0 1 BitmapDictIndex { BitmapDictArray exch get begin } for
1199 0 1 BitmapDictIndex { pop end } for
1202 %% Return a global character name which can be used as a key in the
1203 %% bitmap dictionary.
1204 /GlobalCharName { % fontidx code1 code2 |- gloval-charname
1205 exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put
1209 %% Character code holder for a 2-byte character.
1212 %% Glyph rendering procedure
1213 /BuildGlyphCommon { % fontdict charname |- --
1214 1 index /FontDimension get 1 eq { /FirstCode 0 store } if
1215 NameIndexDict exch get % STACK: fontdict charcode
1216 FirstCode 0 lt { %ifelse
1217 %% This is the first byte of a 2-byte character. Just
1218 %% remember it for the moment.
1219 /FirstCode exch store
1223 1 index /FontSize get /size exch def
1224 1 index /FontSpaceWidthRatio get /ratio exch def
1225 1 index /FontIndex get exch FirstCode exch
1226 GlobalCharName GetBitmap /bmp exch def
1227 %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ]
1229 /FontMatrix get [ exch { size div } forall ] /mtrx exch def
1230 bmp 3 get bmp 4 get mtrx transform
1231 /LLY exch def /LLX exch def
1232 bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform
1233 /URY exch def /URX exch def
1239 bmp 0 get size div 0 % wx wy
1240 setcharwidth % We can't use setcachedevice here.
1242 bmp 1 get 0 gt bmp 2 get 0 gt and {
1243 bmp 1 get bmp 2 get % width height
1245 [ size 0 0 size neg bmp 3 get neg bmp 2 get bmp 4 get add ] % matrix
1246 bmp 5 1 getinterval cvx % datasrc
1253 1 index /Encoding get exch get
1254 1 index /BuildGlyph get exec
1257 %% Bitmap font creator
1259 %% Common Encoding shared by all bitmap fonts.
1260 /EncodingCommon 256 array def
1261 %% Mapping table from character name to character code.
1262 /NameIndexDict 256 dict def
1265 /idxname idx 256 add 16 (XXX) cvrs dup 0 67 put cvn def % `C' == 67
1266 EncodingCommon idx idxname put
1267 NameIndexDict idxname idx put
1270 /GlobalFontIndex 0 def
1272 %% fontname dim col fontsize relative-compose baseline-offset fbbx |- --
1276 /BaselineOffset exch def
1277 /RelativeCompose exch def
1279 /FontBBox [ FontBBox { FontSize div } forall ] def
1280 FontBBox 2 get FontBBox 0 get sub exch div
1281 /FontSpaceWidthRatio exch def
1282 /FontDimension exch def
1283 /FontIndex GlobalFontIndex def
1285 /FontMatrix matrix def
1286 /Encoding EncodingCommon def
1287 /BuildGlyph { BuildGlyphCommon } def
1288 /BuildChar { BuildCharCommon } def
1291 /GlobalFontIndex GlobalFontIndex 1 add def
1294 %% Define a new bitmap font.
1295 %% fontname dim col fontsize relative-compose baseline-offset fbbx |- --
1298 %% Convert BDF's FontBoundingBox to PostScript's FontBBox
1299 [ fbbx 2 get fbbx 3 get
1300 fbbx 2 get fbbx 0 get add fbbx 3 get fbbx 1 get add ]
1304 %% Define a glyph for the specified font and character.
1305 /NG { % fontname charcode bitmap-data |- --
1307 exch findfont dup /BaselineOffset get bmp 4 get add bmp exch 4 exch put
1309 dup 256 idiv exch 256 mod GlobalCharName
1312 %%%% End of bitmap font handler
1316 ;; External library support.
1318 ;; The following three functions are to be called from external
1319 ;; libraries which support bitmap fonts (e.g. `bdf') to get
1320 ;; appropriate PostScript code.
1322 (defun ps-mule-generate-bitmap-prologue ()
1323 (unless ps-mule-bitmap-prologue-generated
1324 (setq ps-mule-bitmap-prologue-generated t)
1325 (list ps-mule-bitmap-prologue)))
1327 (defun ps-mule-generate-bitmap-font (&rest args)
1328 (list (apply 'format "/%s %d %d %f %S %d %S NF\n" args)))
1330 (defun ps-mule-generate-bitmap-glyph (font-name code dwidth bbx bitmap)
1331 (format "/%s %d [ %d %d %d %d %d <%s> ] NG\n"
1333 dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3)
1336 ;; Mule specific initializers.
1339 (defun ps-mule-initialize ()
1340 "Initialize global data for printing multi-byte characters."
1341 (setq ps-mule-font-cache nil
1342 ps-mule-prologue-generated nil
1343 ps-mule-composition-prologue-generated nil
1344 ps-mule-bitmap-prologue-generated nil)
1345 (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil))
1346 ps-mule-external-libraries))
1348 (defvar ps-mule-header-charsets nil)
1351 (defun ps-mule-encode-header-string (string fonttag)
1352 "Generate PostScript code for ploting STRING by font FONTTAG.
1353 FONTTAG should be a string \"/h0\" or \"/h1\"."
1354 (setq string (cond ((not (stringp string))
1356 ((multibyte-string-p string)
1357 (copy-sequence string))
1359 (string-make-multibyte string))))
1360 (when ps-mule-header-charsets
1361 (if (eq (car ps-mule-header-charsets) 'latin-iso8859-1)
1362 ;; Latin1 characters can be printed by the standard PostScript
1363 ;; font. Converts the other non-ASCII characters to `?'.
1364 (let ((len (length string)))
1366 (or (memq (char-charset (aref string i)) '(ascii latin-iso8859-1))
1367 (aset string i ??)))
1368 (setq string (encode-coding-string string 'iso-latin-1)))
1369 ;; We must prepare a font for the first non-ASCII and non-Latin1
1370 ;; character in STRING.
1371 (let* ((ps-current-font (if (string= fonttag "/h0") 0 1))
1372 (ps-mule-current-charset (car ps-mule-header-charsets))
1373 (font-type (car (nth ps-current-font
1374 (ps-font-alist 'ps-font-for-header))))
1375 (font-spec (ps-mule-get-font-spec ps-mule-current-charset
1377 (if (or (not font-spec)
1378 (/= (charset-dimension ps-mule-current-charset) 1))
1379 ;; We don't have a proper font, or we can't print them on
1380 ;; header because this kind of charset is not ASCII
1382 (let ((len (length string)))
1384 (or (memq (char-charset (aref string i))
1385 '(ascii latin-iso8859-1))
1386 (aset string i ??)))
1387 (setq string (encode-coding-string string 'iso-latin-1)))
1388 (let ((charsets (list 'ascii (car ps-mule-header-charsets)))
1389 (len (length string)))
1391 (or (memq (char-charset (aref string i)) charsets)
1392 (aset string i ??))))
1393 (setq string (ps-mule-string-encoding font-spec string nil t))))))
1396 (defun ps-mule-show-warning (charsets from to header-footer-list)
1397 (let ((table (make-category-table))
1398 (buf (current-buffer))
1399 (max-unprintable-chars 15)
1401 (define-category ?u "Unprintable charset" table)
1402 (dolist (cs charsets)
1403 (modify-category-entry (make-char cs) ?u table))
1404 (with-category-table table
1407 (while (and (<= (length char-pos-list) max-unprintable-chars)
1408 (re-search-forward "\\cu" to t))
1409 (or (aref ps-print-translation-table (preceding-char))
1410 (push (cons (preceding-char) (1- (point))) char-pos-list)))))
1411 (with-output-to-temp-buffer "*Warning*"
1412 (with-current-buffer standard-output
1414 (let ((func #'(lambda (buf pos)
1415 (when (buffer-live-p buf)
1419 (if (>= (length char-pos-list) max-unprintable-chars)
1420 (setq char-pos-list (cdr char-pos-list)
1422 (insert "These characters in the buffer can't be printed:\n")
1423 (dolist (elt (nreverse char-pos-list))
1425 (insert-text-button (string (car elt))
1428 "mouse-2, RET: jump to this character"
1430 'help-args (list buf (cdr elt)))
1433 (insert " and more...")
1434 ;; Delete the last comma.
1436 (insert "\nClick them to jump to the buffer position,\n"
1437 (substitute-command-keys "\
1438 or \\[universal-argument] \\[what-cursor-position] will give information about them.\n"))))
1440 (with-category-table table
1442 (dolist (elt header-footer-list)
1444 (when (string-match "\\cu+" elt)
1445 (setq elt (copy-sequence elt))
1446 (put-text-property (match-beginning 0) (match-end 0)
1447 'face 'highlight elt)
1448 (while (string-match "\\cu+" elt (match-end 0))
1449 (put-text-property (match-beginning 0) (match-end 0)
1450 'face 'highlight elt))
1451 (push elt string-list))))
1454 "These highlighted characters in header/footer can't be printed:\n")
1455 (dolist (elt string-list)
1456 (insert " " elt "\n")))))))))
1459 (defun ps-mule-begin-job (from to)
1460 "Start printing job for multi-byte chars between FROM and TO.
1461 This checks if all multi-byte characters in the region are printable or not."
1462 (setq ps-mule-charset-list nil
1463 ps-mule-header-charsets nil
1464 ps-mule-font-info-database
1465 (cond ((eq ps-multibyte-buffer 'non-latin-printer)
1466 ps-mule-font-info-database-ps)
1467 ((eq ps-multibyte-buffer 'bdf-font)
1468 ps-mule-font-info-database-bdf)
1469 ((eq ps-multibyte-buffer 'bdf-font-except-latin)
1470 ps-mule-font-info-database-ps-bdf)
1472 ps-mule-font-info-database-default)))
1473 (and (boundp 'enable-multibyte-characters)
1474 enable-multibyte-characters
1475 ;; Initialize `ps-mule-charset-list'. If some characters aren't
1476 ;; printable, warn it.
1477 (let ((header-footer-list (ps-header-footer-string))
1478 unprintable-charsets)
1479 (setq ps-mule-charset-list
1480 (delq 'ascii (delq 'eight-bit-control
1481 (delq 'eight-bit-graphic
1482 (find-charset-region
1483 from to ps-print-translation-table))))
1484 ps-mule-header-charsets
1485 (delq 'ascii (delq 'eight-bit-control
1486 (delq 'eight-bit-graphic
1487 (find-charset-string
1489 'identity header-footer-list "")
1490 ps-print-translation-table)))))
1491 (dolist (cs ps-mule-charset-list)
1492 (or (ps-mule-printable-p cs)
1493 (push cs unprintable-charsets)))
1494 (dolist (cs ps-mule-header-charsets)
1495 (or (ps-mule-printable-p cs)
1496 (memq cs unprintable-charsets)
1497 (push cs unprintable-charsets)))
1498 (when unprintable-charsets
1499 (ps-mule-show-warning unprintable-charsets from to
1502 (y-or-n-p "Font for some characters not found, continue anyway? ")
1503 (error "Printing cancelled")))
1505 (or ps-mule-composition-prologue-generated
1506 (let ((use-composition (nth 2 (find-composition from to))))
1509 (while header-footer-list
1510 (setq str (car header-footer-list))
1511 (if (and (stringp str)
1512 (nth 2 (find-composition 0 (length str) str)))
1513 (setq use-composition t
1514 header-footer-list nil)
1515 (setq header-footer-list (cdr header-footer-list))))))
1516 (when use-composition
1518 (ps-mule-prologue-generated)
1519 (ps-output-prologue ps-mule-composition-prologue)
1520 (setq ps-mule-composition-prologue-generated t)))))))
1522 (setq ps-mule-current-charset 'ascii)
1524 (if (or ps-mule-charset-list ps-mule-header-charsets)
1525 (dolist (elt (append ps-mule-header-charsets ps-mule-charset-list))
1526 (ps-mule-prologue-generated)
1527 (ps-mule-init-external-library (ps-mule-get-font-spec elt 'normal))))
1529 ;; If ASCII font is also specified in ps-mule-font-info-database,
1530 ;; use it instead of what specified in ps-font-info-database.
1531 (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal)))
1534 (ps-mule-prologue-generated)
1535 (ps-mule-init-external-library font-spec)
1536 (let ((ps-current-font 0))
1537 (dolist (font (ps-font-alist 'ps-font-for-text))
1538 ;; Be sure to download a glyph for SPACE in advance.
1539 (ps-mule-prepare-font (ps-mule-get-font-spec 'ascii font)
1540 " " 'ascii 'no-setfont)
1541 (setq ps-current-font (1+ ps-current-font)))))))
1543 ;; If the header contains non-ASCII and non-Latin1 characters, prepare a font
1544 ;; and glyphs for the first occurrence of such characters.
1545 (if (and ps-mule-header-charsets
1546 (not (eq (car ps-mule-header-charsets) 'latin-iso8859-1))
1547 (= (charset-dimension (car ps-mule-header-charsets)) 1))
1548 (let ((font-spec (ps-mule-get-font-spec (car ps-mule-header-charsets)
1551 ;; Be sure to download glyphs for "0123456789/" in advance for page
1553 (let ((ps-current-font 0))
1554 (ps-mule-prepare-font font-spec "0123456789/" 'ascii t t)))))
1556 (if ps-mule-charset-list
1557 ;; We must change this regexp for multi-byte buffer.
1558 (setq ps-control-or-escape-regexp
1559 (cond ((eq ps-print-control-characters '8-bit)
1561 ((eq ps-print-control-characters 'control-8-bit)
1562 (string-as-multibyte "[^\040-\176\240-\377]"))
1563 ((eq ps-print-control-characters 'control)
1564 (string-as-multibyte "[^\040-\176\200-\377]"))
1565 (t (string-as-multibyte "[^\000-\011\013\015-\377]"))))))
1568 (defun ps-mule-begin-page ()
1569 (setq ps-mule-current-charset 'ascii))
1575 ;; generated-autoload-file: "ps-print.el"
1578 ;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe
1579 ;;; ps-mule.el ends here