lisp/ps-mule.el

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