1 ;;; ps-mule.el --- Provide multi-byte character facility to ps-print.
3 ;; Copyright (C) 1998 Free Software Foundation, Inc.
5 ;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
6 ;; Author: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
7 ;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
8 ;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
9 ;; Keywords: print, PostScript, multibyte, mule
10 ;; Time-stamp: <99/02/19 13:15:52 vinicius>
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., 59 Temple Place - Suite 330,
27 ;; Boston, MA 02111-1307, 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 when you are printing
50 ;; buffer with only ASCII and Latin characters.
52 ;; `non-latin-printer' This is the value to use when you have a japanese
53 ;; or korean PostScript printer and want to print
54 ;; buffer with ASCII, Latin-1, Japanese (JISX0208 and
55 ;; JISX0201-Kana) and Korean characters. At present,
56 ;; it was not tested the Korean characters printing.
57 ;; If you have a korean PostScript printer, please,
60 ;; `bdf-font' This is the value to use when you want to print
61 ;; buffer with BDF fonts. BDF fonts include both latin
62 ;; and non-latin fonts. BDF (Bitmap Distribution
63 ;; Format) is a format used for distributing X's font
64 ;; source file. BDF fonts are included in
65 ;; `intlfonts-1.1' which is a collection of X11 fonts
66 ;; for all characters supported by Emacs. In order to
67 ;; use this value, be sure to have installed
68 ;; `intlfonts-1.1' and set the variable
69 ;; `bdf-directory-list' appropriately (see ps-bdf.el
70 ;; for documentation of this variable).
72 ;; `bdf-font-except-latin' This is like `bdf-font' except that it is used
73 ;; PostScript default fonts to print ASCII and Latin-1
74 ;; characters. This is convenient when you want or
75 ;; need to use both latin and non-latin characters on
76 ;; the same buffer. See `ps-font-family',
77 ;; `ps-header-font-family' and `ps-font-info-database'.
79 ;; Any other value is treated as nil.
81 ;; The default is nil.
83 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
87 (eval-and-compile (require 'ps-print))
90 (defcustom ps-multibyte-buffer nil
91 "*Specifies the multi-byte buffer handling.
95 nil This is the value to use the default settings which
96 is by default for printing buffer with only ASCII
97 and Latin characters. The default setting can be
98 changed by setting the variable
99 `ps-mule-font-info-database-default' differently.
100 The initial value of this variable is
101 `ps-mule-font-info-database-latin' (which see).
103 `non-latin-printer' This is the value to use when you have a Japanese
104 or Korean PostScript printer and want to print
105 buffer with ASCII, Latin-1, Japanese (JISX0208 and
106 JISX0201-Kana) and Korean characters. At present,
107 it was not tested the Korean characters printing.
108 If you have a korean PostScript printer, please,
111 `bdf-font' This is the value to use when you want to print
112 buffer with BDF fonts. BDF fonts include both latin
113 and non-latin fonts. BDF (Bitmap Distribution
114 Format) is a format used for distributing X's font
115 source file. BDF fonts are included in
116 `intlfonts-1.1' which is a collection of X11 fonts
117 for all characters supported by Emacs. In order to
118 use this value, be sure to have installed
119 `intlfonts-1.1' and set the variable
120 `bdf-directory-list' appropriately (see ps-bdf.el for
121 documentation of this variable).
123 `bdf-font-except-latin' This is like `bdf-font' except that it is used
124 PostScript default fonts to print ASCII and Latin-1
125 characters. This is convenient when you want or
126 need to use both latin and non-latin characters on
127 the same buffer. See `ps-font-family',
128 `ps-header-font-family' and `ps-font-info-database'.
130 Any other value is treated as nil."
131 :type '(choice (const non-latin-printer) (const bdf-font)
132 (const bdf-font-except-latin) (other :tag "nil" nil))
133 :group 'ps-print-font)
135 ;; For Emacs 20.2 and the earlier version.
137 (if (not (string< mule-version "4.0"))
139 (defalias 'ps-mule-next-point '1+)
140 (defalias 'ps-mule-chars-in-string 'length)
141 (defalias 'ps-mule-string-char 'aref)
142 (defsubst ps-mule-next-index (str i) (1+ i)))
143 (defun ps-mule-next-point (arg)
144 (save-excursion (goto-char arg) (forward-char 1) (point)))
145 (defun ps-mule-chars-in-string (string)
147 (charset-bytes (char-charset (string-to-char string)))))
148 (defun ps-mule-string-char (string idx)
149 (string-to-char (substring string idx)))
150 (defun ps-mule-next-index (string i)
151 (+ i (charset-bytes (char-charset (string-to-char string))))))
154 (defvar ps-mule-font-info-database
156 "Alist of charsets with the corresponding font information.
157 Each element has the form:
159 (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...)
163 CHARSET is a charset (symbol) for this font family,
165 FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
167 FONT-SRC is a font source: builtin, ps-bdf, vflib, or nil.
169 If FONT-SRC is builtin, FONT-NAME is a buitin PostScript font name.
171 If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of
172 alternative font names. To use this font, the external library `ps-bdf'
175 If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows.
176 To use this font, the external library `vflib' is required.
178 If FONT-SRC is nil, a proper ASCII font in the variable
179 `ps-font-info-database' is used. This is useful for Latin-1 characters.
181 ENCODING is a coding system to encode a string of characters of CHARSET into a
182 proper string matching an encoding of the specified font. ENCODING may be a
183 function that does this encoding. In this case, the function is called with
184 one argument, the string to encode, and it should return an encoded string.
186 BYTES specifies how many bytes each character has in the encoded byte
187 sequence; it should be 1 or 2.
189 All multi-byte characters are printed by fonts specified in this database
190 regardless of a font family of ASCII characters. The exception is Latin-1
191 characters which are printed by the same font as ASCII characters, thus obey
194 See also the variable `ps-font-info-database'.")
196 (defconst ps-mule-font-info-database-latin
198 (normal nil nil iso-latin-1)))
199 "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
201 (defvar ps-mule-font-info-database-default
202 ps-mule-font-info-database-latin
203 "The default setting to use if `ps-multibyte-buffer' (which see) is nil.")
205 (defconst ps-mule-font-info-database-ps
207 (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1)
208 (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)
209 (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1))
211 (normat builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)
212 (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1))
214 (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2)
215 (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2))
217 (normal builtin "Batang-Medium-KSC-H" ps-mule-encode-7bit 2)
218 (bold builtin " Gulim-Medium-KSC-H" ps-mule-encode-7bit 2))
220 "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
222 Currently, data for Japanese and Korean PostScript printers are listed.")
224 (defconst ps-mule-font-info-database-bdf
226 (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") nil 1)
227 (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") nil 1)
228 (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") nil 1)
229 (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") nil 1))
231 (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") iso-latin-1 1)
232 (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") iso-latin-1 1)
233 (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") iso-latin-1 1)
234 (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") iso-latin-1 1))
236 (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf") iso-latin-2 1))
238 (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf") iso-latin-3 1))
240 (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf") iso-latin-4 1))
242 (normal bdf ("thai24.bdf" "thai-24.bdf") thai-tis620 1))
244 (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") greek-iso-8bit 1))
245 ;; (arabic-iso8859-6 nil) ; not yet available
247 (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") hebrew-iso-8bit 1))
249 (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1))
251 (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1))
253 (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") cyrillic-iso-8bit 1))
255 (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-latin-5 1))
256 (japanese-jisx0208-1978
257 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
259 (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2))
261 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
263 (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2))
265 (normal bdf ("jksp40.bdf" "jisksp40.bdf") ps-mule-encode-7bit 2))
267 (normal bdf ("cns1-40.bdf" "cns-1-40.bdf") ps-mule-encode-7bit 2))
269 (normal bdf ("cns2-40.bdf" "cns-2-40.bdf") ps-mule-encode-7bit 2))
271 (normal bdf "taipei24.bdf" chinese-big5 2))
273 (normal bdf "taipei24.bdf" chinese-big5 2))
275 (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-8bit 1))
277 (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1))
278 (vietnamese-viscii-lower
279 (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1))
280 (vietnamese-viscii-upper
281 (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1))
283 (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf") ps-mule-encode-7bit 1))
285 (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf") ps-mule-encode-7bit 1))
286 ;; (ascii-right-to-left nil) ; not yet available
288 (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") lao 1))
290 (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1))
292 (normal bdf ("isci24-etl.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1))
294 (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2))
296 (normal bdf ("tib1c24-mule.bdf" "mule-tibmdx-1col-24.bdf") ps-mule-encode-7bit 2))
298 (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") ps-mule-encode-ethiopic 2))
300 (normal bdf ("cns3-40.bdf" "cns-3-40.bdf") ps-mule-encode-7bit 2))
302 (normal bdf ("cns4-40.bdf" "cns-4-40.bdf") ps-mule-encode-7bit 2))
304 (normal bdf ("cns5-40.bdf" "cns-5-40.bdf") ps-mule-encode-7bit 2))
306 (normal bdf ("cns6-40.bdf" "cns-6-40.bdf") ps-mule-encode-7bit 2))
308 (normal bdf ("cns7-40.bdf" "cns-7-40.bdf") ps-mule-encode-7bit 2))
310 (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2))
312 (normal bdf ("tib24-mule.bdf" "mule-tibmdx-24.bdf") ps-mule-encode-7bit 2)))
313 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
314 BDF (Bitmap Distribution Format) is a format used for distributing X's font
317 Current default value list for BDF fonts is included in `intlfonts-1.1' which is
318 a collection of X11 fonts for all characters supported by Emacs.
320 Using this list as default value to `ps-mule-font-info-database', all characters
321 including ASCII and Latin-1 are printed by BDF fonts.
323 See also `ps-mule-font-info-database-ps-bdf'.")
325 (defconst ps-mule-font-info-database-ps-bdf
326 (cons (car ps-mule-font-info-database-latin)
327 (cdr (cdr ps-mule-font-info-database-bdf)))
328 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
330 Current default value list for BDF fonts is included in `intlfonts-1.1' which is
331 a collection of X11 fonts for all characters supported by Emacs.
333 Using this list as default value to `ps-mule-font-info-database', all characters
334 except ASCII and Latin-1 characters are printed by BDF fonts. ASCII and Latin-1
335 characters are printed by PostScript font specified by `ps-font-family' and
336 `ps-header-font-family'.
338 See also `ps-mule-font-info-database-bdf'.")
340 ;; Two typical encoding functions for PostScript fonts.
342 (defun ps-mule-encode-7bit (string)
343 (ps-mule-encode-bit string 0))
345 (defun ps-mule-encode-8bit (string)
346 (ps-mule-encode-bit string 128))
348 (defun ps-mule-encode-bit (string delta)
349 (let* ((dim (charset-dimension (char-charset (string-to-char string))))
350 (len (* (ps-mule-chars-in-string string) dim))
351 (str (make-string len 0))
357 (+ (nth 1 (split-char (ps-mule-string-char string i))) delta))
358 (setq i (ps-mule-next-index string i)
361 (let ((split (split-char (ps-mule-string-char string i))))
362 (aset str j (+ (nth 1 split) delta))
363 (aset str (1+ j) (+ (nth 2 split) delta))
364 (setq i (ps-mule-next-index string i)
368 ;; Special encoding function for Ethiopic.
369 (define-ccl-program ccl-encode-ethio-unicode
373 (if (r2 == ,leading-code-private-22)
375 (if (r0 == ,(charset-id 'ethiopic))
377 (r1 &= 127) (r2 &= 127)
378 (call ccl-encode-ethio-font)
380 (write-read-repeat r2))
383 (write-read-repeat r2))))))
385 (defun ps-mule-encode-ethiopic (string)
386 (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
390 ;; A charset which we are now processing.
391 (defvar ps-mule-current-charset nil)
393 (defun ps-mule-get-font-spec (charset font-type)
394 "Return FONT-SPEC for printing characters CHARSET with FONT-TYPE.
395 FONT-SPEC is a list that has the form:
397 (FONT-SRC FONT-NAME ENCODING BYTES)
399 FONT-SPEC is extracted from `ps-mule-font-info-database'.
401 See the documentation of `ps-mule-font-info-database' for the meaning of each
402 element of the list."
403 (let ((slot (cdr (assq charset ps-mule-font-info-database))))
405 (cdr (or (assq font-type slot)
406 (and (eq font-type 'bold-italic)
407 (or (assq 'bold slot) (assq 'italic slot)))
408 (assq 'normal slot))))))
410 ;; Functions to access each element of FONT-SPEC.
411 (defsubst ps-mule-font-spec-src (font-spec) (car font-spec))
412 (defsubst ps-mule-font-spec-name (font-spec) (nth 1 font-spec))
413 (defsubst ps-mule-font-spec-encoding (font-spec) (nth 2 font-spec))
414 (defsubst ps-mule-font-spec-bytes (font-spec) (nth 3 font-spec))
416 (defsubst ps-mule-printable-p (charset)
417 "Non-nil if characters in CHARSET is printable."
418 (ps-mule-get-font-spec charset 'normal))
420 (defconst ps-mule-external-libraries
424 bdf-generate-prologue bdf-generate-font bdf-generate-glyphs)
426 pcf-generate-prologue pcf-generate-font pcf-generate-glyphs)
428 vflib-generate-prologue vflib-generate-font vflib-generate-glyphs))
429 "Alist of information of external libraries to support PostScript printing.
430 Each element has the form:
432 (FONT-SRC FEATURE INITIALIZED-P PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC)
434 FONT-SRC is the font source: builtin, bdf, pcf, or vflib.
436 FEATURE is the feature that provide a facility to handle FONT-SRC. Except for
437 `builtin' FONT-SRC, this feature is automatically `require'd before handling
438 FONT-SRC. Currently, we only have the feature `ps-bdf'.
440 INITIALIZED-P indicates if this library is initialized or not.
442 PROLOGUE-FUNC is a function to generate PostScript code which define several
443 PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is
444 called with no argument, and should return a list of strings.
446 FONT-FUNC is a function to generate PostScript code which define a new font. It
447 is called with one argument FONT-SPEC, and should return a list of strings.
449 GLYPHS-FUNC is a function to generate PostScript code which define glyphs of
450 characters. It is called with three arguments FONT-SPEC, CODE-LIST, and BYTES,
451 and should return a list of strings.")
453 (defun ps-mule-init-external-library (font-spec)
454 "Initialize external library specified by FONT-SPEC for PostScript printing.
455 See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning."
456 (let* ((font-src (ps-mule-font-spec-src font-spec))
457 (slot (assq font-src ps-mule-external-libraries)))
460 (let ((func (nth 3 slot)))
463 (or (featurep (nth 1 slot)) (require (nth 1 slot)))
464 (ps-output-prologue (funcall func))))
465 (setcar (nthcdr 2 slot) t)))))
467 ;; Cached glyph information of fonts, alist of:
468 ;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...)
469 ;; cache CODE0 CODE1 ...)
470 (defvar ps-mule-font-cache nil)
472 (defun ps-mule-generate-font (font-spec charset)
473 "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET."
474 (let* ((font-name (ps-mule-font-spec-name font-spec))
475 (font-name (if (consp font-name) (car font-name) font-name))
476 (font-cache (assoc font-name ps-mule-font-cache))
477 (font-src (ps-mule-font-spec-src font-spec))
478 (func (nth 4 (assq font-src ps-mule-external-libraries)))
480 (if (eq charset 'ascii)
481 (format "f%d" ps-current-font)
483 (charset-id charset) ps-current-font))))
484 (and func (not font-cache)
485 (ps-output-prologue (funcall func charset font-spec)))
487 (list (format "/%s %f /%s Def%sFontMule\n"
488 scaled-font-name ps-font-size-internal font-name
489 (if (eq ps-mule-current-charset 'ascii) "Ascii" ""))))
491 (setcar (cdr font-cache)
492 (cons (cons ps-current-font scaled-font-name)
494 (setq font-cache (list font-name
495 (list (cons ps-current-font scaled-font-name))
497 ps-mule-font-cache (cons font-cache ps-mule-font-cache)))
500 (defun ps-mule-generate-glyphs (font-spec code-list)
501 "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC."
502 (let* ((font-src (ps-mule-font-spec-src font-spec))
503 (func (nth 5 (assq font-src ps-mule-external-libraries))))
506 (funcall func font-spec code-list
507 (ps-mule-font-spec-bytes font-spec))))))
509 (defun ps-mule-prepare-font (font-spec string charset &optional no-setfont)
510 "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC.
512 The generated code is inserted on prologue part except the code that sets the
513 current font (using PostScript procedure `FM').
515 If optional arg NO-SETFONT is non-nil, don't generate the code for setting the
517 (let* ((font-name (ps-mule-font-spec-name font-spec))
518 (font-name (if (consp font-name) (car font-name) font-name))
519 (font-cache (assoc font-name ps-mule-font-cache)))
520 (or (and font-cache (assq ps-current-font (nth 1 font-cache)))
521 (setq font-cache (ps-mule-generate-font font-spec charset)))
523 (let ((new-font (cdr (assq ps-current-font (nth 1 font-cache)))))
524 (or (equal new-font ps-last-font)
526 (ps-output (format "/%s FM\n" new-font))
527 (setq ps-last-font new-font)))))
528 (if (nth 5 (assq (ps-mule-font-spec-src font-spec)
529 ps-mule-external-libraries))
530 ;; We have to generate PostScript codes which define glyphs.
531 (let* ((cached-codes (nthcdr 2 font-cache))
532 (bytes (ps-mule-font-spec-bytes font-spec))
533 (len (length string))
537 (setq code (if (= bytes 1)
539 (+ (* (aref string i) 256) (aref string (1+ i)))))
540 (or (memq code cached-codes)
542 (setq newcodes (cons code newcodes))
543 (setcdr cached-codes (cons code (cdr cached-codes)))))
544 (setq i (+ i bytes)))
546 (ps-mule-generate-glyphs font-spec newcodes))))))
549 (defun ps-mule-prepare-ascii-font (string)
550 "Setup special ASCII font for STRING.
551 STRING should contain only ASCII characters."
553 (ps-mule-get-font-spec
555 (car (nth ps-current-font (ps-font-alist 'ps-font-for-text))))))
557 (ps-mule-prepare-font font-spec string 'ascii))))
560 (defun ps-mule-set-ascii-font ()
561 (unless (eq ps-mule-current-charset 'ascii)
562 (ps-set-font ps-current-font)
563 (setq ps-mule-current-charset 'ascii)))
565 ;; List of charsets of multi-byte characters in a text being printed.
566 ;; If the text doesn't contain any multi-byte characters (i.e. only ASCII),
568 (defvar ps-mule-charset-list nil)
570 ;; This is a PostScript code inserted in the header of generated PostScript.
571 (defconst ps-mule-prologue
572 "%%%% Start of Mule Section
574 %% Working dictionary for general use.
575 /MuleDict 10 dict def
577 %% Define already scaled font for non-ASCII character sets.
578 /DefFontMule { % fontname size basefont |- --
579 findfont exch scalefont definefont pop
582 %% Define already scaled font for ASCII character sets.
583 /DefAsciiFontMule { % fontname size basefont |-
585 findfont dup /Encoding get /ISOLatin1Encoding exch def
586 exch scalefont reencodeFontISO
590 %% Set the specified non-ASCII font to use. It doesn't install
592 /FM { % fontname |- --
596 %% Show vacant box for characters which don't have appropriate font.
597 /SB { % count column |- --
598 SpaceWidth mul /w exch def
603 0 Descent rmoveto w 0 rlineto
604 0 LineHeight rlineto w neg 0 rlineto closepath stroke
610 %% Flag to tell if we are now handling a composite character. This is
611 %% defined here because both composite character handler and bitmap font
612 %% handler require it.
615 %%%% End of Mule Section
618 "PostScript code for printing multi-byte characters.")
620 (defvar ps-mule-prologue-generated nil)
622 (defun ps-mule-prologue-generated ()
623 (unless ps-mule-prologue-generated
624 (ps-output-prologue ps-mule-prologue)
625 (setq ps-mule-prologue-generated t)))
627 (defun ps-mule-find-wrappoint (from to char-width)
628 "Find the longest sequence which is printable in the current line.
630 The search starts at FROM and goes until TO. It is assumed that all characters
631 between FROM and TO belong to a charset in `ps-mule-current-charset'.
633 CHAR-WIDTH is the average width of ASCII characters in the current font.
639 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
641 (if (eq ps-mule-current-charset 'composition)
642 ;; We must draw one char by one.
643 (let ((run-width (* (char-width (char-after from)) char-width)))
644 (if (> run-width ps-width-remaining)
645 (cons from ps-width-remaining)
646 (cons (ps-mule-next-point from) run-width)))
647 ;; We assume that all characters in this range have the same width.
648 (setq char-width (* char-width (charset-width ps-mule-current-charset)))
649 (let ((run-width (* (chars-in-region from to) char-width)))
650 (if (> run-width ps-width-remaining)
655 (truncate (/ ps-width-remaining char-width)))))
657 (cons to run-width)))))
660 (defun ps-mule-plot-string (from to &optional bg-color)
661 "Generate PostScript code for ploting characters in the region FROM and TO.
663 It is assumed that all characters in this region belong to the same charset.
665 Optional argument BG-COLOR specifies background color.
671 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
673 (setq ps-mule-current-charset (charset-after from))
674 (let* ((wrappoint (ps-mule-find-wrappoint
675 from to (ps-avg-char-width 'ps-font-for-text)))
677 (font-type (car (nth ps-current-font
678 (ps-font-alist 'ps-font-for-text))))
679 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))
680 (string (buffer-substring-no-properties from to)))
683 ;; We can't print any more characters in the current line.
687 ;; We surely have a font for printing this character set.
688 (ps-output-string (ps-mule-string-encoding font-spec string))
691 ((eq ps-mule-current-charset 'latin-iso8859-1)
692 ;; Latin-1 can be printed by a normal ASCII font.
693 (ps-output-string (ps-mule-string-ascii string))
696 ((eq ps-mule-current-charset 'composition)
697 (let* ((ch (char-after from))
698 (width (char-width ch))
699 (ch-list (decompose-composite-char ch 'list t)))
700 (if (consp (nth 1 ch-list))
701 (ps-mule-plot-rule-cmpchar ch-list width font-type)
702 (ps-mule-plot-cmpchar ch-list width t font-type))))
705 ;; No way to print this charset. Just show a vacant box of an
706 ;; appropriate width.
707 (ps-output (format "%d %d SB\n"
709 (if (eq ps-mule-current-charset 'composition)
710 (char-width (char-after from))
711 (charset-width ps-mule-current-charset))))))
714 ;; Composite font support
716 (defvar ps-mule-cmpchar-prologue-generated nil)
718 (defconst ps-mule-cmpchar-prologue
719 "%%%% Composite character handler
721 /CmpcharRelativeCompose 0 def
722 /CmpcharRelativeSkip 0.4 def
724 %% Get a bounding box (relative to currentpoint) of STR.
725 /GetPathBox { % str |- --
727 currentfont /FontType get 3 eq { %ifelse
730 currentpoint /y exch def pop
731 false charpath flattenpath pathbbox
732 y sub /URY exch def pop
733 y sub /LLY exch def pop
738 %% Beginning of composite char.
739 /BC { % str xoff width |- --
741 /CmpcharWidth exch def
742 currentfont /RelativeCompose known {
743 /CmpcharRelativeCompose currentfont /RelativeCompose get def
745 /CmpcharRelativeCompose false def
747 /bgsave bg def /bgcolorsave bgcolor def
748 /Effectsave Effect def
749 gsave % Reflect effect only at first
750 /Effect Effect 1 2 add 4 add 16 add and def
751 /f0 findfont setfont ( ) 0 CmpcharWidth getinterval S
753 /Effect Effectsave 8 32 add and def % enable only shadow and outline
755 gsave SpaceWidth mul 0 rmoveto dup GetPathBox S grestore
756 /y currentpoint exch pop def
757 /HIGH URY y add def /LOW LLY y add def
760 %% End of composite char.
762 /bg bgsave def /bgcolor bgcolorsave def
763 /Effect Effectsave def
765 CmpcharWidth SpaceWidth mul 0 rmoveto
768 %% Rule base composition
769 /RBC { % str xoff gref nref |- --
770 /nref exch def /gref exch def
772 SpaceWidth mul 0 rmoveto
775 [ HIGH currentpoint exch pop LOW HIGH LOW add 2 div ] gref get
776 [ URY LLY sub LLY neg 0 URY LLY sub 2 div ] nref get
778 /top btm URY LLY sub add def
779 top HIGH gt { /HIGH top def } if
780 btm LOW lt { /LOW btm def } if
781 currentpoint pop btm LLY sub moveto
786 %% Relative composition
790 CmpcharRelativeCompose type /integertype eq {
791 LLY CmpcharRelativeCompose gt { % compose on top
792 currentpoint pop HIGH LLY sub CmpcharRelativeSkip add moveto
793 /HIGH HIGH URY LLY sub add CmpcharRelativeSkip add def
794 } { URY 0 le { % compose under bottom
795 currentpoint pop LOW LLY add CmpcharRelativeSkip sub moveto
796 /LOW LOW URY LLY sub sub CmpcharRelativeSkip sub def
801 %%%% End of composite character handler
804 "PostScript code for printing composite characters.")
806 (defun ps-mule-plot-rule-cmpchar (ch-rule-list total-width font-type)
808 (rightmost (float (char-width (car ch-rule-list))))
809 (the-list (cons '(3 . 3) ch-rule-list))
812 (let* ((this (car the-list))
815 ;; X-axis info (0:left, 1:center, 2:right)
818 ;; Y-axis info (0:top, 1:base, 2:bottom, 3:center)
819 (gref-y (if (= gref 4) 3 (/ gref 3)))
820 (nref-y (if (= nref 4) 3 (/ nref 3)))
821 (char (car (cdr the-list)))
822 (width (float (char-width char)))
824 (setq left (+ leftmost
825 (* (- rightmost leftmost) gref-x 0.5)
826 (- (* nref-x width 0.5)))
827 cmpchar-elements (cons (list char left gref-y nref-y)
829 leftmost (min left leftmost)
830 rightmost (max (+ left width) rightmost)
831 the-list (nthcdr 2 the-list))))
833 (let ((the-list cmpchar-elements)
836 (setq elt (car the-list)
837 the-list (cdr the-list))
838 (setcar (cdr elt) (- (nth 1 elt) leftmost)))))
839 (ps-mule-plot-cmpchar (nreverse cmpchar-elements)
840 total-width nil font-type)))
842 (defun ps-mule-plot-cmpchar (elements total-width relativep font-type)
843 (let* ((elt (car elements))
844 (ch (if relativep elt (car elt))))
845 (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
846 (ps-output (format " %d %d BC "
847 (if relativep 0 (nth 1 elt))
849 (while (setq elements (cdr elements))
850 (setq elt (car elements)
851 ch (if relativep elt (car elt)))
852 (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
853 (ps-output (if relativep
855 (format " %d %d %d RBC "
856 (nth 1 elt) (nth 2 elt) (nth 3 elt))))))
859 (defun ps-mule-prepare-cmpchar-font (char font-type)
860 (let* ((ps-mule-current-charset (char-charset char))
861 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)))
863 (ps-mule-string-encoding font-spec (char-to-string char)))
865 ((eq ps-mule-current-charset 'latin-iso8859-1)
866 (ps-mule-string-ascii (char-to-string char)))
870 (ps-set-font ps-current-font)
873 (defun ps-mule-string-ascii (str)
874 (ps-set-font ps-current-font)
875 (string-as-unibyte (encode-coding-string str 'iso-latin-1)))
877 (defun ps-mule-string-encoding (font-spec str)
878 (let ((encoding (ps-mule-font-spec-encoding font-spec)))
881 (cond ((coding-system-p encoding)
882 (encode-coding-string str encoding))
883 ((functionp encoding)
884 (funcall encoding str))
886 (error "Invalid coding system or function: %s" encoding))
889 (if (ps-mule-font-spec-src font-spec)
890 (ps-mule-prepare-font font-spec str ps-mule-current-charset)
891 (ps-set-font ps-current-font))
894 ;; Bitmap font support
896 (defvar ps-mule-bitmap-prologue-generated nil)
898 (defconst ps-mule-bitmap-prologue
899 "%%%% Bitmap font handler
901 /str7 7 string def % working area
903 %% We grow the dictionary one bunch (1024 entries) by one.
904 /BitmapDictArray 256 array def
905 /BitmapDictLength 1024 def
906 /BitmapDictIndex -1 def
908 /NewBitmapDict { % -- |- --
909 /BitmapDictIndex BitmapDictIndex 1 add def
910 BitmapDictArray BitmapDictIndex BitmapDictLength dict put
913 %% Make at least one dictionary.
916 /AddBitmap { % gloval-charname bitmap-data |- --
917 BitmapDictArray BitmapDictIndex get
918 dup length BitmapDictLength ge {
921 BitmapDictArray BitmapDictIndex get
926 /GetBitmap { % gloval-charname |- bitmap-data
927 0 1 BitmapDictIndex { BitmapDictArray exch get begin } for
929 0 1 BitmapDictIndex { pop end } for
932 %% Return a global character name which can be used as a key in the
933 %% bitmap dictionary.
934 /GlobalCharName { % fontidx code1 code2 |- gloval-charname
935 exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put
939 %% Character code holder for a 2-byte character.
942 %% Glyph rendering procedure
943 /BuildGlyphCommon { % fontdict charname |- --
944 1 index /FontDimension get 1 eq { /FirstCode 0 store } if
945 NameIndexDict exch get % STACK: fontdict charcode
946 FirstCode 0 lt { %ifelse
947 %% This is the first byte of a 2-byte character. Just
948 %% remember it for the moment.
949 /FirstCode exch store
953 1 index /FontSize get /size exch def
954 1 index /FontSpaceWidthRatio get /ratio exch def
955 1 index /FontIndex get exch FirstCode exch
956 GlobalCharName GetBitmap /bmp exch def
957 %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ]
959 /FontMatrix get [ exch { size div } forall ] /mtrx exch def
960 bmp 3 get bmp 4 get mtrx transform
962 bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform
969 bmp 0 get SpaceWidthRatio ratio div mul size div 0 % wx wy
970 setcharwidth % We can't use setcachedevice here.
972 bmp 1 get 0 gt bmp 2 get 0 gt and {
973 bmp 1 get bmp 2 get % width height
975 [ size 0 0 size neg bmp 3 get neg bmp 2 get bmp 4 get add ] % matrix
976 bmp 5 1 getinterval cvx % datasrc
983 1 index /Encoding get exch get
984 1 index /BuildGlyph get exec
987 %% Bitmap font creater
989 %% Common Encoding shared by all bitmap fonts.
990 /EncodingCommon 256 array def
991 %% Mapping table from character name to character code.
992 /NameIndexDict 256 dict def
995 /idxname idx 256 add 16 (XXX) cvrs dup 0 67 put cvn def % `C' == 67
996 EncodingCommon idx idxname put
997 NameIndexDict idxname idx put
1000 /GlobalFontIndex 0 def
1002 %% fontname dim col fontsize relative-compose baseline-offset fbbx |- --
1006 /BaselineOffset exch def
1007 /RelativeCompose exch def
1009 /FontBBox [ FontBBox { FontSize div } forall ] def
1010 FontBBox 2 get FontBBox 0 get sub exch div
1011 /FontSpaceWidthRatio exch def
1012 /FontDimension exch def
1013 /FontIndex GlobalFontIndex def
1015 /FontMatrix matrix def
1016 /Encoding EncodingCommon def
1017 /BuildGlyph { BuildGlyphCommon } def
1018 /BuildChar { BuildCharCommon } def
1021 /GlobalFontIndex GlobalFontIndex 1 add def
1024 %% Define a new bitmap font.
1025 %% fontname dim col fontsize relative-compose baseline-offset fbbx |- --
1028 %% Convert BDF's FontBoundingBox to PostScript's FontBBox
1029 [ fbbx 2 get fbbx 3 get
1030 fbbx 2 get fbbx 0 get add fbbx 3 get fbbx 1 get add ]
1034 %% Define a glyph for the specified font and character.
1035 /NG { % fontname charcode bitmap-data |- --
1037 exch findfont dup /BaselineOffset get bmp 4 get add bmp exch 4 exch put
1039 dup 256 idiv exch 256 mod GlobalCharName
1042 %%%% End of bitmap font handler
1046 ;; External library support.
1048 ;; The following three functions are to be called from external
1049 ;; libraries which support bitmap fonts (e.g. `bdf') to get
1050 ;; appropriate PostScript code.
1052 (defun ps-mule-generate-bitmap-prologue ()
1053 (unless ps-mule-bitmap-prologue-generated
1054 (setq ps-mule-bitmap-prologue-generated t)
1055 (list ps-mule-bitmap-prologue)))
1057 (defun ps-mule-generate-bitmap-font (&rest args)
1058 (list (apply 'format "/%s %d %d %f %S %d %S NF\n" args)))
1060 (defun ps-mule-generate-bitmap-glyph (font-name code dwidth bbx bitmap)
1061 (format "/%s %d [ %d %d %d %d %d <%s> ] NG\n"
1063 dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3)
1066 ;; Mule specific initializers.
1069 (defun ps-mule-initialize ()
1070 "Initialize global data for printing multi-byte characters."
1071 (setq ps-mule-font-cache nil
1072 ps-mule-prologue-generated nil
1073 ps-mule-cmpchar-prologue-generated nil
1074 ps-mule-bitmap-prologue-generated nil)
1075 (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil))
1076 ps-mule-external-libraries))
1079 (defun ps-mule-begin-job (from to)
1080 "Start printing job for multi-byte chars between FROM and TO.
1081 This checks if all multi-byte characters in the region are printable or not."
1082 (setq ps-mule-charset-list nil
1083 ps-mule-font-info-database
1084 (cond ((eq ps-multibyte-buffer 'non-latin-printer)
1085 ps-mule-font-info-database-ps)
1086 ((eq ps-multibyte-buffer 'bdf-font)
1087 ps-mule-font-info-database-bdf)
1088 ((eq ps-multibyte-buffer 'bdf-font-except-latin)
1089 ps-mule-font-info-database-ps-bdf)
1091 ps-mule-font-info-database-default)))
1092 (and (boundp 'enable-multibyte-characters)
1093 enable-multibyte-characters
1094 ;; Initialize `ps-mule-charset-list'. If some characters aren't
1095 ;; printable, warn it.
1096 (let ((charsets (find-charset-region from to)))
1097 (setq charsets (delq 'ascii (delq 'unknown (delq nil charsets)))
1098 ps-mule-charset-list charsets)
1101 (and (search-forward "\200" to t)
1102 (setq ps-mule-charset-list
1103 (cons 'composition ps-mule-charset-list))))
1107 ((or (eq (car charsets) 'composition)
1108 (ps-mule-printable-p (car charsets)))
1111 "Font for some characters not found, continue anyway? ")
1114 (error "Printing cancelled")))))))
1116 (setq ps-mule-current-charset 'ascii)
1118 (if ps-mule-charset-list
1119 (let ((the-list ps-mule-charset-list)
1121 (ps-mule-prologue-generated)
1122 ;; If external functions are necessary, generate prologues for them.
1124 (setq elt (car the-list)
1125 the-list (cdr the-list))
1126 (cond ((and (eq elt 'composition)
1127 (not ps-mule-cmpchar-prologue-generated))
1128 (ps-output-prologue ps-mule-cmpchar-prologue)
1129 (setq ps-mule-cmpchar-prologue-generated t))
1130 ((setq font-spec (ps-mule-get-font-spec elt 'normal))
1131 (ps-mule-init-external-library font-spec))))))
1133 ;; If ASCII font is also specified in ps-mule-font-info-database,
1134 ;; use it istead of what specified in ps-font-info-database.
1135 (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal)))
1138 (ps-mule-prologue-generated)
1139 (ps-mule-init-external-library font-spec)
1140 (let ((font (ps-font-alist 'ps-font-for-text))
1141 (ps-current-font 0))
1143 ;; Be sure to download a glyph for SPACE in advance.
1144 (ps-mule-prepare-font (ps-mule-get-font-spec 'ascii (car font))
1145 " " 'ascii 'no-setfont)
1146 (setq font (cdr font)
1147 ps-current-font (1+ ps-current-font)))))))
1149 (if ps-mule-charset-list
1150 ;; We must change this regexp for multi-byte buffer.
1151 (setq ps-control-or-escape-regexp
1152 (cond ((eq ps-print-control-characters '8-bit)
1154 ((eq ps-print-control-characters 'control-8-bit)
1155 (string-as-multibyte "[^\040-\176\240-\377]"))
1156 ((eq ps-print-control-characters 'control)
1157 (string-as-multibyte "[^\040-\176\200-\377]"))
1158 (t (string-as-multibyte "[^\000-\011\013\015-\377"))))))
1161 (defun ps-mule-begin-page ()
1162 (setq ps-mule-current-charset 'ascii))
1167 ;;; ps-mule.el ends here