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