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: <98/12/15 14:04:50 handa>
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 when you are printing
96 buffer with only ASCII and Latin characters.
98 `non-latin-printer' This is the value to use when you have a japanese
99 or korean PostScript printer and want to print
100 buffer with ASCII, Latin-1, Japanese (JISX0208 and
101 JISX0201-Kana) and Korean characters. At present,
102 it was not tested the Korean characters printing.
103 If you have a korean PostScript printer, please,
106 `bdf-font' This is the value to use when you want to print
107 buffer with BDF fonts. BDF fonts include both latin
108 and non-latin fonts. BDF (Bitmap Distribution
109 Format) is a format used for distributing X's font
110 source file. BDF fonts are included in
111 `intlfonts-1.1' which is a collection of X11 fonts
112 for all characters supported by Emacs. In order to
113 use this value, be sure to have installed
114 `intlfonts-1.1' and set the variable
115 `bdf-directory-list' appropriately (see ps-bdf.el for
116 documentation of this variable).
118 `bdf-font-except-latin' This is like `bdf-font' except that it is used
119 PostScript default fonts to print ASCII and Latin-1
120 characters. This is convenient when you want or
121 need to use both latin and non-latin characters on
122 the same buffer. See `ps-font-family',
123 `ps-header-font-family' and `ps-font-info-database'.
125 Any other value is treated as nil."
126 :type '(choice (const non-latin-printer) (const bdf-font)
127 (const bdf-font-except-latin) (other :tag "nil" nil))
128 :group 'ps-print-font)
130 ;; For Emacs 20.2 and the earlier version.
132 (if (not (string< mule-version "4.0"))
134 (defalias 'ps-mule-next-point '1+)
135 (defalias 'ps-mule-chars-in-string 'length)
136 (defalias 'ps-mule-string-char 'aref)
137 (defsubst ps-mule-next-index (str i) (1+ i)))
138 (defun ps-mule-next-point (arg)
139 (save-excursion (goto-char arg) (forward-char 1) (point)))
140 (defun ps-mule-chars-in-string (string)
142 (charset-bytes (char-charset (string-to-char string)))))
143 (defun ps-mule-string-char (string idx)
144 (string-to-char (substring string idx)))
145 (defun ps-mule-next-index (string i)
146 (+ i (charset-bytes (char-charset (string-to-char string))))))
149 (defvar ps-mule-font-info-database
151 "Alist of charsets with the corresponding font information.
152 Each element has the form:
154 (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES) ...)
158 CHARSET is a charset (symbol) for this font family,
160 FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
162 FONT-SRC is a font source: builtin, ps-bdf, vflib, or nil.
164 If FONT-SRC is builtin, FONT-NAME is a buitin PostScript font name.
166 If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of
167 alternative font names. To use this font, the external library `ps-bdf'
170 If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows.
171 To use this font, the external library `vflib' is required.
173 If FONT-SRC is nil, a proper ASCII font in the variable
174 `ps-font-info-database' is used. This is useful for Latin-1 characters.
176 ENCODING is a coding system to encode a string of characters of CHARSET into a
177 proper string matching an encoding of the specified font. ENCODING may be a
178 function that does this encoding. In this case, the function is called with
179 one argument, the string to encode, and it should return an encoded string.
181 BYTES specifies how many bytes each character has in the encoded byte
182 sequence; it should be 1 or 2.
184 All multi-byte characters are printed by fonts specified in this database
185 regardless of a font family of ASCII characters. The exception is Latin-1
186 characters which are printed by the same font as ASCII characters, thus obey
189 See also the variable `ps-font-info-database'.")
191 (defconst ps-mule-font-info-database-latin
193 (normal nil nil iso-latin-1)))
194 "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
196 (defconst ps-mule-font-info-database-ps
198 (normal builtin "Ryumin-Light.Katakana" ps-mule-encode-7bit 1)
199 (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)
200 (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1))
202 (normat builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)
203 (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1))
205 (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2)
206 (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2))
208 (normal builtin "Batang-Medium-KSC-H" ps-mule-encode-7bit 2)
209 (bold builtin " Gulim-Medium-KSC-H" ps-mule-encode-7bit 2))
211 "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
213 Currently, data for Japanese and Korean PostScript printers are listed.")
215 (defconst ps-mule-font-info-database-bdf
217 (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") nil 1)
218 (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") iso-latin-1 1)
219 (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") iso-latin-1 1)
220 (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") iso-latin-1 1))
222 (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf") nil 1)
223 (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf") iso-latin-1 1)
224 (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf") iso-latin-1 1)
225 (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf") iso-latin-1 1))
227 (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf") iso-latin-2 1))
229 (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf") iso-latin-3 1))
231 (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf") iso-latin-4 1))
233 (normal bdf ("thai24.bdf" "thai-24.bdf") thai-tis620 1))
235 (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") greek-iso-8bit 1))
236 ;; (arabic-iso8859-6 nil) ; not yet available
238 (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") hebrew-iso-8bit 1))
240 (normal bdf "12x24rk.bdf" ps-mule-encode-8bit 1))
242 (normal bdf "12x24rk.bdf" ps-mule-encode-7bit 1))
244 (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") cyrillic-iso-8bit 1))
246 (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-latin-5 1))
247 (japanese-jisx0208-1978
248 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
250 (normal bdf "gb24st.bdf" ps-mule-encode-7bit 2))
252 (normal bdf "jiskan24.bdf" ps-mule-encode-7bit 2))
254 (normal bdf "hanglm24.bdf" ps-mule-encode-7bit 2))
256 (normal bdf ("jksp40.bdf" "jisksp40.bdf") ps-mule-encode-7bit 2))
258 (normal bdf ("cns1-40.bdf" "cns-1-40.bdf") ps-mule-encode-7bit 2))
260 (normal bdf ("cns2-40.bdf" "cns-2-40.bdf") ps-mule-encode-7bit 2))
262 (normal bdf "taipei24.bdf" chinese-big5 2))
264 (normal bdf "taipei24.bdf" chinese-big5 2))
266 (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-8bit 1))
268 (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1))
269 (vietnamese-viscii-lower
270 (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1))
271 (vietnamese-viscii-upper
272 (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf") vietnamese-viscii 1))
274 (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf") ps-mule-encode-7bit 1))
276 (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf") ps-mule-encode-7bit 1))
277 ;; (ascii-right-to-left nil) ; not yet available
279 (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") lao 1))
281 (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1))
283 (normal bdf ("isci24-etl.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1))
285 (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2))
287 (normal bdf ("tib1c24-mule.bdf" "mule-tibmdx-1col-24.bdf") ps-mule-encode-7bit 2))
289 (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") ps-mule-encode-ethiopic 2))
291 (normal bdf ("cns3-40.bdf" "cns-3-40.bdf") ps-mule-encode-7bit 2))
293 (normal bdf ("cns4-40.bdf" "cns-4-40.bdf") ps-mule-encode-7bit 2))
295 (normal bdf ("cns5-40.bdf" "cns-5-40.bdf") ps-mule-encode-7bit 2))
297 (normal bdf ("cns6-40.bdf" "cns-6-40.bdf") ps-mule-encode-7bit 2))
299 (normal bdf ("cns7-40.bdf" "cns-7-40.bdf") ps-mule-encode-7bit 2))
301 (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2))
303 (normal bdf ("tib24-mule.bdf" "mule-tibmdx-24.bdf") ps-mule-encode-7bit 2)))
304 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
305 BDF (Bitmap Distribution Format) is a format used for distributing X's font
308 Current default value list for BDF fonts is included in `intlfonts-1.1' which is
309 a collection of X11 fonts for all characters supported by Emacs.
311 Using this list as default value to `ps-mule-font-info-database', all characters
312 including ASCII and Latin-1 are printed by BDF fonts.
314 See also `ps-mule-font-info-database-ps-bdf'.")
316 (defconst ps-mule-font-info-database-ps-bdf
317 (cons (car ps-mule-font-info-database-latin)
318 (cdr (cdr ps-mule-font-info-database-bdf)))
319 "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
321 Current default value list for BDF fonts is included in `intlfonts-1.1' which is
322 a collection of X11 fonts for all characters supported by Emacs.
324 Using this list as default value to `ps-mule-font-info-database', all characters
325 except ASCII and Latin-1 characters are printed by BDF fonts. ASCII and Latin-1
326 characters are printed by PostScript font specified by `ps-font-family' and
327 `ps-header-font-family'.
329 See also `ps-mule-font-info-database-bdf'.")
331 ;; Two typical encoding functions for PostScript fonts.
333 (defun ps-mule-encode-7bit (string)
334 (ps-mule-encode-bit string 0))
336 (defun ps-mule-encode-8bit (string)
337 (ps-mule-encode-bit string 128))
339 (defun ps-mule-encode-bit (string delta)
340 (let* ((dim (charset-dimension (char-charset (string-to-char string))))
341 (len (* (ps-mule-chars-in-string string) dim))
342 (str (make-string len 0))
348 (+ (nth 1 (split-char (ps-mule-string-char string i))) delta))
349 (setq i (ps-mule-next-index string i)
352 (let ((split (split-char (ps-mule-string-char string i))))
353 (aset str j (+ (nth 1 split) delta))
354 (aset str (1+ j) (+ (nth 2 split) delta))
355 (setq i (ps-mule-next-index string i)
359 ;; Special encoding function for Ethiopic.
360 (define-ccl-program ccl-encode-ethio-unicode
364 (if (r2 == ,leading-code-private-22)
366 (if (r0 == ,(charset-id 'ethiopic))
368 (r1 &= 127) (r2 &= 127)
369 (call ccl-encode-ethio-font)
371 (write-read-repeat r2))
374 (write-read-repeat r2))))))
376 (defun ps-mule-encode-ethiopic (string)
377 (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
381 ;; A charset which we are now processing.
382 (defvar ps-mule-current-charset nil)
384 (defun ps-mule-get-font-spec (charset font-type)
385 "Return FONT-SPEC for printing characters CHARSET with FONT-TYPE.
386 FONT-SPEC is a list that has the form:
388 (FONT-SRC FONT-NAME ENCODING BYTES)
390 FONT-SPEC is extracted from `ps-mule-font-info-database'.
392 See the documentation of `ps-mule-font-info-database' for the meaning of each
393 element of the list."
394 (let ((slot (cdr (assq charset ps-mule-font-info-database))))
396 (cdr (or (assq font-type slot)
397 (and (eq font-type 'bold-italic)
398 (or (assq 'bold slot) (assq 'italic slot)))
399 (assq 'normal slot))))))
401 ;; Functions to access each element of FONT-SPEC.
402 (defsubst ps-mule-font-spec-src (font-spec) (car font-spec))
403 (defsubst ps-mule-font-spec-name (font-spec) (nth 1 font-spec))
404 (defsubst ps-mule-font-spec-encoding (font-spec) (nth 2 font-spec))
405 (defsubst ps-mule-font-spec-bytes (font-spec) (nth 3 font-spec))
407 (defsubst ps-mule-printable-p (charset)
408 "Non-nil if characters in CHARSET is printable."
409 (ps-mule-get-font-spec charset 'normal))
411 (defconst ps-mule-external-libraries
415 bdf-generate-prologue bdf-generate-font bdf-generate-glyphs)
417 pcf-generate-prologue pcf-generate-font pcf-generate-glyphs)
419 vflib-generate-prologue vflib-generate-font vflib-generate-glyphs))
420 "Alist of information of external libraries to support PostScript printing.
421 Each element has the form:
423 (FONT-SRC FEATURE INITIALIZED-P PROLOGUE-FUNC FONT-FUNC GLYPHS-FUNC)
425 FONT-SRC is the font source: builtin, bdf, pcf, or vflib.
427 FEATURE is the feature that provide a facility to handle FONT-SRC. Except for
428 `builtin' FONT-SRC, this feature is automatically `require'd before handling
429 FONT-SRC. Currently, we only have the feature `ps-bdf'.
431 INITIALIZED-P indicates if this library is initialized or not.
433 PROLOGUE-FUNC is a function to generate PostScript code which define several
434 PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC. It is
435 called with no argument, and should return a list of strings.
437 FONT-FUNC is a function to generate PostScript code which define a new font. It
438 is called with one argument FONT-SPEC, and should return a list of strings.
440 GLYPHS-FUNC is a function to generate PostScript code which define glyphs of
441 characters. It is called with three arguments FONT-SPEC, CODE-LIST, and BYTES,
442 and should return a list of strings.")
444 (defun ps-mule-init-external-library (font-spec)
445 "Initialize external library specified by FONT-SPEC for PostScript printing.
446 See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning."
447 (let* ((font-src (ps-mule-font-spec-src font-spec))
448 (slot (assq font-src ps-mule-external-libraries)))
451 (let ((func (nth 3 slot)))
454 (or (featurep (nth 1 slot)) (require (nth 1 slot)))
455 (ps-output-prologue (funcall func))))
456 (setcar (nthcdr 2 slot) t)))))
458 ;; Cached glyph information of fonts, alist of:
459 ;; (FONT-NAME ((FONT-TYPE-NUMBER . SCALED-FONT-NAME) ...)
460 ;; cache CODE0 CODE1 ...)
461 (defvar ps-mule-font-cache nil)
463 (defun ps-mule-generate-font (font-spec charset)
464 "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET."
465 (let* ((font-name (ps-mule-font-spec-name font-spec))
466 (font-name (if (consp font-name) (car font-name) font-name))
467 (font-cache (assoc font-name ps-mule-font-cache))
468 (font-src (ps-mule-font-spec-src font-spec))
469 (func (nth 4 (assq font-src ps-mule-external-libraries)))
471 (if (eq charset 'ascii)
472 (format "f%d" ps-current-font)
474 (charset-id charset) ps-current-font))))
475 (and func (not font-cache)
476 (ps-output-prologue (funcall func charset font-spec)))
478 (list (format "/%s %f /%s Def%sFontMule\n"
479 scaled-font-name ps-font-size font-name
480 (if (eq ps-mule-current-charset 'ascii) "Ascii" ""))))
482 (setcar (cdr font-cache)
483 (cons (cons ps-current-font scaled-font-name)
485 (setq font-cache (list font-name
486 (list (cons ps-current-font scaled-font-name))
488 ps-mule-font-cache (cons font-cache ps-mule-font-cache)))
491 (defun ps-mule-generate-glyphs (font-spec code-list)
492 "Generate PostScript codes which generate glyphs for CODE-LIST of FONT-SPEC."
493 (let* ((font-src (ps-mule-font-spec-src font-spec))
494 (func (nth 5 (assq font-src ps-mule-external-libraries))))
497 (funcall func font-spec code-list
498 (ps-mule-font-spec-bytes font-spec))))))
500 (defun ps-mule-prepare-font (font-spec string charset &optional no-setfont)
501 "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC.
503 The generated code is inserted on prologue part except the code that sets the
504 current font (using PostScript procedure `FM').
506 If optional arg NO-SETFONT is non-nil, don't generate the code for setting the
508 (let* ((font-name (ps-mule-font-spec-name font-spec))
509 (font-name (if (consp font-name) (car font-name) font-name))
510 (font-cache (assoc font-name ps-mule-font-cache)))
511 (or (and font-cache (assq ps-current-font (nth 1 font-cache)))
512 (setq font-cache (ps-mule-generate-font font-spec charset)))
514 (let ((new-font (cdr (assq ps-current-font (nth 1 font-cache)))))
515 (or (equal new-font ps-last-font)
517 (ps-output (format "/%s FM\n" new-font))
518 (setq ps-last-font new-font)))))
519 (if (nth 5 (assq (ps-mule-font-spec-src font-spec)
520 ps-mule-external-libraries))
521 ;; We have to generate PostScript codes which define glyphs.
522 (let* ((cached-codes (nthcdr 2 font-cache))
523 (bytes (ps-mule-font-spec-bytes font-spec))
524 (len (length string))
528 (setq code (if (= bytes 1)
530 (+ (* (aref string i) 256) (aref string (1+ i)))))
531 (or (memq code cached-codes)
533 (setq newcodes (cons code newcodes))
534 (setcdr cached-codes (cons code (cdr cached-codes)))))
535 (setq i (+ i bytes)))
537 (ps-mule-generate-glyphs font-spec newcodes))))))
540 (defun ps-mule-prepare-ascii-font (string)
541 "Setup special ASCII font for STRING.
542 STRING should contain only ASCII characters."
544 (ps-mule-get-font-spec
546 (car (nth ps-current-font (ps-font-alist 'ps-font-for-text))))))
548 (ps-mule-prepare-font font-spec string 'ascii))))
551 (defun ps-mule-set-ascii-font ()
552 (unless (eq ps-mule-current-charset 'ascii)
553 (ps-set-font ps-current-font)
554 (setq ps-mule-current-charset 'ascii)))
556 ;; List of charsets of multi-byte characters in a text being printed.
557 ;; If the text doesn't contain any multi-byte characters (i.e. only ASCII),
559 (defvar ps-mule-charset-list nil)
561 ;; This is a PostScript code inserted in the header of generated PostScript.
562 (defconst ps-mule-prologue
563 "%%%% Start of Mule Section
565 %% Working dictionary for general use.
566 /MuleDict 10 dict def
568 %% Define already scaled font for non-ASCII character sets.
569 /DefFontMule { % fontname size basefont |- --
570 findfont exch scalefont definefont pop
573 %% Define already scaled font for ASCII character sets.
574 /DefAsciiFontMule { % fontname size basefont |-
576 findfont dup /Encoding get /ISOLatin1Encoding exch def
577 exch scalefont reencodeFontISO
581 %% Set the specified non-ASCII font to use. It doesn't install
583 /FM { % fontname |- --
587 %% Show vacant box for characters which don't have appropriate font.
588 /SB { % count column |- --
589 SpaceWidth mul /w exch def
594 0 Descent rmoveto w 0 rlineto
595 0 LineHeight rlineto w neg 0 rlineto closepath stroke
601 %% Flag to tell if we are now handling a composite character. This is
602 %% defined here because both composite character handler and bitmap font
603 %% handler require it.
606 %%%% End of Mule Section
609 "PostScript code for printing multi-byte characters.")
611 (defvar ps-mule-prologue-generated nil)
613 (defun ps-mule-prologue-generated ()
614 (unless ps-mule-prologue-generated
615 (ps-output-prologue ps-mule-prologue)
616 (setq ps-mule-prologue-generated t)))
618 (defun ps-mule-find-wrappoint (from to char-width)
619 "Find the longest sequence which is printable in the current line.
621 The search starts at FROM and goes until TO. It is assumed that all characters
622 between FROM and TO belong to a charset in `ps-mule-current-charset'.
624 CHAR-WIDTH is the average width of ASCII characters in the current font.
630 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
632 (if (eq ps-mule-current-charset 'composition)
633 ;; We must draw one char by one.
634 (let ((run-width (* (char-width (char-after from)) char-width)))
635 (if (> run-width ps-width-remaining)
636 (cons from ps-width-remaining)
637 (cons (ps-mule-next-point from) run-width)))
638 ;; We assume that all characters in this range have the same width.
639 (setq char-width (* char-width (charset-width ps-mule-current-charset)))
640 (let ((run-width (* (chars-in-region from to) char-width)))
641 (if (> run-width ps-width-remaining)
646 (truncate (/ ps-width-remaining char-width)))))
648 (cons to run-width)))))
651 (defun ps-mule-plot-string (from to &optional bg-color)
652 "Generate PostScript code for ploting characters in the region FROM and TO.
654 It is assumed that all characters in this region belong to the same charset.
656 Optional argument BG-COLOR specifies background color.
662 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
664 (setq ps-mule-current-charset (charset-after from))
665 (let* ((wrappoint (ps-mule-find-wrappoint
666 from to (ps-avg-char-width 'ps-font-for-text)))
668 (font-type (car (nth ps-current-font
669 (ps-font-alist 'ps-font-for-text))))
670 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type))
671 (string (buffer-substring-no-properties from to)))
674 ;; We can't print any more characters in the current line.
678 ;; We surely have a font for printing this character set.
679 (ps-output-string (ps-mule-string-encoding font-spec string))
682 ((eq ps-mule-current-charset 'latin-iso8859-1)
683 ;; Latin-1 can be printed by a normal ASCII font.
684 (ps-output-string (ps-mule-string-ascii string))
687 ((eq ps-mule-current-charset 'composition)
688 (let* ((ch (char-after from))
689 (width (char-width ch))
690 (ch-list (decompose-composite-char ch 'list t)))
691 (if (consp (nth 1 ch-list))
692 (ps-mule-plot-rule-cmpchar ch-list width font-type)
693 (ps-mule-plot-cmpchar ch-list width t font-type))))
696 ;; No way to print this charset. Just show a vacant box of an
697 ;; appropriate width.
698 (ps-output (format "%d %d SB\n"
700 (if (eq ps-mule-current-charset 'composition)
701 (char-width (char-after from))
702 (charset-width ps-mule-current-charset))))))
705 ;; Composite font support
707 (defvar ps-mule-cmpchar-prologue-generated nil)
709 (defconst ps-mule-cmpchar-prologue
710 "%%%% Composite character handler
712 /CmpcharRelativeCompose 0 def
713 /CmpcharRelativeSkip 0.4 def
715 %% Get a bounding box (relative to currentpoint) of STR.
716 /GetPathBox { % str |- --
718 currentfont /FontType get 3 eq { %ifelse
721 currentpoint /y exch def pop
722 false charpath flattenpath pathbbox
723 y sub /URY exch def pop
724 y sub /LLY exch def pop
729 %% Beginning of composite char.
730 /BC { % str xoff width |- --
732 /CmpcharWidth exch def
733 currentfont /RelativeCompose known {
734 /CmpcharRelativeCompose currentfont /RelativeCompose get def
736 /CmpcharRelativeCompose false def
738 /bgsave bg def /bgcolorsave bgcolor def
739 /Effectsave Effect def
740 gsave % Reflect effect only at first
741 /Effect Effect 1 2 add 4 add 16 add and def
742 /f0 findfont setfont ( ) 0 CmpcharWidth getinterval S
744 /Effect Effectsave 8 32 add and def % enable only shadow and outline
746 gsave SpaceWidth mul 0 rmoveto dup GetPathBox S grestore
747 /y currentpoint exch pop def
748 /HIGH URY y add def /LOW LLY y add def
751 %% End of composite char.
753 /bg bgsave def /bgcolor bgcolorsave def
754 /Effect Effectsave def
756 CmpcharWidth SpaceWidth mul 0 rmoveto
759 %% Rule base composition
760 /RBC { % str xoff gref nref |- --
761 /nref exch def /gref exch def
763 SpaceWidth mul 0 rmoveto
766 [ HIGH currentpoint exch pop LOW HIGH LOW add 2 div ] gref get
767 [ URY LLY sub LLY neg 0 URY LLY sub 2 div ] nref get
769 /top btm URY LLY sub add def
770 top HIGH gt { /HIGH top def } if
771 btm LOW lt { /LOW btm def } if
772 currentpoint pop btm LLY sub moveto
777 %% Relative composition
781 CmpcharRelativeCompose type /integertype eq {
782 LLY CmpcharRelativeCompose gt { % compose on top
783 currentpoint pop HIGH LLY sub CmpcharRelativeSkip add moveto
784 /HIGH HIGH URY LLY sub add CmpcharRelativeSkip add def
785 } { URY 0 le { % compose under bottom
786 currentpoint pop LOW LLY add CmpcharRelativeSkip sub moveto
787 /LOW LOW URY LLY sub sub CmpcharRelativeSkip sub def
792 %%%% End of composite character handler
795 "PostScript code for printing composite characters.")
797 (defun ps-mule-plot-rule-cmpchar (ch-rule-list total-width font-type)
799 (rightmost (float (char-width (car ch-rule-list))))
800 (the-list (cons '(3 . 3) ch-rule-list))
803 (let* ((this (car the-list))
806 ;; X-axis info (0:left, 1:center, 2:right)
809 ;; Y-axis info (0:top, 1:base, 2:bottom, 3:center)
810 (gref-y (if (= gref 4) 3 (/ gref 3)))
811 (nref-y (if (= nref 4) 3 (/ nref 3)))
812 (char (car (cdr the-list)))
813 (width (float (char-width char)))
815 (setq left (+ leftmost
816 (* (- rightmost leftmost) gref-x 0.5)
817 (- (* nref-x width 0.5)))
818 cmpchar-elements (cons (list char left gref-y nref-y)
820 leftmost (min left leftmost)
821 rightmost (max (+ left width) rightmost)
822 the-list (nthcdr 2 the-list))))
824 (let ((the-list cmpchar-elements)
827 (setq elt (car the-list)
828 the-list (cdr the-list))
829 (setcar (cdr elt) (- (nth 1 elt) leftmost)))))
830 (ps-mule-plot-cmpchar (nreverse cmpchar-elements)
831 total-width nil font-type)))
833 (defun ps-mule-plot-cmpchar (elements total-width relativep font-type)
834 (let* ((elt (car elements))
835 (ch (if relativep elt (car elt))))
836 (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
837 (ps-output (format " %d %d BC "
838 (if relativep 0 (nth 1 elt))
840 (while (setq elements (cdr elements))
841 (setq elt (car elements)
842 ch (if relativep elt (car elt)))
843 (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
844 (ps-output (if relativep
846 (format " %d %d %d RBC "
847 (nth 1 elt) (nth 2 elt) (nth 3 elt))))))
850 (defun ps-mule-prepare-cmpchar-font (char font-type)
851 (let* ((ps-mule-current-charset (char-charset char))
852 (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)))
854 (ps-mule-string-encoding font-spec (char-to-string char)))
856 ((eq ps-mule-current-charset 'latin-iso8859-1)
857 (ps-mule-string-ascii (char-to-string char)))
861 (ps-set-font ps-current-font)
864 (defun ps-mule-string-ascii (str)
865 (ps-set-font ps-current-font)
866 (string-as-unibyte (encode-coding-string str 'iso-latin-1)))
868 (defun ps-mule-string-encoding (font-spec str)
869 (let ((encoding (ps-mule-font-spec-encoding font-spec)))
872 (cond ((coding-system-p encoding)
873 (encode-coding-string str encoding))
874 ((functionp encoding)
875 (funcall encoding str))
877 (error "Invalid coding system or function: %s" encoding))
880 (if (ps-mule-font-spec-src font-spec)
881 (ps-mule-prepare-font font-spec str ps-mule-current-charset)
882 (ps-set-font ps-current-font))
885 ;; Bitmap font support
887 (defvar ps-mule-bitmap-prologue-generated nil)
889 (defconst ps-mule-bitmap-prologue
890 "%%%% Bitmap font handler
892 /str7 7 string def % working area
894 %% We grow the dictionary one bunch (1024 entries) by one.
895 /BitmapDictArray 256 array def
896 /BitmapDictLength 1024 def
897 /BitmapDictIndex -1 def
899 /NewBitmapDict { % -- |- --
900 /BitmapDictIndex BitmapDictIndex 1 add def
901 BitmapDictArray BitmapDictIndex BitmapDictLength dict put
904 %% Make at least one dictionary.
907 /AddBitmap { % gloval-charname bitmap-data |- --
908 BitmapDictArray BitmapDictIndex get
909 dup length BitmapDictLength ge {
912 BitmapDictArray BitmapDictIndex get
917 /GetBitmap { % gloval-charname |- bitmap-data
918 0 1 BitmapDictIndex { BitmapDictArray exch get begin } for
920 0 1 BitmapDictIndex { pop end } for
923 %% Return a global character name which can be used as a key in the
924 %% bitmap dictionary.
925 /GlobalCharName { % fontidx code1 code2 |- gloval-charname
926 exch 256 mul add exch 65536 mul add 16777216 add 16 str7 cvrs 0 66 put
930 %% Character code holder for a 2-byte character.
933 %% Glyph rendering procedure
934 /BuildGlyphCommon { % fontdict charname |- --
935 1 index /FontDimension get 1 eq { /FirstCode 0 store } if
936 NameIndexDict exch get % STACK: fontdict charcode
937 FirstCode 0 lt { %ifelse
938 %% This is the first byte of a 2-byte character. Just
939 %% remember it for the moment.
940 /FirstCode exch store
944 1 index /FontSize get /size exch def
945 1 index /FontSpaceWidthRatio get /ratio exch def
946 1 index /FontIndex get exch FirstCode exch
947 GlobalCharName GetBitmap /bmp exch def
948 %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ]
950 /FontMatrix get [ exch { size div } forall ] /mtrx exch def
951 bmp 3 get bmp 4 get mtrx transform
953 bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform
960 bmp 0 get SpaceWidthRatio ratio div mul size div 0 % wx wy
961 setcharwidth % We can't use setcachedevice here.
963 bmp 1 get 0 gt bmp 2 get 0 gt and {
964 bmp 1 get bmp 2 get % width height
966 [ size 0 0 size neg bmp 3 get neg bmp 2 get bmp 4 get add ] % matrix
967 bmp 5 1 getinterval cvx % datasrc
974 1 index /Encoding get exch get
975 1 index /BuildGlyph get exec
978 %% Bitmap font creater
980 %% Common Encoding shared by all bitmap fonts.
981 /EncodingCommon 256 array def
982 %% Mapping table from character name to character code.
983 /NameIndexDict 256 dict def
986 /idxname idx 256 add 16 (XXX) cvrs dup 0 67 put cvn def % `C' == 67
987 EncodingCommon idx idxname put
988 NameIndexDict idxname idx put
991 /GlobalFontIndex 0 def
993 %% fontname dim col fontsize relative-compose baseline-offset fbbx |- --
997 /BaselineOffset exch def
998 /RelativeCompose exch def
1000 /FontBBox [ FontBBox { FontSize div } forall ] def
1001 FontBBox 2 get FontBBox 0 get sub exch div
1002 /FontSpaceWidthRatio exch def
1003 /FontDimension exch def
1004 /FontIndex GlobalFontIndex def
1006 /FontMatrix matrix def
1007 /Encoding EncodingCommon def
1008 /BuildGlyph { BuildGlyphCommon } def
1009 /BuildChar { BuildCharCommon } def
1012 /GlobalFontIndex GlobalFontIndex 1 add def
1015 %% Define a new bitmap font.
1016 %% fontname dim col fontsize relative-compose baseline-offset fbbx |- --
1019 %% Convert BDF's FontBoundingBox to PostScript's FontBBox
1020 [ fbbx 2 get fbbx 3 get
1021 fbbx 2 get fbbx 0 get add fbbx 3 get fbbx 1 get add ]
1025 %% Define a glyph for the specified font and character.
1026 /NG { % fontname charcode bitmap-data |- --
1028 exch findfont dup /BaselineOffset get bmp 4 get add bmp exch 4 exch put
1030 dup 256 idiv exch 256 mod GlobalCharName
1033 %%%% End of bitmap font handler
1037 ;; External library support.
1039 ;; The following three functions are to be called from external
1040 ;; libraries which support bitmap fonts (e.g. `bdf') to get
1041 ;; appropriate PostScript code.
1043 (defun ps-mule-generate-bitmap-prologue ()
1044 (unless ps-mule-bitmap-prologue-generated
1045 (setq ps-mule-bitmap-prologue-generated t)
1046 (list ps-mule-bitmap-prologue)))
1048 (defun ps-mule-generate-bitmap-font (&rest args)
1049 (list (apply 'format "/%s %d %d %f %S %d %S NF\n" args)))
1051 (defun ps-mule-generate-bitmap-glyph (font-name code dwidth bbx bitmap)
1052 (format "/%s %d [ %d %d %d %d %d <%s> ] NG\n"
1054 dwidth (aref bbx 0) (aref bbx 1) (aref bbx 2) (aref bbx 3)
1057 ;; Mule specific initializers.
1060 (defun ps-mule-initialize ()
1061 "Initialize global data for printing multi-byte characters."
1062 (setq ps-mule-font-cache nil
1063 ps-mule-prologue-generated nil
1064 ps-mule-cmpchar-prologue-generated nil
1065 ps-mule-bitmap-prologue-generated nil)
1066 (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil))
1067 ps-mule-external-libraries))
1070 (defun ps-mule-begin-job (from to)
1071 "Start printing job for multi-byte chars between FROM and TO.
1072 This checks if all multi-byte characters in the region are printable or not."
1073 (setq ps-mule-charset-list nil
1074 ps-mule-font-info-database
1075 (cond ((eq ps-multibyte-buffer 'non-latin-printer)
1076 ps-mule-font-info-database-ps)
1077 ((eq ps-multibyte-buffer 'bdf-font)
1078 ps-mule-font-info-database-bdf)
1079 ((eq ps-multibyte-buffer 'bdf-font-except-latin)
1080 ps-mule-font-info-database-ps-bdf)
1082 ps-mule-font-info-database-latin)))
1083 (and (boundp 'enable-multibyte-characters)
1084 enable-multibyte-characters
1085 ;; Initialize `ps-mule-charset-list'. If some characters aren't
1086 ;; printable, warn it.
1087 (let ((charsets (find-charset-region from to)))
1088 (setq charsets (delq 'ascii (delq 'unknown (delq nil charsets)))
1089 ps-mule-charset-list charsets)
1092 (and (search-forward "\200" to t)
1093 (setq ps-mule-charset-list
1094 (cons 'composition ps-mule-charset-list))))
1098 ((or (eq (car charsets) 'composition)
1099 (ps-mule-printable-p (car charsets)))
1102 "Font for some characters not found, continue anyway? ")
1105 (error "Printing cancelled")))))))
1107 (setq ps-mule-current-charset 'ascii)
1109 (if ps-mule-charset-list
1110 (let ((the-list ps-mule-charset-list)
1112 (ps-mule-prologue-generated)
1113 ;; If external functions are necessary, generate prologues for them.
1115 (setq elt (car the-list)
1116 the-list (cdr the-list))
1117 (cond ((and (eq elt 'composition)
1118 (not ps-mule-cmpchar-prologue-generated))
1119 (ps-output-prologue ps-mule-cmpchar-prologue)
1120 (setq ps-mule-cmpchar-prologue-generated t))
1121 ((setq font-spec (ps-mule-get-font-spec elt 'normal))
1122 (ps-mule-init-external-library font-spec))))))
1124 ;; If ASCII font is also specified in ps-mule-font-info-database,
1125 ;; use it istead of what specified in ps-font-info-database.
1126 (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal)))
1129 (ps-mule-prologue-generated)
1130 (ps-mule-init-external-library font-spec)
1131 (let ((font (ps-font-alist 'ps-font-for-text))
1132 (ps-current-font 0))
1134 ;; Be sure to download a glyph for SPACE in advance.
1135 (ps-mule-prepare-font (ps-mule-get-font-spec 'ascii (car font))
1136 " " 'ascii 'no-setfont)
1137 (setq font (cdr font)
1138 ps-current-font (1+ ps-current-font)))))))
1140 (if ps-mule-charset-list
1141 ;; We must change this regexp for multi-byte buffer.
1142 (setq ps-control-or-escape-regexp
1143 (cond ((eq ps-print-control-characters '8-bit)
1145 ((eq ps-print-control-characters 'control-8-bit)
1146 (string-as-multibyte "[^\040-\176\240-\377]"))
1147 ((eq ps-print-control-characters 'control)
1148 (string-as-multibyte "[^\040-\176\200-\377]"))
1149 (t (string-as-multibyte "[^\000-\011\013\015-\377"))))))
1152 (defun ps-mule-begin-page ()
1153 (setq ps-mule-current-charset 'ascii))
1158 ;;; ps-mule.el ends here