code.delx.au - gnu-emacs/blob - lisp/ps-mule.el

   1 ;;; ps-mule.el --- provide multi-byte character facility to ps-print
   2
   3 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4 ;;   2005, 2006, 2007 Free Software Foundation, Inc.
   5
   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
  11
  12 ;; This file is part of GNU Emacs.
  13
  14 ;; GNU Emacs is free software; you can redistribute it and/or modify
  15 ;; it under the terms of the GNU General Public License as published by
  16 ;; the Free Software Foundation; either version 2, or (at your option)
  17 ;; any later version.
  18
  19 ;; GNU Emacs is distributed in the hope that it will be useful,
  20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  22 ;; GNU General Public License for more details.
  23
  24 ;; You should have received a copy of the GNU General Public License
  25 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  26 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  27 ;; Boston, MA 02110-1301, USA.
  28
  29 ;;; Commentary:
  30
  31 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  32 ;;
  33 ;; About ps-mule
  34 ;; -------------
  35 ;;
  36 ;; This package is used for ps-print to print multi-byte buffer.
  37 ;;
  38 ;; See also ps-print.el.
  39 ;;
  40 ;;
  41 ;; Printing Multi-byte Buffer
  42 ;; --------------------------
  43 ;;
  44 ;; The variable `ps-multibyte-buffer' specifies the ps-print multi-byte buffer
  45 ;; handling.
  46 ;;
  47 ;; Valid values for `ps-multibyte-buffer' are:
  48 ;;
  49 ;;  nil                     This is the value to use 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
  56 ;;                          documentation).
  57 ;;
  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,
  64 ;;                          test it.
  65 ;;
  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).
  77 ;;
  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'.
  84 ;;
  85 ;; Any other value is treated as nil.
  86 ;;
  87 ;; The default is nil.
  88 ;;
  89 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  90
  91 ;;; Code:
  92
  93 (eval-and-compile
  94   (require 'ps-print))
  95
  96
  97 ;;;###autoload
  98 (defcustom ps-multibyte-buffer nil
  99   "*Specifies the multi-byte buffer handling.
 100
 101 Valid values are:
 102
 103   nil                     This is the value to use the default settings which
 104                           is by default for printing buffer with only ASCII
 105                           and Latin characters.   The default setting can be
 106                           changed by setting the variable
 107                           `ps-mule-font-info-database-default' differently.
 108                           The initial value of this variable is
 109                           `ps-mule-font-info-database-latin' (see
 110                           documentation).
 111
 112   `non-latin-printer'     This is the value to use when you have a Japanese
 113                           or Korean PostScript printer and want to print
 114                           buffer with ASCII, Latin-1, Japanese (JISX0208 and
 115                           JISX0201-Kana) and Korean characters.  At present,
 116                           it was not tested the Korean characters printing.
 117                           If you have a korean PostScript printer, please,
 118                           test it.
 119
 120   `bdf-font'              This is the value to use when you want to print
 121                           buffer with BDF fonts.  BDF fonts include both latin
 122                           and non-latin fonts.  BDF (Bitmap Distribution
 123                           Format) is a format used for distributing X's font
 124                           source file.  BDF fonts are included in
 125                           `intlfonts-1.2' which is a collection of X11 fonts
 126                           for all characters supported by Emacs.  In order to
 127                           use this value, be sure to have installed
 128                           `intlfonts-1.2' and set the variable
 129                           `bdf-directory-list' appropriately (see ps-bdf.el for
 130                           documentation of this variable).
 131
 132   `bdf-font-except-latin' This is like `bdf-font' except that it is used
 133                           PostScript default fonts to print ASCII and Latin-1
 134                           characters.  This is convenient when you want or
 135                           need to use both latin and non-latin characters on
 136                           the same buffer.  See `ps-font-family',
 137                           `ps-header-font-family' and `ps-font-info-database'.
 138
 139 Any other value is treated as nil."
 140   :type '(choice (const non-latin-printer)     (const bdf-font)
 141                  (const bdf-font-except-latin) (const :tag "nil" nil))
 142   :group 'ps-print-font)
 143
 144 (defvar ps-mule-font-info-database
 145   nil
 146   "Alist of charsets with the corresponding font information.
 147 Each element has the form:
 148
 149         (CHARSET (FONT-TYPE FONT-SRC FONT-NAME ENCODING BYTES)) ...)
 150
 151 Where
 152
 153 CHARSET is a charset (symbol) for this font family,
 154
 155 FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
 156
 157 FONT-SRC is a font source: builtin, bdf, vflib, or nil.
 158
 159   If FONT-SRC is builtin, FONT-NAME is a built-in PostScript font name.
 160
 161   If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of
 162   alternative font names.  To use this font, the external library `ps-bdf'
 163   is required.
 164
 165   If FONT-SRC is vflib, FONT-NAME is the name of a font that VFlib knows.
 166   To use this font, the external library `vflib' is required.
 167
 168   If FONT-SRC is nil, a proper ASCII font in the variable
 169   `ps-font-info-database' is used, and FONT-NAME is ignored.
 170   This is useful for Latin-1 characters.
 171
 172 ENCODING is a charset to encode a character of CHARSET to a glyph
 173 code of the specifies font.  ENCODING may be a function that does
 174 this encoding.  In this case, the function is called with one
 175 argument, the character to encode, and it should return an
 176 encoded code.  ENCODING may be nil, in which case CHARSET is used
 177 to encode a character.
 178
 179 BYTES specifies how many bytes each character has in the encoded
 180 byte sequence; it should be 1 or 2.  If ENCODING is a charset,
 181 BYTES may be nil, in chich case the dimension of ENCODING is
 182 used.
 183
 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
 187 font family.
 188
 189 See also the variable `ps-font-info-database'.")
 190
 191 (defconst ps-mule-font-info-database-latin
 192   '((iso-8859-1
 193      (normal nil nil)))
 194   "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
 195
 196 (defcustom ps-mule-font-info-database-default
 197   ps-mule-font-info-database-latin
 198   "*The default setting to use when `ps-multibyte-buffer' is nil."
 199   :type '(symbol :tag "Multi-Byte Buffer Database Font Default")
 200   :group 'ps-print-font)
 201
 202 (defconst ps-mule-font-info-database-ps
 203   '((katakana-jisx0201
 204      (normal builtin "Ryumin-Light.Katakana")
 205      (bold builtin "GothicBBB-Medium.Katakana")
 206      (bold-italic builtin "GothicBBB-Medium.Katakana"))
 207     (latin-jisx0201
 208      (normal builtin "Ryumin-Light.Hankaku")
 209      (bold builtin "GothicBBB-Medium.Hankaku"))
 210     (japanese-jisx0208
 211      (normal builtin "Ryumin-Light-H")
 212      (bold builtin "GothicBBB-Medium-H"))
 213     (korean-ksc5601
 214      (normal builtin "Munhwa-Regular-KSC-EUC-H")
 215      (bold builtin "Munhwa-Bold-KSC-EUC-H"))
 216     )
 217   "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
 218
 219 Currently, data for Japanese and Korean PostScript printers are listed.")
 220
 221 (defconst ps-mule-font-info-database-bdf
 222   '((iso-8859-1
 223      (normal bdf ("lt1-24-etl.bdf" "etl24-latin1.bdf"))
 224      (bold bdf ("lt1-16b-etl.bdf" "etl16b-latin1.bdf"))
 225      (italic bdf ("lt1-16i-etl.bdf" "etl16i-latin1.bdf"))
 226      (bold-italic bdf ("lt1-16bi-etl.bdf" "etl16bi-latin1.bdf")))
 227     (iso-8859-2
 228      (normal bdf ("lt2-24-etl.bdf" "etl24-latin2.bdf")))
 229     (iso-8859-3
 230      (normal bdf ("lt3-24-etl.bdf" "etl24-latin3.bdf")))
 231     (iso-8859-4
 232      (normal bdf ("lt4-24-etl.bdf" "etl24-latin4.bdf")))
 233     (thai-tis620
 234      (normal bdf ("thai24.bdf" "thai-24.bdf") iso-8859-11))
 235     (greek-iso8859-7
 236      (normal bdf ("grk24-etl.bdf" "etl24-greek.bdf") iso-8859-7))
 237     (hebrew-iso8859-8
 238      (normal bdf ("heb24-etl.bdf" "etl24-hebrew.bdf") iso-8859-8))
 239     (jisx0201
 240      (normal bdf "12x24rk.bdf" jisx0201))
 241     (cyrillic-iso8859-5
 242      (normal bdf ("cyr24-etl.bdf" "etl24-cyrillic.bdf") iso-8859-5))
 243     (iso-8859-9
 244      (normal bdf ("lt5-24-etl.bdf" "etl24-latin5.bdf") iso-8859-9))
 245     (chinese-gb2312
 246      (normal bdf "gb24st.bdf"))
 247     (japanese-jisx0208
 248      (normal bdf "jiskan24.bdf"))
 249     (korean-ksc5601
 250      (normal bdf "hanglm24.bdf"))
 251     (japanese-jisx0212
 252      (normal bdf ("jksp40.bdf" "jisksp40.bdf")))
 253     (chinese-cns11643-1
 254      (normal bdf ("cns1-40.bdf" "cns-1-40.bdf")))
 255     (chinese-cns11643-2
 256      (normal bdf ("cns2-40.bdf" "cns-2-40.bdf")))
 257     (big5
 258      (normal bdf "taipei24.bdf"))
 259     (chinese-sisheng
 260      (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf")))
 261     (ipa
 262      (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ipa))
 263     (viscii
 264      (normal bdf ("visc24-etl.bdf" "etl24-viscii.bdf")))
 265     (arabic-digit
 266      (normal bdf ("arab24-0-etl.bdf" "etl24-arabic0.bdf")))
 267     (arabic-1-column
 268      (normal bdf ("arab24-1-etl.bdf" "etl24-arabic1.bdf")))
 269     (lao
 270      (normal bdf ("lao24-mule.bdf" "mule-lao-24.bdf") ps-mule-encode-lao 1))
 271     (arabic-2-column
 272      (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf")))
 273     (devanagari-cdac
 274      (normal bdf "dvsr0ntt-32.bdf"))
 275     (malayalam-cdac
 276      (normal bdf "mlkr0ntt-32.bdf"))
 277     (tamil-cdac
 278      (normal bdf "tmvl0ntt-32.bdf"))
 279     (indian-is13194
 280      (normal bdf ("isci24-mule.bdf" "mule-iscii-24.bdf")))
 281     (indian-1-column
 282      (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf")))
 283     (ethiopic
 284      (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") unicode-bmp))
 285     (chinese-cns11643-3
 286      (normal bdf ("cns3-40.bdf" "cns-3-40.bdf")))
 287     (chinese-cns11643-4
 288      (normal bdf ("cns4-40.bdf" "cns-4-40.bdf")))
 289     (chinese-cns11643-5
 290      (normal bdf ("cns5-40.bdf" "cns-5-40.bdf")))
 291     (chinese-cns11643-6
 292      (normal bdf ("cns6-40.bdf" "cns-6-40.bdf")))
 293     (chinese-cns11643-7
 294      (normal bdf ("cns7-40.bdf" "cns-7-40.bdf")))
 295     (indian-2-column
 296      (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf")))
 297     (tibetan
 298      (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf")))
 299     (unicode-bmp
 300      (normal bdf "etl24-unicode.bdf"))
 301     )
 302   "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
 303 BDF (Bitmap Distribution Format) is a format used for distributing X's font
 304 source file.
 305
 306 Current default value list for BDF fonts is included in `intlfonts-1.2'
 307 which is a collection of X11 fonts for all characters supported by Emacs.
 308
 309 Using this list as default value to `ps-mule-font-info-database', all
 310 characters including ASCII and Latin-1 are printed by BDF fonts.
 311
 312 See also `ps-mule-font-info-database-ps-bdf'.")
 313
 314 (defconst ps-mule-font-info-database-ps-bdf
 315   (cons (car ps-mule-font-info-database-latin)
 316         (cdr (cdr ps-mule-font-info-database-bdf)))
 317   "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
 318
 319 Current default value list for BDF fonts is included in `intlfonts-1.2'
 320 which is a collection of X11 fonts for all characters supported by Emacs.
 321
 322 Using this list as default value to `ps-mule-font-info-database', all
 323 characters except ASCII and Latin-1 characters are printed with BDF fonts.
 324 ASCII and Latin-1 characters are printed with PostScript font specified
 325 by `ps-font-family' and `ps-header-font-family'.
 326
 327 See also `ps-mule-font-info-database-bdf'.")
 328
 329 (defvar ps-mule-font-spec-list nil
 330   "Array of FONT-SPEC lists for each font type.
 331
 332 Elements are for `normal' font, `bold' font, `italic' font, and
 333 `bold-italic' font in this order.
 334
 335 Each element is a list of FONT-SPEC which has this form:
 336
 337         (ID CHARSET (FONT-SRC FONT-NAME ENCODING) EXTRA-DATA)
 338
 339 Where
 340
 341 ID is a number for this FONT-SPEC and is unique in the list.
 342
 343 CHARSET, FONT-SRC, FONT-NAME, ENCODING are the same as those in
 344 `ps-mule-font-info-database' (which see).
 345
 346 EXTRA-DATA is a data attached by external libraries.
 347
 348 Each list is ordered by the current charset priorities.
 349
 350 This variable is setup by `ps-mule-begin-job' from
 351 `ps-mule-font-info-database'.")
 352
 353 ;; Functions to access each element of FONT-SPEC.
 354 (defsubst ps-mule-font-spec-id (font-spec) (aref font-spec 0))
 355 (defsubst ps-mule-font-spec-charset (font-spec) (aref font-spec 1))
 356 (defsubst ps-mule-font-spec-font-id (font-spec) (aref font-spec 2))
 357 (defsubst ps-mule-font-spec-src (font-spec) (aref font-spec 3))
 358 (defsubst ps-mule-font-spec-name (font-spec) (aref font-spec 4))
 359 (defsubst ps-mule-font-spec-set-name (font-spec name)
 360   (aset font-spec 4 name))
 361 (defsubst ps-mule-font-spec-encoding (font-spec) (aref font-spec 5))
 362 (defsubst ps-mule-font-spec-bytes (font-spec) (aref font-spec 6))
 363 (defsubst ps-mule-font-spec-extra (font-spec) (aref font-spec 7))
 364 (defsubst ps-mule-font-spec-set-extra (font-spec extra)
 365   (aset font-spec 7 extra))
 366
 367 ;; Functions to encode character into glyph code.
 368 (defun ps-mule-encode-lao (char)
 369   (- char #x0DE0))
 370
 371 (defun ps-mule-encode-char (char font-spec)
 372   (let ((encoding (ps-mule-font-spec-encoding font-spec)))
 373     (cond ((charsetp encoding)
 374            (encode-char char encoding))
 375           ((fboundp encoding)
 376            (funcall encoding char))
 377           (t
 378            char))))
 379
 380 ;; Array of FONT-SPEC-TABLEs; Nth element is for FONT-TYPE N.
 381 ;;
 382 ;; FONT-TYPE is 0, 1, 2, or 3 representing normal, bold, italic, and
 383 ;; bold-italic respectively.
 384 ;;
 385 ;; FONT-SPEC-TABLE is a char-table of FONT-SPECs.  It records which
 386 ;; character is printed by which FONT-SPEC.  It has one extra slot
 387 ;; whose value is an alist of the form:
 388 ;;      (CHARSET . FONT-SPEC)
 389 ;; FONT-SPEC is a vecotr of the form:
 390 ;;      (ID FONT-SRC FONT-NAME ENCODING EXTRA)
 391 (defvar ps-mule-font-spec-tables nil)
 392
 393 ;; Array of FONT-TYPEs; Nth element FONT-NUMBER N.
 394 ;;
 395 ;; FONT-NUMBER is 0, 1, 2, 3, 4, 5, 6 representing fonts f0, f1, f2,
 396 ;; f3, h0, h1, and H0.
 397 (defconst ps-mule-font-number-to-type [ 0 1 2 3 1 0 0 ])
 398
 399 (defsubst ps-mule-get-font-spec (char font-spec-table font-spec)
 400   "Return a font spec for printing CHAR with FONT-SPEC-TABLE.
 401
 402 FONT-SPEC, if non-nil, is a font spec to try at first.
 403
 404 See the documentation of `ps-mule-font-spec-tables' for the
 405 format of font spec."
 406
 407   (or (aref font-spec-table char)
 408       (aset font-spec-table char
 409             (or (and (< char 256)
 410                      (cdr (car (char-table-extra-slot font-spec-table 0))))
 411                 (and font-spec
 412                      (encode-char char (ps-mule-font-spec-charset font-spec))
 413                      font-spec)
 414                 (catch 'tag
 415                   (dolist (elt (char-table-extra-slot font-spec-table 0))
 416                     (and (encode-char char (car elt))
 417                          (throw 'tag (cdr elt)))))
 418                 ;; Record that no font-spec exist for CHAR.
 419                 t))))
 420
 421 (defconst ps-mule-external-libraries
 422   '((builtin nil nil nil nil nil nil)
 423     (bdf ps-bdf nil bdf-generate-prologue
 424          bdf-check-font bdf-generate-font bdf-generate-glyph)
 425     (pcf nil nil pcf-generate-prologue
 426          pcf-check-font pcf-generate-font pcf-generate-glyph)
 427     (vflib nil nil vflib-generate-prologue
 428            vflib-check-font vflib-generate-font vflib-generate-glyphs))
 429   "Alist of information of external libraries to support PostScript printing.
 430 Each element has the form:
 431
 432     (FONT-SRC FEATURE INITIALIZED-P
 433      PROLOGUE-FUNC CHECK-FUNC FONT-FUNC GLYPH-FUNC)
 434
 435 FONT-SRC is the font source: builtin, bdf, pcf, or vflib.
 436
 437 FEATURE is the feature that provide a facility to handle FONT-SRC.  Except for
 438 `builtin' FONT-SRC, this feature is automatically `require'd before handling
 439 FONT-SRC.  Currently, we only have the feature `ps-bdf'.
 440
 441 INITIALIZED-P indicates if this library is initialized or not.
 442
 443 PROLOGUE-FUNC is a function to generate PostScript code which
 444 define several PostScript procedures that will be called by
 445 FONT-FUNC and GLYPHS-FUNC.  It is called with no argument, and
 446 should return a list of strings.
 447
 448 CHECK-FUNC is a function to check if a font is available or not.
 449 It is called with one argument FONT-SPEC, and should return
 450 non-nil iff the font specified in FONT-SPEC is available.
 451
 452 FONT-FUNC is a function to generate PostScript code which define
 453 a new font.  It is called with one argument FONT-SPEC, and should
 454 return a list of strings.
 455
 456 GLYPH-FUNC is a function to generate PostScript code which define a glyph of
 457 characters.  It is called with two arguments FONT-SPEC and CODE,
 458 and should return a list of strings.")
 459
 460 (defsubst ps-mule-exlib-feature (exlib) (nth 1 exlib))
 461 (defsubst ps-mule-exlib-initialized-p (exlib) (nth 2 exlib))
 462 (defsubst ps-mule-exlib-set-initialized-p (exlib val)
 463   (setcar (nthcdr 2 exlib) val))
 464 (defsubst ps-mule-exlib-prologue (exlib) (nth 3 exlib))
 465 (defsubst ps-mule-exlib-check (exlib) (nth 4 exlib))
 466 (defsubst ps-mule-exlib-font (exlib) (nth 5 exlib))
 467 (defsubst ps-mule-exlib-glyph (exlib) (nth 6 exlib))
 468
 469 (defun ps-mule-init-external-library (exlib)
 470   "Initialize external library specified by EXLIB for PostScript printing.
 471 See the documentation of `ps-mule-external-libraries' for EXLIB's meaning."
 472   (or (ps-mule-exlib-initialized-p exlib)
 473       (let ((prologue-func (ps-mule-exlib-prologue exlib)))
 474         (if prologue-func
 475             (let ((feature (ps-mule-exlib-feature exlib)))
 476               (if feature
 477                   (require feature))
 478               (ps-output-prologue (funcall prologue-func))))
 479         (ps-mule-exlib-set-initialized-p exlib t))))
 480
 481 (defvar ps-mule-output-list nil)
 482
 483 (defun ps-mule-check-font (font-spec)
 484   "Check if a font specified in FONT-SPEC is available or not."
 485   (let ((font-src (ps-mule-font-spec-src font-spec)))
 486     (or (not font-src)
 487         (let ((exlib (assq font-src ps-mule-external-libraries)))
 488           (ps-mule-init-external-library exlib)
 489           (or (not (ps-mule-exlib-check exlib))
 490               (funcall (ps-mule-exlib-check exlib) font-spec))))))
 491
 492 (defun ps-mule-prepare-font (font-spec)
 493   "Generate PostScript codes defining a new font of FONT-TYPE for CHARSET."
 494   (let* ((font-src (ps-mule-font-spec-src font-spec))
 495          (exlib (assq font-src ps-mule-external-libraries))
 496          (id (ps-mule-font-spec-id font-spec))
 497          (ftag (format "%02X" id))
 498          (font-func (ps-mule-exlib-font exlib))
 499          output-list)
 500     (if font-func
 501         (setq output-list (funcall font-func font-spec))
 502       (setq output-list
 503             (format "/F%s /%s findfont def\n"
 504                     ftag (or (ps-mule-font-spec-name font-spec) "Courier")))
 505       (ps-mule-font-spec-set-extra font-spec t))
 506     (and output-list
 507          (nconc ps-mule-output-list (list output-list)))))
 508
 509 (defun ps-mule-prepare-glyph (char font-spec)
 510   "Generate PostScript codes to print CHAR by FONT-SPEC.
 511
 512 If CHAR is a cons (FROM TO), generate codes for characters
 513 specified by the character code range FROM and TO.
 514
 515 The generated code is inserted on prologue part."
 516   (if (vectorp font-spec)
 517       (progn
 518         (or (ps-mule-font-spec-extra font-spec)
 519             (ps-mule-prepare-font font-spec))
 520         (let ((glyph-func (ps-mule-exlib-glyph
 521                            (assq (ps-mule-font-spec-src font-spec)
 522                                  ps-mule-external-libraries))))
 523           (if glyph-func
 524               (let (from to output-list)
 525                 (if (consp char)
 526                     (setq from (car char) to (cdr char))
 527                   (setq from char to char))
 528                 (while (<= from to)
 529                   (setq output-list
 530                         (funcall glyph-func font-spec from))
 531                   (and output-list
 532                        (ps-output-prologue output-list))
 533                   (setq from (1+ from)))))))))
 534
 535 ;; This is a PostScript code inserted in the header of generated PostScript.
 536 (defconst ps-mule-prologue
 537   "%%%% Start of Mule Section
 538
 539 /Latin1Encoding {       % newname fontname  |  font
 540     findfont dup length dict begin
 541         { 1 index /FID ne { def } { pop pop } ifelse } forall
 542         /Encoding ISOLatin1Encoding def
 543         currentdict
 544     end
 545     definefont
 546 } bind def
 547
 548 %% Redefine fonts for multiple charsets.
 549 /ReDefFont {                 % fontname encoding fdepvector size  |  -
 550   20 dict begin
 551   3 index findfont {
 552     1 index /FID ne 2 index /UniqueID ne and {def} {pop pop} ifelse
 553   } forall
 554   /FontType 0 def
 555   /FMapType 3 def
 556   /EscChar 0 def
 557   % FontMatrix ::= [ size 0 0 size 0 0 ]
 558   /FontMatrix exch [ exch dup 0 exch 0 exch 0 0 ] def
 559   /FDepVector exch def
 560   /Encoding exch def
 561   currentdict
 562   end                   % fontname dic
 563   definefont pop
 564 } bind def
 565 "
 566   "PostScript code for printing multi-byte characters.")
 567
 568 (defvar ps-mule-prologue-generated nil)
 569
 570 ;; EscChar used in generated composite fonts.
 571 (defconst ps-mule-esc-char 0)
 572
 573 (defun ps-mule-prologue-generated ()
 574   (unless ps-mule-prologue-generated
 575     (ps-output-prologue ps-mule-prologue)
 576     (ps-output-prologue (format "/EscChar %d def\n" ps-mule-esc-char))
 577     (setq ps-mule-prologue-generated t)))
 578
 579 (defun ps-mule-encode-region (from to font-spec-table)
 580   "Generate PostScript code for plotting characters in the region FROM and TO.
 581
 582 FONT-NUM is 0, 1, 2, 3, 4, 5, or 6, each represents font tags
 583 f0, f1, f2, f3, h0, h1, and H0 respectively."
 584   (let* ((font-spec nil)
 585          (font-id 0)
 586          (string-list nil)
 587          ;; At most 4-byte (EscChar FONT-ID CODE1 CODE2) per character.
 588          (str (make-string (* (- to from) 4) 0))
 589          (i 0))
 590     (goto-char from)
 591     (while (< (point) to)
 592       (let* ((char (following-char))
 593              (this-spec (ps-mule-get-font-spec char font-spec-table font-spec))
 594              this-id)
 595         (if (vectorp this-spec)
 596             (setq this-id (ps-mule-font-spec-font-id this-spec))
 597           ;; Can't print CHAR.   Replace it with '?'.
 598           (setq char ??
 599                 this-spec (ps-mule-get-font-spec char font-spec-table nil)
 600                 this-id (ps-mule-font-spec-font-id this-spec)))
 601         (or (= font-id this-id)
 602             (progn
 603               (if font-spec
 604                   (setq string-list (cons (substring str 0 i) string-list)
 605                         i 0))
 606               (setq font-id this-id)
 607               (or (= font-id 0)
 608                   (progn
 609                     (aset str i ps-mule-esc-char)
 610                     (setq i (1+ i))
 611                     (aset str i font-id)
 612                     (setq i (1+ i))))))
 613         (setq font-spec this-spec)
 614         (if (< char 128)
 615             (aset str i char)
 616           (let* ((code (ps-mule-encode-char char font-spec)))
 617             (if (= (ps-mule-font-spec-bytes font-spec) 1)
 618                 (aset str i code)
 619               (aset str i (/ code 256))
 620               (setq i (1+ i))
 621               (aset str i (% code 256)))))
 622         (setq i (1+ i))
 623         (forward-char 1)))
 624     (nreverse (cons (substring str 0 i) string-list))))
 625
 626 (defun ps-mule-plot-composition (composition font-spec-table)
 627   "Generate PostScript code for plotting COMPOSITION with FONT-NUM."
 628   (ps-output "[")
 629   (let ((components (copy-sequence (nth 2 composition)))
 630         (font-spec nil))
 631     (dotimes (i (length components))
 632       (let ((elt (aref components i))
 633             this-spec)
 634         (if (consp elt)
 635             ;; ELT is a composition rule.
 636             (ps-output (format " %d" (encode-composition-rule elt)))
 637           ;; ELT is a glyph character.
 638           (setq this-spec
 639                 (ps-mule-get-font-spec elt font-spec-table font-spec))
 640           (or (vectorp this-spec)
 641               ;; Can't print CHAR.   Replace it with '?'.
 642               (setq elt ??
 643                     this-spec
 644                     (ps-mule-get-font-spec elt font-spec-table font-spec)))
 645           (setq font-spec this-spec)
 646           (let* ((bytes (ps-mule-font-spec-bytes font-spec))
 647                  (code (ps-mule-encode-char elt font-spec))
 648                  (font-id (ps-mule-font-spec-font-id font-spec))
 649                  (str (make-string (if (= font-id 0) 1 (+ 2 bytes)) 0)))
 650             (if (= font-id 0)
 651                 (aset str 0 code)
 652               (aset str 0 ps-mule-esc-char)
 653               (aset str 1 font-id)
 654               (if (= bytes 1)
 655                   (aset str 2 code)
 656                 (aset str 2 (/ code 256))
 657                 (aset str 3 (% code 256))))
 658             (ps-output "[")
 659             (ps-output-string str)
 660             (ps-output (if (eq (ps-mule-font-spec-src font-spec) 'bdf)
 661                            (format "/C%02X-%X" (ps-mule-font-spec-id font-spec)
 662                                    elt)
 663                          "false"))
 664             (ps-output "]"))))))
 665   (ps-output " ] " (if (nth 3 composition) "RLC" "RBC") "\n"))
 666
 667 (defun ps-mule-plot-string (from to &optional bg-color)
 668   "Generate PostScript code for plotting characters in the region FROM and TO.
 669
 670 Optional argument BG-COLOR is ignored.
 671
 672 Returns the value:
 673
 674         (ENDPOS . RUN-WIDTH)
 675
 676 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
 677 the sequence."
 678   (let* ((average-width (ps-avg-char-width 'ps-font-for-text))
 679          (point (point))
 680          (composition (find-composition from to nil t))
 681          (stop (if composition (car composition) to))
 682          (ascii-or-latin-1 "[\000-\377]+")
 683          (run-width 0)
 684          (endpos nil)
 685          (font-spec-table (aref ps-mule-font-spec-tables
 686                                 (aref ps-mule-font-number-to-type
 687                                       ps-current-font)))
 688          width)
 689     (goto-char from)
 690     (while (not endpos)
 691       (cond ((= (point) stop)
 692              (if (= stop to)
 693                  (setq endpos stop)
 694                (if (< from stop)
 695                    (dolist (l (ps-mule-encode-region from (point)
 696                                                      font-spec-table))
 697                      (ps-output-string l)
 698                      (ps-output " S\n")))
 699                (setq width (* (nth 5 composition) average-width))
 700                (if (< ps-width-remaining (+ run-width width))
 701                    (setq endpos stop)
 702                  (ps-mule-plot-composition composition font-spec-table)
 703                  (setq run-width (+ run-width width)
 704                        from (nth 1 composition))
 705                  (goto-char from)
 706                  (setq composition (find-composition (point) to nil t))
 707                  (setq stop (if composition (car composition) to)))))
 708
 709             ((looking-at ascii-or-latin-1)
 710              (let ((nchars (- (min (match-end 0) stop) (point))))
 711                (setq width (* average-width nchars))
 712                (if (< ps-width-remaining (+ run-width width))
 713                    (setq nchars (truncate (- ps-width-remaining run-width)
 714                                           average-width)
 715                          run-width (+ run-width (* nchars average-width))
 716                          endpos (+ (point) nchars))
 717                  (setq run-width (+ run-width width))
 718                  (forward-char nchars))))
 719
 720             (t
 721              (while (and (< (point) stop) (not endpos))
 722                (setq width (char-width (following-char)))
 723                (if (< ps-width-remaining (+ run-width width))
 724                    (setq endpos (point))
 725                  (setq run-width (+ run-width width))
 726                  (forward-char 1))))))
 727
 728     (if (< from endpos)
 729         (dolist (l (ps-mule-encode-region from endpos font-spec-table))
 730           (ps-output-string l)
 731           (ps-output " S\n")))
 732     (goto-char point)
 733     (cons endpos run-width)))
 734
 735 ;; Character composition support
 736
 737 (defvar ps-mule-composition-prologue-generated nil)
 738
 739 (defconst ps-mule-composition-prologue
 740   "%%%% Procedures for character composition.
 741 /RelativeCompositionSkip 0.4 def
 742
 743 %% Get a bounding box (relative to currentpoint) of STR.
 744 /GetPathBox {                   % [ str cname ]  |  -
 745     dup 1 get dup false ne {
 746         BitmapDict exch get /bmp exch def
 747         %% bmp ::= [ DWIDTH WIDTH HEIGHT XOFF YOFF BITMAP RELATIVE-COMPOSE]
 748         /LLY bmp 4 get def
 749         /URY LLY bmp 2 get add def
 750         /RelativeCompose bmp 6 get dup false ne {
 751             dup LLY le { pop 1 } { URY ge { -1 } { 0 } ifelse } ifelse
 752         } {
 753             pop 0
 754         } ifelse def
 755         dup 0 get stringwidth pop dup /WIDTH exch def bmp 0 get div
 756         dup LLY mul /LLY exch def
 757         URY mul /URY exch def
 758     } {
 759         pop
 760         dup 0 get stringwidth pop /WIDTH exch def
 761         gsave 0 0 moveto
 762         dup 0 get false charpath flattenpath pathbbox
 763         /URY exch def pop /LLY exch def pop
 764         grestore
 765         /RelativeCompose 0 def
 766     } ifelse
 767 } bind def
 768
 769 %% Apply effects except for shadow and outline to the rectangle
 770 %% specified by TOP BOTTOM LEFT RIGHT.
 771 /SpecialEffect {                % --  |  --
 772     currentpoint dup TOP add /yy exch def BOTTOM add /YY exch def
 773     dup LEFT add /xx exch def RIGHT add /XX exch def
 774     %% Adjust positions for future shadowing.
 775     Effect 8 and 0 ne {
 776         /yy yy Yshadow add def
 777         /XX XX Xshadow add def
 778     } if
 779     Effect 1 and 0 ne { UnderlinePosition Hline } if    % underline
 780     Effect 2 and 0 ne { StrikeoutPosition Hline } if    % strikeout
 781     Effect 4 and 0 ne { OverlinePosition  Hline } if    % overline
 782     bg {                                                % background
 783         true
 784         Effect 16 and 0 ne {SpaceBackground doBox} { xx yy XX YY doRect} ifelse
 785     } if
 786     Effect 16 and 0 ne { false 0 doBox } if             % box
 787 } def
 788
 789 %% Draw COMPONENTS which has the form [ [str0 xoff0 yoff0] ... ] with
 790 %% effects shadow and outline.
 791 /ShowComponents {               % components  |  -
 792     gsave
 793     {   gsave aload pop rmoveto
 794         Effect 8 and 0 ne { dup doShadow } if
 795         Effect 32 and 0 ne { true doOutline } { show } ifelse
 796         grestore
 797     } forall
 798     grestore
 799     RIGHT 0 rmoveto
 800 } def
 801
 802 %% Show relative composition.
 803 /RLC {         % [[str0 cname0] [str1 cname1] ... [strN cnameN]]  |  -
 804     /components exch def
 805     [                           % push [str xoff yoff] one by one
 806     [ components 0 get GetPathBox aload pop pop 0 0 ]
 807     %% Bounding box of overall glyphs.
 808     /LEFT 0 def
 809     /RIGHT WIDTH def
 810     /TOP URY def
 811     /BOTTOM LLY def
 812
 813     1 1 components length 1 sub {
 814         components exch get
 815         [ exch
 816             GetPathBox
 817             aload pop pop                               % str
 818             0                                           % xoff
 819             RelativeCompose 1 eq {          % compose on TOP
 820                 TOP LLY sub RelativeCompositionSkip add % yoff
 821                 /TOP TOP URY LLY sub add RelativeCompositionSkip add def
 822             } { RelativeCompose -1 eq { % compose under BOTTOM
 823                 BOTTOM URY sub RelativeCompositionSkip sub % yoff
 824                 /BOTTOM BOTTOM URY LLY sub sub
 825                 RelativeCompositionSkip sub def
 826             } {
 827                 0                                       % yoff
 828                 URY TOP gt { /TOP URY def } if
 829                 LLY BOTTOM lt { /BOTTOM LLY def } if
 830             } ifelse } ifelse
 831         ]
 832     } for
 833     ]
 834     SpecialEffect               % Reflect special effects.
 835     ShowComponents              % Draw components.
 836 } def
 837
 838 %% Show rule-base composition.
 839 /RBC { % [[str0 cname0] rule1 [str1 cname0] rule2 ... [strN cnameN]]  |  -
 840     /components exch def
 841     [                           % push [str xoff yoff] one by one
 842     [ components 0 get GetPathBox aload pop pop 0 0 ]
 843     %% Bounding box of overall glyphs.
 844     /LEFT 0 def
 845     /RIGHT WIDTH def
 846     /TOP URY def
 847     /BOTTOM LLY def
 848     1 1 components length 1 sub {
 849         components exch get /elt exch def
 850         elt type /integertype eq {                      % rule
 851             %% Do the same RULE decoding as the macro
 852             %% COMPOSITION_DECODE_RULE in emacs/src/composite.h.
 853             elt 12 idiv dup 3 mod /grefx exch def 3 idiv /grefy exch def
 854             elt 12 mod dup 3 mod /nrefx exch def 3 idiv /nrefy exch def
 855         } {                                             % other strings
 856             [
 857             elt GetPathBox
 858             aload pop pop
 859             /height URY LLY sub def
 860             /left LEFT [ 0 RIGHT LEFT sub dup 2 div exch ] grefx get add
 861                 [ 0 WIDTH 2 div WIDTH ] nrefx get sub def
 862             /bottom [ TOP 0 BOTTOM TOP BOTTOM add 2 div ] grefy get
 863                 [ height LLY neg 0 height 2 div ] nrefy get sub def
 864             %% Update bounding box
 865             left LEFT lt { /LEFT left def } if
 866             left WIDTH add RIGHT gt { /RIGHT left WIDTH add def } if
 867             bottom BOTTOM lt { /BOTTOM bottom def } if
 868             bottom height add TOP gt { /TOP bottom height add def } if
 869             left bottom LLY sub ]
 870         } ifelse
 871     } for
 872     ]
 873
 874     LEFT 0 lt {                 % Adjust xoff to the right.
 875         dup { dup 1 get LEFT sub 1 exch put } forall
 876         /RIGHT RIGHT LEFT sub def
 877     } if
 878
 879     SpecialEffect               % Reflect special effects.
 880     ShowComponents              % Draw components.
 881 } def
 882 %%%% End of procedures for character composition
 883 "
 884   "PostScript code for printing character composition.")
 885
 886 (defun ps-mule-composition-prologue-generated ()
 887   (unless ps-mule-composition-prologue-generated
 888     (ps-mule-prologue-generated)
 889     (ps-output-prologue ps-mule-composition-prologue)
 890     (setq ps-mule-composition-prologue-generated t)))
 891
 892 ;; Bitmap font support
 893
 894 (defvar ps-mule-bitmap-prologue-generated nil)
 895
 896 (defconst ps-mule-bitmap-prologue
 897   "%%%% Procedures for bitmap fonts.
 898
 899 %% Create a base bitmap font.
 900 /NBF { % fontname fontsize relative-compose baseline-offset enc  |  --
 901     11 dict begin
 902     /FontType 3 def
 903     /FontMatrix matrix def
 904     /FontBBox [ 0 0 0 0 ] def
 905     /Encoding exch def
 906     /BaselineOffset exch def
 907     /RelativeCompose exch def
 908     /FontSize exch def
 909     /FontMatrix [ 1 FontSize div 0 0 1 FontSize div 0 0 ] def
 910     /BuildGlyph {               % fontdict charname  |  -
 911         BitmapDict exch get /bmp exch def pop
 912         %% bmp ::= [ DWIDTH WIDTH HEIGHT XOFF YOFF BITMAP RELATIVE-COMPOSE ]
 913         /llx bmp 3 get def
 914         /lly bmp 4 get def
 915         /urx llx bmp 1 get add def
 916         /ury lly bmp 2 get add def
 917         bmp 0 get 0 llx lly urx ury setcachedevice
 918         bmp 5 get length 0 gt {
 919             llx ury translate
 920             bmp 1 get bmp 2 get
 921             true [ 1 0 0 -1 0 0 ] { bmp 5 get } imagemask
 922         } if
 923     } bind def
 924     /BuildChar {                % fontdict byte  |  -
 925         1 index /Encoding get exch get
 926         1 index /BuildGlyph get exec
 927     } bind def
 928     dup currentdict end
 929     definefont def
 930 } bind def
 931
 932 %% Create a parent font of 8/8 mapping.
 933 /NPF {                          % fontname encoding fdepvector  |  -
 934     8 dict begin
 935         /FontType 0 def
 936         /FMapType 2 def
 937         /FontMatrix matrix def
 938         /FDepVector exch def
 939         /Encoding exch def
 940         dup currentdict
 941     end
 942     definefont def
 943 } bind def
 944
 945 %%%% End of procedures for bitmap fonts.
 946 ")
 947
 948 ;; External library support.
 949
 950 (defvar ps-mule-bitmap-dict-list nil)
 951 (defvar ps-mule-bitmap-font-record nil)
 952
 953 ;; The following three functions are to be called from external
 954 ;; libraries which support bitmap fonts (e.g. `bdf') to get
 955 ;; appropriate PostScript code.
 956
 957 (defun ps-mule-generate-bitmap-prologue ()
 958   (unless ps-mule-bitmap-prologue-generated
 959     (setq ps-mule-bitmap-prologue-generated t
 960           ps-mule-bitmap-dict-list nil
 961           ps-mule-bitmap-font-record (make-vector 1024 nil))
 962     (list ps-mule-bitmap-prologue)))
 963
 964 (defun ps-mule-generate-bitmap-font (font-spec size relative-compose
 965                                                baselie-offset bbx)
 966   (let* ((id (ps-mule-font-spec-id font-spec))
 967          (bytes (ps-mule-font-spec-bytes font-spec))
 968          output-list)
 969     (if (= bytes 1)
 970         (setq output-list
 971               (list (format "/E%02X [ 0 1 255 {pop /.notdef} for ] def\n" id)
 972                     (format "%%%% %s\n" (ps-mule-font-spec-name font-spec))
 973                     (format "/F%02X %f %S %d E%02X NBF\n" id size
 974                             relative-compose baselie-offset id)))
 975       (setq output-list
 976             (list (list (format "/E%02X [ 0 1 255 { pop 0 } for ] def\n" id))
 977                   (list (format "/V%02X [" id))
 978                   " ] def\n"
 979                   (format "%%%% %s\n" (ps-mule-font-spec-name font-spec))
 980                   (format "/F%02X E%02X V%02X NPF\n" id id id))))
 981     (aset ps-mule-bitmap-font-record id
 982           (vector (= bytes 1) output-list
 983                   size relative-compose baselie-offset bbx))
 984     (if ps-mule-bitmap-dict-list
 985         output-list
 986       (setq ps-mule-bitmap-dict-list (list "/BitmapDict <<\n" ">> def\n"))
 987       (cons ps-mule-bitmap-dict-list output-list))))
 988
 989 (defun ps-mule-generate-bitmap-glyph (font-spec char code bitmap)
 990   (let* ((id (ps-mule-font-spec-id font-spec))
 991          ;; FONT-RECORD ::= ([(SUBFONT-OUTPUT-LIST ...) | t]
 992          ;;                  BASEFONT-OUTPUT-LIST SIZE REL-COMP B-OFFSET BBX)
 993          (font-record (aref ps-mule-bitmap-font-record id))
 994          enc-name
 995          output-list)
 996     (if (listp (aref font-record 0))
 997         ;; This is a 2-dimensional font.  Create a subfont for this
 998         ;; glyph if not yet created.
 999         (let* ((high (/ code 256))
1000                (id2 (+ (* id 256) high)))
1001           (setq output-list (cdr (assq high (aref font-record 0)))
1002                 code (% code 256))
1003           (or output-list
1004               ;; We must create a subfont.
1005               (let ((enc-list (car (aref font-record 1)))
1006                     (fdep-list (nth 1 (aref font-record 1))))
1007                 (setq output-list
1008                       (list
1009                        (format "/E%04X [ 0 1 255 {pop /.notdef} for ] def\n"
1010                                id2)
1011                        (format "/F%04X %f %S %d E%04X NBF\n"
1012                                id2 (aref font-record 2) (aref font-record 3)
1013                                (aref font-record 4) id2)
1014                        (format "E%02X %d %d put\n"
1015                                id high (1- (length fdep-list)))))
1016                 (nconc enc-list (list output-list))
1017                 (nconc fdep-list (list (format " F%04X" id2)))
1018                 (aset font-record 0
1019                       (cons (cons high output-list) (aref font-record 0)))))
1020           (setq enc-name (format "%04X" id2)))
1021       (setq output-list (aref font-record 1)
1022             enc-name (format "%02X" id)))
1023     (setcdr ps-mule-bitmap-dict-list
1024             (cons (format "/C%02X-%X %s\n" id char bitmap)
1025                   (cdr ps-mule-bitmap-dict-list)))
1026     (setcdr output-list
1027             (cons (format "E%s %d /C%02X-%X put\n" enc-name code id char)
1028                   (cdr output-list))))
1029   nil)
1030
1031 ;; Mule specific initializers.
1032
1033 ;;;###autoload
1034 (defun ps-mule-initialize ()
1035   "Initialize global data for printing multi-byte characters."
1036   (setq ps-mule-prologue-generated nil
1037         ps-mule-composition-prologue-generated nil
1038         ps-mule-bitmap-prologue-generated nil)
1039   (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil))
1040           ps-mule-external-libraries))
1041
1042 (defun ps-mule-encode-header-string (string fonttag)
1043   "Generate PostScript code for ploting STRING by font FONTTAG.
1044 FONTTAG should be a string \"/h0\", \"/h1\", \"/L0\", or \"/H0\"."
1045   (with-temp-buffer
1046     (insert string)
1047     (ps-mule-encode-region (point-min) (point-max)
1048                            (aref ps-mule-font-spec-tables
1049                                  (aref ps-mule-font-number-to-type
1050                                        (cond ((string= fonttag "/h0") 4)
1051                                              ((string= fonttag "/h1") 5)
1052                                              ((string= fonttag "/L0") 6)
1053                                              (t 0)))))))
1054
1055 ;;;###autoload
1056 (defun ps-mule-begin-job (from to)
1057   "Start printing job for multi-byte chars between FROM and TO.
1058 This checks if all multi-byte characters in the region are printable or not."
1059   (auto-compose-region from to)
1060   (if (and (not (find-composition from to))
1061            (save-excursion
1062              (goto-char from)
1063              (= (skip-chars-forward "\x00-\xFF" to) to)))
1064       ;; All characters can be printed by normal PostScript fonts.
1065       (setq ps-basic-plot-string-function 'ps-basic-plot-string
1066             ps-encode-header-string-function 'identity)
1067     (setq ps-basic-plot-string-function 'ps-mule-plot-string
1068           ps-encode-header-string-function 'ps-mule-encode-header-string
1069           ps-mule-font-info-database
1070           (cond ((eq ps-multibyte-buffer 'non-latin-printer)
1071                  ps-mule-font-info-database-ps)
1072                 ((eq ps-multibyte-buffer 'bdf-font)
1073                  ps-mule-font-info-database-bdf)
1074                 ((eq ps-multibyte-buffer 'bdf-font-except-latin)
1075                  ps-mule-font-info-database-ps-bdf)
1076                 (t
1077                  ps-mule-font-info-database-default)))
1078
1079     ;; Be sure to have font information for Latin-1.
1080     (or (assq 'iso-8859-1 ps-mule-font-info-database)
1081         (setq ps-mule-font-info-database
1082               (cons '(iso-8859-1 (normal nil nil))
1083                     ps-mule-font-info-database)))
1084
1085     ;; Generate ps-mule-font-spec-tables.
1086     (let ((font-spec-alist (make-vector 4 nil))
1087           (id-max 0)
1088           (font-id 0)
1089           font-info-list)
1090       ;; Generate properly ordered font-info-list from
1091       ;; ps-mule-font-info-database.
1092       (let ((charset-list
1093              (copy-sequence (get-language-info current-language-environment
1094                                                'charset))))
1095         (setq charset-list (cons 'iso-8859-1 (delq 'iso-8859-1 charset-list)))
1096         (dolist (charset charset-list)
1097           (let ((font-info (assq charset ps-mule-font-info-database)))
1098             (and font-info
1099                  (setq font-info-list (cons font-info font-info-list)))))
1100         (dolist (font-info ps-mule-font-info-database)
1101           (or (memq (car font-info) charset-list)
1102               (setq font-info-list (cons font-info font-info-list))))
1103         (setq font-info-list (nreverse font-info-list)))
1104
1105       ;; Store FONT-SPECs in each element of font-spec-alist.
1106       (dolist (font-info font-info-list)
1107         (let ((font-spec-vec (make-vector 4 nil))
1108               (charset (car font-info))
1109               encoding font-spec)
1110           (dolist (e (cdr font-info))
1111             (setq encoding (or (nth 3 e) charset)
1112                   font-spec (vector id-max charset font-id
1113                                     (nth 1 e) (nth 2 e) encoding
1114                                     (or (nth 4 e) (charset-dimension encoding))
1115                                     nil)
1116                   id-max (1+ id-max))
1117             (if (ps-mule-check-font font-spec)
1118                 (aset font-spec-vec
1119                       (cond ((eq (car e) 'normal) 0)
1120                             ((eq (car e) 'bold) 1)
1121                             ((eq (car e) 'italic) 2)
1122                             (t 3)) font-spec)))
1123           (when (aref font-spec-vec 0)
1124             (or (aref font-spec-vec 3)
1125                 (aset font-spec-vec 3 (or (aref font-spec-vec 1)
1126                                           (aref font-spec-vec 2)
1127                                           (aref font-spec-vec 0))))
1128             (or (aref font-spec-vec 1)
1129                 (aset font-spec-vec 1 (aref font-spec-vec 0)))
1130             (or (aref font-spec-vec 2)
1131                 (aset font-spec-vec 2 (aref font-spec-vec 1)))
1132             (dotimes (i 4)
1133               (aset font-spec-alist i
1134                     (nconc (aref font-spec-alist i)
1135                            (list (cons charset (aref font-spec-vec i))))))
1136             (setq font-id (1+ font-id)))))
1137
1138       ;; Make four FONT-SPEC-TABLEs and set them in
1139       ;; ps-mule-font-spec-tables.  Each char table has one extra slot
1140       ;; whose value is an element of font-spec-alist.
1141       (setq ps-mule-font-spec-tables (make-vector 4 nil))
1142       (put 'font-spec-table 'char-table-extra-slots 1)
1143       (dotimes (i 4)
1144         (let ((table (make-char-table 'font-spec-table)))
1145           (aset ps-mule-font-spec-tables i table)
1146           (set-char-table-extra-slot table 0 (aref font-spec-alist i))
1147           ;; Be sure to have glyphs for "0123456789/" in advance for
1148           ;; page numbering.
1149           (let ((str " 0123456789/"))
1150             (dotimes (i (length str))
1151               (or (vectorp (ps-mule-get-font-spec (aref str i) table nil))
1152                   (error "ASCII font not available")))))))
1153
1154     (ps-mule-prologue-generated)
1155     (if (find-composition from to)
1156         (ps-mule-composition-prologue-generated))))
1157
1158 (defun ps-mule-restruct-output-list (list tail)
1159   (dolist (elt list)
1160     (if (listp elt)
1161         (setq tail (ps-mule-restruct-output-list elt tail))
1162       (setcdr tail (cons elt (cdr tail)))
1163       (setq tail (cdr tail))))
1164   tail)
1165
1166 (defun ps-mule-redefine-font (font-number fonttag size ps-font)
1167   (let* ((font-type (aref ps-mule-font-number-to-type font-number))
1168          (font-spec-alist (char-table-extra-slot
1169                            (aref ps-mule-font-spec-tables font-type) 0)))
1170     (ps-output-prologue
1171      (list (if (ps-mule-font-spec-src (cdr (car font-spec-alist)))
1172                ;; We ignore a font specfied in ps-font-info-database.
1173                (format "/V%s VTOP%d def\n" fonttag font-type)
1174              (format "/V%s [ VTOP%d aload pop ] def\n
1175 V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
1176                      fonttag font-type fonttag ps-font ps-font))
1177            (format "/%s ETOP%d V%s %f ReDefFont\n"
1178                    fonttag font-type fonttag size)))))
1179
1180
1181 ;;;###autoload
1182 (defun ps-mule-end-job ()
1183   "Finish printing job for multi-byte chars."
1184
1185   ;; Prepare root and sub fonts while generating glyphs if necessary.
1186   (let ((output-head (list t))
1187         (ps-mule-output-list (list t)))
1188     (dotimes (i 4)
1189       (map-char-table 'ps-mule-prepare-glyph
1190                       (aref ps-mule-font-spec-tables i)))
1191     (ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head)
1192     (ps-output-prologue (cdr output-head)))
1193
1194   ;; Prepare top Encoding and templates of FDepVector.
1195   (dotimes (i 4)
1196     (let ((font-spec-alist (char-table-extra-slot
1197                             (aref ps-mule-font-spec-tables i) 0))
1198           font-list font-spec)
1199       (dolist (elt font-spec-alist)
1200         (setq font-spec (cdr elt))
1201         (if (ps-mule-font-spec-extra font-spec)
1202             (push (cons (ps-mule-font-spec-font-id font-spec)
1203                         (ps-mule-font-spec-id font-spec))
1204                   font-list)))
1205       (setq font-list (nreverse font-list))
1206       (ps-output-prologue
1207        (list (format "/ETOP%d 256 array def\n" i)
1208              (format "0 1 255 { ETOP%d exch 0 put } for\n" i)))
1209       (let ((index 0))
1210         (dolist (font font-list)
1211           (ps-output-prologue (format "ETOP%d %d %d put\n" i (car font) index))
1212           (setq index (1+ index))))
1213       (ps-output-prologue (format "/VTOP%d [%s] def\n" i
1214                                   (mapconcat #'(lambda (x)
1215                                                  (format "F%02X" (cdr x)))
1216                                              font-list " ")))))
1217
1218   ;; Redefine fonts f0, f1, f2, f3, h0, h1, H0.
1219   (ps-mule-redefine-font 4 "h0" ps-header-title-font-size-internal
1220                          (ps-font 'ps-font-for-header 'bold))
1221   (ps-mule-redefine-font 5 "h1" ps-header-font-size-internal
1222                          (ps-font 'ps-font-for-header 'normal))
1223   (ps-mule-redefine-font 6 "H0" ps-footer-font-size-internal
1224                          (ps-font 'ps-font-for-footer 'normal))
1225   (let ((font (ps-font-alist 'ps-font-for-text))
1226         (i 0))
1227     (while font
1228       (ps-mule-redefine-font i (format "f%d" i)
1229                              ps-font-size-internal
1230                              (ps-font 'ps-font-for-text (car (car font))))
1231       (setq font (cdr font)
1232             i (1+ i)))))
1233
1234 (provide 'ps-mule)
1235
1236 ;; Local Variables:
1237 ;; generated-autoload-file: "ps-print.el"
1238 ;; End:
1239
1240 ;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe
1241 ;;; ps-mule.el ends here