lisp/ps-mule.el

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