Add a provide statement.

[gnu-emacs] / lisp / ps-mule.el

diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index 727c76ba02c37ddcbddfcd8ff8fd4efd33ca9421..ec7b3b22fcad83f850dc22a75c7c2568800f76ff 100644 (file)
--- a/lisp/ps-mule.el
+++ b/lisp/ps-mule.el
@@ -1,13 +1,14 @@
-;;; ps-mule.el --- Provide multi-byte character facility to ps-print.
+;;; ps-mule.el --- provide multi-byte character facility to ps-print

 
 

-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.

 
 

-;; Author:     Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Author:     Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
-;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
-;; Maintainer: Vinicius Jose Latorre <vinicius@cpqd.com.br>
-;; Keywords:   print, PostScript, multibyte, mule
-;; Time-stamp: <99/02/19 13:15:52 vinicius>
+;; Author: Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;;     Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
+;; Maintainer: Kenichi Handa <handa@etl.go.jp> (multi-byte characters)
+;;     Vinicius Jose Latorre <vinicius@cpqd.com.br>
+;; Keywords: wp, print, PostScript, multibyte, mule
+;; Time-stamp: <2003/05/14 22:19:41 vinicius>

 
 ;; This file is part of GNU Emacs.
 
 
 ;; This file is part of GNU Emacs.
 


@@ -28,7 +29,7 @@
 
 ;;; Commentary:
 
 
 ;;; Commentary:
 

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;;
 ;; About ps-mule
 ;; -------------
 ;;
 ;; About ps-mule
 ;; -------------


@@ -46,8 +47,14 @@
 ;;
 ;; Valid values for `ps-multibyte-buffer' are:
 ;;
 ;;
 ;; Valid values for `ps-multibyte-buffer' are:
 ;;

-;;  nil                     This is the value to use when you are printing
-;;                         buffer with only ASCII and Latin characters.
+;;  nil                     This is the value to use the default settings which
+;;                         is by default for printing buffer with only ASCII
+;;                         and Latin characters.   The default setting can be
+;;                         changed by setting the variable
+;;                         `ps-mule-font-info-database-default' differently.
+;;                         The initial value of this variable is
+;;                         `ps-mule-font-info-database-latin' (see
+;;                         documentation).

 ;;
 ;;  `non-latin-printer'     This is the value to use when you have a japanese
 ;;                         or korean PostScript printer and want to print
 ;;
 ;;  `non-latin-printer'     This is the value to use when you have a japanese
 ;;                         or korean PostScript printer and want to print


@@ -62,10 +69,10 @@
 ;;                         and non-latin fonts.  BDF (Bitmap Distribution
 ;;                         Format) is a format used for distributing X's font
 ;;                         source file.  BDF fonts are included in
 ;;                         and non-latin fonts.  BDF (Bitmap Distribution
 ;;                         Format) is a format used for distributing X's font
 ;;                         source file.  BDF fonts are included in

-;;                         `intlfonts-1.1' which is a collection of X11 fonts
+;;                         `intlfonts-1.2' which is a collection of X11 fonts

 ;;                         for all characters supported by Emacs.  In order to
 ;;                         use this value, be sure to have installed
 ;;                         for all characters supported by Emacs.  In order to
 ;;                         use this value, be sure to have installed

-;;                         `intlfonts-1.1' and set the variable
+;;                         `intlfonts-1.2' and set the variable

 ;;                         `bdf-directory-list' appropriately (see ps-bdf.el
 ;;                         for documentation of this variable).
 ;;
 ;;                         `bdf-directory-list' appropriately (see ps-bdf.el
 ;;                         for documentation of this variable).
 ;;


@@ -80,11 +87,84 @@
 ;;
 ;; The default is nil.
 ;;
 ;;
 ;; The default is nil.
 ;;

-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 
 ;;; Code:
 
 
 ;;; Code:
 

-(eval-and-compile (require 'ps-print))
+(eval-and-compile
+  (require 'ps-print)
+
+  ;; to avoid XEmacs compilation gripes
+  (defvar leading-code-private-22 157)
+  (or (fboundp 'charset-bytes)
+      (defun charset-bytes (charset) 1)) ; ascii
+  (or (fboundp 'charset-dimension)
+      (defun charset-dimension (charset) 1)) ; ascii
+  (or (fboundp 'charset-id)
+      (defun charset-id (charset) 0))  ; ascii
+  (or (fboundp 'charset-width)
+      (defun charset-width (charset) 1)) ; ascii
+  (or (fboundp 'find-charset-region)
+      (defun find-charset-region (beg end &optional table)
+       (list 'ascii)))
+  (or (fboundp 'char-valid-p)
+      (defun char-valid-p (char)
+       (< (following-char) 256)))
+  (or (fboundp 'split-char)
+      (defun split-char (char)
+       (list (if (char-valid-p char)
+                 'ascii
+               'unknow)
+             char)))
+  (or (fboundp 'char-width)
+      (defun char-width (char) 1))     ; ascii
+  (or (fboundp 'chars-in-region)
+      (defun chars-in-region (beg end)
+       (- (max beg end) (min beg end))))
+  (or (fboundp 'forward-point)
+      (defun forward-point (arg)
+       (save-excursion
+         (let ((count (abs arg))
+               (step  (if (zerop arg)
+                          0
+                        (/ arg arg))))
+           (while (and (> count 0)
+                       (< (point-min) (point)) (< (point) (point-max)))
+             (forward-char step)
+             (setq count (1- count)))
+           (+ (point) (* count step))))))
+  (or (fboundp 'decompose-composite-char)
+      (defun decompose-composite-char (char &optional type
+                                           with-composition-rule)
+       nil))
+  (or (fboundp 'encode-coding-string)
+      (defun encode-coding-string (string coding-system &optional nocopy)
+       (if nocopy
+           string
+         (copy-sequence string))))
+  (or (fboundp 'coding-system-p)
+      (defun coding-system-p (obj) nil))
+  (or (fboundp 'ccl-execute-on-string)
+      (defun ccl-execute-on-string (ccl-prog status str
+                                            &optional contin unibyte-p)
+       str))
+  (or (fboundp 'define-ccl-program)
+      (defmacro define-ccl-program (name ccl-program &optional doc)
+       `(defconst ,name nil ,doc)))
+  (or (fboundp 'multibyte-string-p)
+      (defun multibyte-string-p (str)
+       (let ((len (length str))
+             (i 0)
+             multibyte)
+         (while (and (< i len) (not (setq multibyte (> (aref str i) 255))))
+           (setq i (1+ i)))
+         multibyte)))
+  (or (fboundp 'string-make-multibyte)
+      (defalias 'string-make-multibyte 'copy-sequence))
+  (or (fboundp 'encode-char)
+      (defun encode-char (ch ccs)
+       ch)))
+

 
 ;;;###autoload
 (defcustom ps-multibyte-buffer nil
 
 ;;;###autoload
 (defcustom ps-multibyte-buffer nil


@@ -98,7 +178,8 @@ Valid values are:
                          changed by setting the variable
                          `ps-mule-font-info-database-default' differently.
                          The initial value of this variable is
                          changed by setting the variable
                          `ps-mule-font-info-database-default' differently.
                          The initial value of this variable is

-                         `ps-mule-font-info-database-latin' (which see).
+                         `ps-mule-font-info-database-latin' (see
+                         documentation).

 
   `non-latin-printer'     This is the value to use when you have a Japanese
                          or Korean PostScript printer and want to print
 
   `non-latin-printer'     This is the value to use when you have a Japanese
                          or Korean PostScript printer and want to print


@@ -113,10 +194,10 @@ Valid values are:
                          and non-latin fonts.  BDF (Bitmap Distribution
                          Format) is a format used for distributing X's font
                          source file.  BDF fonts are included in
                          and non-latin fonts.  BDF (Bitmap Distribution
                          Format) is a format used for distributing X's font
                          source file.  BDF fonts are included in

-                         `intlfonts-1.1' which is a collection of X11 fonts
+                         `intlfonts-1.2' which is a collection of X11 fonts

                          for all characters supported by Emacs.  In order to
                          use this value, be sure to have installed
                          for all characters supported by Emacs.  In order to
                          use this value, be sure to have installed

-                         `intlfonts-1.1' and set the variable
+                         `intlfonts-1.2' and set the variable

                          `bdf-directory-list' appropriately (see ps-bdf.el for
                          documentation of this variable).
 
                          `bdf-directory-list' appropriately (see ps-bdf.el for
                          documentation of this variable).
 


@@ -128,29 +209,10 @@ Valid values are:
                          `ps-header-font-family' and `ps-font-info-database'.
 
 Any other value is treated as nil."
                          `ps-header-font-family' and `ps-font-info-database'.
 
 Any other value is treated as nil."

-  :type '(choice (const non-latin-printer) (const bdf-font)
-                (const bdf-font-except-latin) (other :tag "nil" nil))
+  :type '(choice (const non-latin-printer)     (const bdf-font)
+                (const bdf-font-except-latin) (const :tag "nil" nil))

   :group 'ps-print-font)
 
   :group 'ps-print-font)
 

-;; For Emacs 20.2 and the earlier version.
-(eval-and-compile
-  (if (not (string< mule-version "4.0"))
-      (progn
-       (defalias 'ps-mule-next-point '1+)
-       (defalias 'ps-mule-chars-in-string 'length)
-       (defalias 'ps-mule-string-char 'aref)
-       (defsubst ps-mule-next-index (str i) (1+ i)))
-    (defun ps-mule-next-point (arg)
-      (save-excursion (goto-char arg) (forward-char 1) (point)))
-    (defun ps-mule-chars-in-string (string)
-      (/ (length string)
-        (charset-bytes (char-charset (string-to-char string)))))
-    (defun ps-mule-string-char (string idx)
-      (string-to-char (substring string idx)))
-    (defun ps-mule-next-index (string i)
-      (+ i (charset-bytes (char-charset (string-to-char string))))))
-  )
-

 (defvar ps-mule-font-info-database
   nil
   "Alist of charsets with the corresponding font information.
 (defvar ps-mule-font-info-database
   nil
   "Alist of charsets with the corresponding font information.


@@ -164,9 +226,9 @@ CHARSET is a charset (symbol) for this font family,
 
 FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
 
 
 FONT-TYPE is a font type: normal, bold, italic, or bold-italic.
 

-FONT-SRC is a font source: builtin, ps-bdf, vflib, or nil.
+FONT-SRC is a font source: builtin, bdf, vflib, or nil.

 
 

-  If FONT-SRC is builtin, FONT-NAME is a buitin PostScript font name.
+  If FONT-SRC is builtin, FONT-NAME is a built-in PostScript font name.

 
   If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of
   alternative font names.  To use this font, the external library `ps-bdf'
 
   If FONT-SRC is bdf, FONT-NAME is a BDF font file name, or a list of
   alternative font names.  To use this font, the external library `ps-bdf'


@@ -198,9 +260,11 @@ See also the variable `ps-font-info-database'.")
      (normal nil nil iso-latin-1)))
   "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
 
      (normal nil nil iso-latin-1)))
   "Sample setting of `ps-mule-font-info-database' to use latin fonts.")
 

-(defvar ps-mule-font-info-database-default
+(defcustom ps-mule-font-info-database-default

   ps-mule-font-info-database-latin
   ps-mule-font-info-database-latin

-  "The default setting to use if `ps-multibyte-buffer' (which see) is nil.")
+  "*The default setting to use when `ps-multibyte-buffer' is nil."
+  :type '(symbol :tag "Multi-Byte Buffer Database Font Default")
+  :group 'ps-print-font)

 
 (defconst ps-mule-font-info-database-ps
   '((katakana-jisx0201
 
 (defconst ps-mule-font-info-database-ps
   '((katakana-jisx0201


@@ -208,14 +272,14 @@ See also the variable `ps-font-info-database'.")
      (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)
      (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1))
     (latin-jisx0201
      (bold builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1)
      (bold-italic builtin "GothicBBB-Medium.Katakana" ps-mule-encode-7bit 1))
     (latin-jisx0201

-     (normat builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)
+     (normal builtin "Ryumin-Light.Hankaku" ps-mule-encode-7bit 1)

      (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1))
     (japanese-jisx0208
      (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2)
      (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2))
     (korean-ksc5601
      (bold builtin "GothicBBB-Medium.Hankaku" ps-mule-encode-7bit 1))
     (japanese-jisx0208
      (normal builtin "Ryumin-Light-H" ps-mule-encode-7bit 2)
      (bold builtin "GothicBBB-Medium-H" ps-mule-encode-7bit 2))
     (korean-ksc5601

-     (normal builtin "Batang-Medium-KSC-H" ps-mule-encode-7bit 2)
-     (bold builtin " Gulim-Medium-KSC-H" ps-mule-encode-7bit 2))
+     (normal builtin "Munhwa-Regular-KSC-EUC-H" ps-mule-encode-7bit 2)
+     (bold builtin "Munhwa-Bold-KSC-EUC-H" ps-mule-encode-7bit 2))

     )
   "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
 
     )
   "Sample setting of the `ps-mule-font-info-database' to use builtin PS font.
 


@@ -272,7 +336,7 @@ Currently, data for Japanese and Korean PostScript printers are listed.")
     (chinese-big5-2
      (normal bdf "taipei24.bdf" chinese-big5 2))
     (chinese-sisheng
     (chinese-big5-2
      (normal bdf "taipei24.bdf" chinese-big5 2))
     (chinese-sisheng

-     (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-8bit 1))
+     (normal bdf ("sish24-etl.bdf" "etl24-sisheng.bdf") ps-mule-encode-7bit 1))

     (ipa
      (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1))
     (vietnamese-viscii-lower
     (ipa
      (normal bdf ("ipa24-etl.bdf" "etl24-ipa.bdf") ps-mule-encode-8bit 1))
     (vietnamese-viscii-lower


@@ -289,7 +353,7 @@ Currently, data for Japanese and Korean PostScript printers are listed.")
     (arabic-2-column
      (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1))
     (indian-is13194
     (arabic-2-column
      (normal bdf ("arab24-2-etl.bdf" "etl24-arabic2.bdf") ps-mule-encode-7bit 1))
     (indian-is13194

-     (normal bdf ("isci24-etl.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1))
+     (normal bdf ("isci24-mule.bdf" "mule-iscii-24.bdf") ps-mule-encode-7bit 1))

     (indian-1-column
      (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2))
     (tibetan-1-column
     (indian-1-column
      (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf") ps-mule-encode-7bit 2))
     (tibetan-1-column


@@ -309,16 +373,23 @@ Currently, data for Japanese and Korean PostScript printers are listed.")
     (indian-2-column
      (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2))
     (tibetan
     (indian-2-column
      (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2))
     (tibetan

-     (normal bdf ("tib24-mule.bdf" "mule-tibmdx-24.bdf") ps-mule-encode-7bit 2)))
+     (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf")
+            ps-mule-encode-7bit 2))
+    (mule-unicode-0100-24ff
+     (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2))
+    (mule-unicode-2500-33ff
+     (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2))
+    (mule-unicode-e000-ffff
+     (normal bdf "etl24-unicode.bdf" ps-mule-encode-ucs2 2)))

   "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
 BDF (Bitmap Distribution Format) is a format used for distributing X's font
 source file.
 
   "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
 BDF (Bitmap Distribution Format) is a format used for distributing X's font
 source file.
 

-Current default value list for BDF fonts is included in `intlfonts-1.1' which is
-a collection of X11 fonts for all characters supported by Emacs.
+Current default value list for BDF fonts is included in `intlfonts-1.2'
+which is a collection of X11 fonts for all characters supported by Emacs.

 
 

-Using this list as default value to `ps-mule-font-info-database', all characters
-including ASCII and Latin-1 are printed by BDF fonts.
+Using this list as default value to `ps-mule-font-info-database', all
+characters including ASCII and Latin-1 are printed by BDF fonts.

 
 See also `ps-mule-font-info-database-ps-bdf'.")
 
 
 See also `ps-mule-font-info-database-ps-bdf'.")
 


@@ -327,13 +398,13 @@ See also `ps-mule-font-info-database-ps-bdf'.")
        (cdr (cdr ps-mule-font-info-database-bdf)))
   "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
 
        (cdr (cdr ps-mule-font-info-database-bdf)))
   "Sample setting of the `ps-mule-font-info-database' to use BDF fonts.
 

-Current default value list for BDF fonts is included in `intlfonts-1.1' which is
-a collection of X11 fonts for all characters supported by Emacs.
+Current default value list for BDF fonts is included in `intlfonts-1.2'
+which is a collection of X11 fonts for all characters supported by Emacs.

 
 

-Using this list as default value to `ps-mule-font-info-database', all characters
-except ASCII and Latin-1 characters are printed by BDF fonts.  ASCII and Latin-1
-characters are printed by PostScript font specified by `ps-font-family' and
-`ps-header-font-family'.
+Using this list as default value to `ps-mule-font-info-database', all
+characters except ASCII and Latin-1 characters are printed with BDF fonts.
+ASCII and Latin-1 characters are printed with PostScript font specified
+by `ps-font-family' and `ps-header-font-family'.

 
 See also `ps-mule-font-info-database-bdf'.")
 
 
 See also `ps-mule-font-info-database-bdf'.")
 


@@ -347,45 +418,70 @@ See also `ps-mule-font-info-database-bdf'.")
 
 (defun ps-mule-encode-bit (string delta)
   (let* ((dim (charset-dimension (char-charset (string-to-char string))))
 
 (defun ps-mule-encode-bit (string delta)
   (let* ((dim (charset-dimension (char-charset (string-to-char string))))

-        (len (* (ps-mule-chars-in-string string) dim))
+        (len (* (length string) dim))

         (str (make-string len 0))
         (i 0)
         (j 0))
     (if (= dim 1)
        (while (< j len)
          (aset str j
         (str (make-string len 0))
         (i 0)
         (j 0))
     (if (= dim 1)
        (while (< j len)
          (aset str j

-               (+ (nth 1 (split-char (ps-mule-string-char string i))) delta))
-         (setq i (ps-mule-next-index string i)
+               (+ (nth 1 (split-char (aref string i))) delta))
+         (setq i (1+ i)

                j (1+ j)))
       (while (< j len)
                j (1+ j)))
       (while (< j len)

-       (let ((split (split-char (ps-mule-string-char string i))))
+       (let ((split (split-char (aref string i))))

          (aset str j (+ (nth 1 split) delta))
          (aset str (1+ j) (+ (nth 2 split) delta))
          (aset str j (+ (nth 1 split) delta))
          (aset str (1+ j) (+ (nth 2 split) delta))

-         (setq i (ps-mule-next-index string i)
+         (setq i (1+ i)

                j (+ j 2)))))
     str))
 
 ;; Special encoding function for Ethiopic.
                j (+ j 2)))))
     str))
 
 ;; Special encoding function for Ethiopic.

-(define-ccl-program ccl-encode-ethio-unicode
-  `(1
-    ((read r2)
-     (loop
-      (if (r2 == ,leading-code-private-22)
-         ((read r0)
-          (if (r0 == ,(charset-id 'ethiopic))
-              ((read r1 r2)
-               (r1 &= 127) (r2 &= 127)
-               (call ccl-encode-ethio-font)
-               (write r1)
-               (write-read-repeat r2))
-            ((write r2 r0)
-             (repeat))))
-       (write-read-repeat r2))))))
-
-(defun ps-mule-encode-ethiopic (string)
-  (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
-                        (make-vector 9 nil)
-                        string))
+(if (boundp 'mule-version)             ; only if mule package is loaded
+    (define-ccl-program ccl-encode-ethio-unicode
+      `(1
+       ((read r2)
+        (loop
+         (if (r2 == ,leading-code-private-22)
+             ((read r0)
+              (if (r0 == ,(charset-id 'ethiopic))
+                  ((read r1 r2)
+                   (r1 &= 127) (r2 &= 127)
+                   (call ccl-encode-ethio-font)
+                   (write r1)
+                   (write-read-repeat r2))
+                ((write r2 r0)
+                 (repeat))))
+           (write-read-repeat r2))))))
+  ;; to avoid compilation gripes
+  (defvar ccl-encode-ethio-unicode nil))
+
+(if (boundp 'mule-version)
+    ;; bound mule-version
+    (defun ps-mule-encode-ethiopic (string)
+      (ccl-execute-on-string (symbol-value 'ccl-encode-ethio-unicode)
+                            (make-vector 9 nil)
+                            string))
+  ;; unbound mule-version
+  (defun ps-mule-encode-ethiopic (string)
+    string))
+
+;; Special encoding for mule-unicode-* characters.
+(defun ps-mule-encode-ucs2 (string)
+  (let* ((len (length string))
+        (str (make-string (* 2 len) 0))
+        (i 0)
+        (j 0)
+        ch hi lo)
+    (while (< i len)
+      (setq ch (encode-char (aref string i) 'ucs)
+           hi (lsh ch -8)
+           lo (logand ch 255))
+      (aset str j hi)
+      (aset str (1+ j) lo)
+      (setq i (1+ i)
+           j (+ j 2)))
+    str))

 
 ;; A charset which we are now processing.
 (defvar ps-mule-current-charset nil)
 
 ;; A charset which we are now processing.
 (defvar ps-mule-current-charset nil)


@@ -460,7 +556,7 @@ See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning."
        (let ((func (nth 3 slot)))
          (if func
              (progn
        (let ((func (nth 3 slot)))
          (if func
              (progn

-               (or (featurep (nth 1 slot)) (require (nth 1 slot)))
+               (require (nth 1 slot))

                (ps-output-prologue (funcall func))))
          (setcar (nthcdr 2 slot) t)))))
 
                (ps-output-prologue (funcall func))))
          (setcar (nthcdr 2 slot) t)))))
 


@@ -469,30 +565,42 @@ See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning."
 ;;      cache CODE0 CODE1 ...)
 (defvar ps-mule-font-cache nil)
 
 ;;      cache CODE0 CODE1 ...)
 (defvar ps-mule-font-cache nil)
 

-(defun ps-mule-generate-font (font-spec charset)
-  "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET."
+(defun ps-mule-generate-font (font-spec charset &optional header-p)
+  "Generate PostScript codes to define a new font in FONT-SPEC for CHARSET.
+
+If optional 3rd arg HEADER-P is non-nil, generate codes to define a header
+font."

   (let* ((font-name (ps-mule-font-spec-name font-spec))
         (font-name (if (consp font-name) (car font-name) font-name))
         (font-cache (assoc font-name ps-mule-font-cache))
         (font-src (ps-mule-font-spec-src font-spec))
         (func (nth 4 (assq font-src ps-mule-external-libraries)))
   (let* ((font-name (ps-mule-font-spec-name font-spec))
         (font-name (if (consp font-name) (car font-name) font-name))
         (font-cache (assoc font-name ps-mule-font-cache))
         (font-src (ps-mule-font-spec-src font-spec))
         (func (nth 4 (assq font-src ps-mule-external-libraries)))

+        (font-size (if header-p (if (eq ps-current-font 0)
+                                    ps-header-title-font-size-internal
+                                  ps-header-font-size-internal)
+                     ps-font-size-internal))
+        (current-font (+ ps-current-font (if header-p 10 0)))

         (scaled-font-name
         (scaled-font-name

-         (if (eq charset 'ascii)
-             (format "f%d" ps-current-font)
-           (format "f%02x-%d"
-                   (charset-id charset) ps-current-font))))
+         (cond (header-p
+                (format "h%d" ps-current-font))
+               ((eq charset 'ascii)
+                (format "f%d" ps-current-font))
+               (t
+                (format "f%02x-%d" (charset-id charset) ps-current-font)))))

     (and func (not font-cache)
         (ps-output-prologue (funcall func charset font-spec)))
     (ps-output-prologue
      (list (format "/%s %f /%s Def%sFontMule\n"
     (and func (not font-cache)
         (ps-output-prologue (funcall func charset font-spec)))
     (ps-output-prologue
      (list (format "/%s %f /%s Def%sFontMule\n"

-                  scaled-font-name ps-font-size-internal font-name
-                  (if (eq ps-mule-current-charset 'ascii) "Ascii" ""))))
+                  scaled-font-name font-size font-name
+                  (if (or header-p
+                          (eq ps-mule-current-charset 'ascii))
+                      "Ascii" ""))))

     (if font-cache
        (setcar (cdr font-cache)
     (if font-cache
        (setcar (cdr font-cache)

-               (cons (cons ps-current-font scaled-font-name)
+               (cons (cons current-font scaled-font-name)

                      (nth 1 font-cache)))
       (setq font-cache (list font-name
                      (nth 1 font-cache)))
       (setq font-cache (list font-name

-                            (list (cons ps-current-font scaled-font-name))
+                            (list (cons current-font scaled-font-name))

                             'cache)
            ps-mule-font-cache (cons font-cache ps-mule-font-cache)))
     font-cache))
                             'cache)
            ps-mule-font-cache (cons font-cache ps-mule-font-cache)))
     font-cache))


@@ -506,21 +614,26 @@ See the documentation of `ps-mule-get-font-spec' for FONT-SPEC's meaning."
          (funcall func font-spec code-list
                   (ps-mule-font-spec-bytes font-spec))))))
 
          (funcall func font-spec code-list
                   (ps-mule-font-spec-bytes font-spec))))))
 

-(defun ps-mule-prepare-font (font-spec string charset &optional no-setfont)
+(defun ps-mule-prepare-font (font-spec string charset
+                                      &optional no-setfont header-p)

   "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC.
 
 The generated code is inserted on prologue part except the code that sets the
 current font (using PostScript procedure `FM').
 
   "Generate PostScript codes to print STRING of CHARSET by font FONT-SPEC.
 
 The generated code is inserted on prologue part except the code that sets the
 current font (using PostScript procedure `FM').
 

-If optional arg NO-SETFONT is non-nil, don't generate the code for setting the
-current font."
+If optional 4th arg NO-SETFONT is non-nil, don't generate the code for setting
+the current font.
+
+If optional 5th arg HEADER-P is non-nil, generate a code for setting a header
+font."

   (let* ((font-name (ps-mule-font-spec-name font-spec))
         (font-name (if (consp font-name) (car font-name) font-name))
   (let* ((font-name (ps-mule-font-spec-name font-spec))
         (font-name (if (consp font-name) (car font-name) font-name))

+        (current-font (+ ps-current-font (if header-p 10 0)))

         (font-cache (assoc font-name ps-mule-font-cache)))
         (font-cache (assoc font-name ps-mule-font-cache)))

-    (or (and font-cache (assq ps-current-font (nth 1 font-cache)))
-       (setq font-cache (ps-mule-generate-font font-spec charset)))
+    (or (and font-cache (assq current-font (nth 1 font-cache)))
+       (setq font-cache (ps-mule-generate-font font-spec charset header-p)))

     (or no-setfont
     (or no-setfont

-       (let ((new-font (cdr (assq ps-current-font (nth 1 font-cache)))))
+       (let ((new-font (cdr (assq current-font (nth 1 font-cache)))))

          (or (equal new-font ps-last-font)
              (progn
                (ps-output (format "/%s FM\n" new-font))
          (or (equal new-font ps-last-font)
              (progn
                (ps-output (format "/%s FM\n" new-font))


@@ -574,23 +687,52 @@ STRING should contain only ASCII characters."
 %% Working dictionary for general use.
 /MuleDict 10 dict def
 
 %% Working dictionary for general use.
 /MuleDict 10 dict def
 

+%% Adjust /RelativeCompose properly by checking /BaselineOffset.
+/AdjustRelativeCompose {       % fontdict  |-  fontdict
+  dup length 2 add dict begin
+    { 1 index /FID ne { def } { pop pop } ifelse } forall
+    currentdict /BaselineOffset known {
+       BaselineOffset false eq { /BaselineOffset 0 def } if
+    } {
+      /BaselineOffset 0 def
+    } ifelse
+    currentdict /RelativeCompose known not {
+      /RelativeCompose [ 0 0.1 ] def
+    } {
+      RelativeCompose false ne {
+       [ BaselineOffset RelativeCompose BaselineOffset add
+         [ FontMatrix { FontSize div } forall ] transform ]
+       /RelativeCompose exch def
+      } if
+    } ifelse
+    currentdict
+  end
+} def
+

 %% Define already scaled font for non-ASCII character sets.
 /DefFontMule {                 % fontname size basefont  |-  --
 %% Define already scaled font for non-ASCII character sets.
 /DefFontMule {                 % fontname size basefont  |-  --

-  findfont exch scalefont definefont pop
+  findfont exch scalefont AdjustRelativeCompose definefont pop

 } bind def
 
 %% Define already scaled font for ASCII character sets.
 /DefAsciiFontMule {            % fontname size basefont  |-
   MuleDict begin
   findfont dup /Encoding get /ISOLatin1Encoding exch def
 } bind def
 
 %% Define already scaled font for ASCII character sets.
 /DefAsciiFontMule {            % fontname size basefont  |-
   MuleDict begin
   findfont dup /Encoding get /ISOLatin1Encoding exch def

-  exch scalefont reencodeFontISO
+  exch scalefont AdjustRelativeCompose reencodeFontISO

   end
 } def
 
   end
 } def
 

-%% Set the specified non-ASCII font to use.  It doesn't install
-%% Ascent, etc.
+/CurrentFont false def
+
+%% Set the specified font to use.
+%% For non-ASCII font, don't install Ascent, etc.

 /FM {                          %  fontname  |-  --
 /FM {                          %  fontname  |-  --

-  findfont setfont
+    /font exch def
+    font /f0 eq font /f1 eq font /f2 eq font /f3 eq or or or {
+      font F
+    } {
+      font findfont setfont
+    } ifelse

 } bind def
 
 %% Show vacant box for characters which don't have appropriate font.
 } bind def
 
 %% Show vacant box for characters which don't have appropriate font.


@@ -607,10 +749,10 @@ STRING should contain only ASCII characters."
     } for
 } bind def
 
     } for
 } bind def
 

-%% Flag to tell if we are now handling a composite character.  This is
-%% defined here because both composite character handler and bitmap font
+%% Flag to tell if we are now handling a composition.  This is
+%% defined here because both composition handler and bitmap font

 %% handler require it.
 %% handler require it.

-/Cmpchar false def
+/Composing false def

 
 %%%% End of Mule Section
 
 
 %%%% End of Mule Section
 


@@ -624,11 +766,18 @@ STRING should contain only ASCII characters."
     (ps-output-prologue ps-mule-prologue)
     (setq ps-mule-prologue-generated t)))
 
     (ps-output-prologue ps-mule-prologue)
     (setq ps-mule-prologue-generated t)))
 

-(defun ps-mule-find-wrappoint (from to char-width)
+(defun ps-mule-find-wrappoint (from to char-width &optional composition)

   "Find the longest sequence which is printable in the current line.
 
   "Find the longest sequence which is printable in the current line.
 

-The search starts at FROM and goes until TO.  It is assumed that all characters
-between FROM and TO belong to a charset in `ps-mule-current-charset'.
+The search starts at FROM and goes until TO.
+
+Optional 4th arg COMPOSITION, if non-nil, is information of
+composition starting at FROM.
+
+If COMPOSITION is nil, it is assumed that all characters between FROM
+and TO belong to a charset in `ps-mule-current-charset'.  Otherwise,
+it is assumed that all characters between FROM and TO belong to the
+same composition.

 
 CHAR-WIDTH is the average width of ASCII characters in the current font.
 
 
 CHAR-WIDTH is the average width of ASCII characters in the current font.
 


@@ -638,15 +787,20 @@ Returns the value:
 
 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
 the sequence."
 
 Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
 the sequence."

-  (if (eq ps-mule-current-charset 'composition)
+  (if (or composition (eq ps-mule-current-charset 'composition))

       ;; We must draw one char by one.
       ;; We must draw one char by one.

-      (let ((run-width (* (char-width (char-after from)) char-width)))
+      (let ((run-width (if composition
+                          (nth 5 composition)
+                        (* (char-width (char-after from)) char-width))))

        (if (> run-width ps-width-remaining)
            (cons from ps-width-remaining)
        (if (> run-width ps-width-remaining)
            (cons from ps-width-remaining)

-         (cons (ps-mule-next-point from) run-width)))
+         (cons (if composition
+                   (nth 1 composition)
+                 (1+ from))
+               run-width)))

     ;; We assume that all characters in this range have the same width.
     (setq char-width (* char-width (charset-width ps-mule-current-charset)))
     ;; We assume that all characters in this range have the same width.
     (setq char-width (* char-width (charset-width ps-mule-current-charset)))

-    (let ((run-width (* (chars-in-region from to) char-width)))
+    (let ((run-width (* (abs (- from to)) char-width)))

       (if (> run-width ps-width-remaining)
          (cons (min to
                     (save-excursion
       (if (> run-width ps-width-remaining)
          (cons (min to
                     (save-excursion


@@ -658,7 +812,7 @@ the sequence."
 
 ;;;###autoload
 (defun ps-mule-plot-string (from to &optional bg-color)
 
 ;;;###autoload
 (defun ps-mule-plot-string (from to &optional bg-color)

-  "Generate PostScript code for ploting characters in the region FROM and TO.
+  "Generate PostScript code for plotting characters in the region FROM and TO.

 
 It is assumed that all characters in this region belong to the same charset.
 
 
 It is assumed that all characters in this region belong to the same charset.
 


@@ -693,13 +847,9 @@ the sequence."
       (ps-output-string (ps-mule-string-ascii string))
       (ps-output " S\n"))
 
       (ps-output-string (ps-mule-string-ascii string))
       (ps-output " S\n"))
 

+     ;; This case is obsolete for Emacs 21.

      ((eq ps-mule-current-charset 'composition)
      ((eq ps-mule-current-charset 'composition)

-      (let* ((ch (char-after from))
-            (width (char-width ch))
-            (ch-list (decompose-composite-char ch 'list t)))
-       (if (consp (nth 1 ch-list))
-           (ps-mule-plot-rule-cmpchar ch-list width font-type)
-         (ps-mule-plot-cmpchar ch-list width t font-type))))
+      (ps-mule-plot-composition from (1+ from) bg-color))

 
      (t
       ;; No way to print this charset.  Just show a vacant box of an
 
      (t
       ;; No way to print this charset.  Just show a vacant box of an


@@ -711,15 +861,99 @@ the sequence."
                           (charset-width ps-mule-current-charset))))))
     wrappoint))
 
                           (charset-width ps-mule-current-charset))))))
     wrappoint))
 

+;;;###autoload
+(defun ps-mule-plot-composition (from to &optional bg-color)
+  "Generate PostScript code for plotting composition in the region FROM and TO.
+
+It is assumed that all characters in this region belong to the same
+composition.
+
+Optional argument BG-COLOR specifies background color.
+
+Returns the value:
+
+       (ENDPOS . RUN-WIDTH)
+
+Where ENDPOS is the end position of the sequence and RUN-WIDTH is the width of
+the sequence."
+  (let* ((composition (find-composition from nil nil t))
+        (wrappoint (ps-mule-find-wrappoint
+                    from to (ps-avg-char-width 'ps-font-for-text)
+                    composition))
+        (to (car wrappoint))
+        (font-type (car (nth ps-current-font
+                             (ps-font-alist 'ps-font-for-text)))))
+    (if (< from to)
+       ;; We can print this composition in the current line.
+       (let ((components (nth 2 composition)))
+         (ps-mule-plot-components
+          (ps-mule-prepare-font-for-components components font-type)
+          (if (nth 3 composition) "RLC" "RBC"))))
+    wrappoint))
+
+;; Prepare font of FONT-TYPE for printing COMPONENTS.  By side effect,
+;; change character elements in COMPONENTS to the form:
+;;     ENCODED-STRING or (FONTNAME . ENCODED-STRING)
+;; and change rule elements to the encoded value (integer).
+;; The latter form is used if we much change font for the character.
+
+(defun ps-mule-prepare-font-for-components (components font-type)
+  (let ((len (length components))
+       (i 0)
+       elt)
+    (while (< i len)
+      (setq elt (aref components i))
+      (if (consp elt)
+         ;; ELT is a composition rule.
+         (setq elt (encode-composition-rule elt))
+       ;; ELT is a glyph character.
+       (let* ((charset (char-charset elt))
+              (font (or (eq charset ps-mule-current-charset)
+                        (if (eq charset 'ascii)
+                            (format "/f%d" ps-current-font)
+                          (format "/f%02x-%d"
+                                  (charset-id charset) ps-current-font))))
+               str)
+         (setq ps-mule-current-charset charset
+               str (ps-mule-string-encoding
+                    (ps-mule-get-font-spec charset font-type)
+                    (char-to-string elt)
+                    'no-setfont))
+         (if (stringp font)
+             (setq elt (cons font str) ps-last-font font)
+           (setq elt str))))
+      (aset components i elt)
+      (setq i (1+ i))))
+  components)
+
+(defun ps-mule-plot-components (components tail)
+  (let ((elt (aref components 0))
+       (len (length components))
+       (i 1))
+    (ps-output "[ ")
+    (if (stringp elt)
+       (ps-output-string elt)
+      (ps-output (car elt) " ")
+      (ps-output-string (cdr elt)))
+    (while (< i len)
+      (setq elt (aref components i) i (1+ i))
+      (ps-output " ")
+      (cond ((stringp elt)
+            (ps-output-string elt))
+           ((consp elt)
+            (ps-output (car elt) " ")
+            (ps-output-string (cdr elt)))
+           (t                          ; i.e. (integerp elt)
+            (ps-output (format "%d" elt)))))
+    (ps-output " ] " tail "\n")))
+

 ;; Composite font support
 
 ;; Composite font support
 

-(defvar ps-mule-cmpchar-prologue-generated nil)
+(defvar ps-mule-composition-prologue-generated nil)

 
 

-(defconst ps-mule-cmpchar-prologue
-  "%%%% Composite character handler
-/CmpcharWidth 0 def
-/CmpcharRelativeCompose 0 def
-/CmpcharRelativeSkip 0.4 def
+(defconst ps-mule-composition-prologue
+  "%%%% Character composition handler
+/RelativeCompositionSkip 0.4 def

 
 %% Get a bounding box (relative to currentpoint) of STR.
 /GetPathBox {                  % str  |-  --
 
 %% Get a bounding box (relative to currentpoint) of STR.
 /GetPathBox {                  % str  |-  --


@@ -727,154 +961,178 @@ the sequence."
     currentfont /FontType get 3 eq { %ifelse
        stringwidth pop pop
     } {
     currentfont /FontType get 3 eq { %ifelse
        stringwidth pop pop
     } {

-       currentpoint /y exch def pop
+       currentpoint /y exch def /x exch def

        false charpath flattenpath pathbbox
        false charpath flattenpath pathbbox

-       y sub /URY exch def pop
-       y sub /LLY exch def pop
+       y sub /URY exch def x sub /URX exch def
+       y sub /LLY exch def x sub /LLX exch def

     } ifelse
     grestore
 } bind def
 
     } ifelse
     grestore
 } bind def
 

-%% Beginning of composite char.
-/BC {                          % str xoff width |-  --
-    /Cmpchar true def
-    /CmpcharWidth exch def
-    currentfont /RelativeCompose known {
-       /CmpcharRelativeCompose currentfont /RelativeCompose get def
-    } {
-       /CmpcharRelativeCompose false def
-    } ifelse
-    /bgsave bg def /bgcolorsave bgcolor def
-    /Effectsave Effect def
-    gsave                      % Reflect effect only at first
-       /Effect Effect 1 2 add 4 add 16 add and def
-       /f0 findfont setfont (        ) 0 CmpcharWidth getinterval S
-    grestore
-    /Effect Effectsave 8 32 add and def        % enable only shadow and outline
-    false BG
-    gsave SpaceWidth mul 0 rmoveto dup GetPathBox S grestore
-    /y currentpoint exch pop def
-    /HIGH URY y add def /LOW LLY y add def
-} bind def
+%% Apply effects (underline, strikeout, overline, box) to the
+%% rectangle specified by TOP BOTTOM LEFT RIGHT.
+/SpecialEffect {                                       % --  |-  --
+    currentpoint dup TOP add /yy exch def BOTTOM add /YY exch def
+    dup LEFT add /xx exch def RIGHT add /XX exch def
+    %% Adjust positions for future shadowing.
+    Effect 8 and 0 ne {
+       /yy yy Yshadow add def
+       /XX XX Xshadow add def
+    } if
+    Effect 1 and 0 ne { UnderlinePosition Hline } if   % underline
+    Effect 2 and 0 ne { StrikeoutPosition Hline } if   % strikeout
+    Effect 4 and 0 ne { OverlinePosition  Hline } if   % overline
+    bg {                                               % background
+       true
+       Effect 16 and 0 ne {SpaceBackground doBox} { xx yy XX YY doRect} ifelse
+    } if
+    Effect 16 and 0 ne { false 0 doBox } if            % box
+} def

 
 

-%% End of composite char.
-/EC {                          % --  |-  --
-    /bg bgsave def /bgcolor bgcolorsave def
-    /Effect Effectsave def
-    /Cmpchar false def
-    CmpcharWidth SpaceWidth mul 0 rmoveto
-} bind def
+%% Show STR with effects (shadow, outline).
+/ShowWithEffect {                                      % str  |-  --
+    Effect 8 and 0 ne { dup doShadow } if
+    Effect 32 and 0 ne { true doOutline } { show } ifelse
+} def
+
+%% Draw COMPONENTS which have the form [ font0? [str0 xoff0 yoff0] ... ].
+/ShowComponents {                                      % components  |-  -
+    LEFT 0 lt { LEFT neg 0 rmoveto } if
+    {
+       dup type /nametype eq {                         % font
+           FM
+       } {                                             % [ str xoff yoff ]
+           gsave
+           aload pop rmoveto ShowWithEffect
+           grestore
+       } ifelse
+    } forall
+    RIGHT 0 rmoveto
+} def

 
 

-%% Rule base composition
-/RBC {                         % str xoff gref nref  |-  --
-    /nref exch def /gref exch def
+%% Show relative composition.
+/RLC {         % [ font0? str0 font1? str1 ... fontN? strN ]  |-  --
+    /components exch def
+    /Composing true def
+    /first true def

     gsave
     gsave

-    SpaceWidth mul 0 rmoveto
-    dup
-    GetPathBox
-    [ HIGH currentpoint exch pop LOW HIGH LOW add 2 div ] gref get
-    [ URY LLY sub LLY neg 0 URY LLY sub 2 div ] nref get
-    sub /btm exch def
-    /top btm URY LLY sub add def
-    top HIGH gt { /HIGH top def } if
-    btm LOW lt { /LOW btm def } if
-    currentpoint pop btm LLY sub moveto
-    S
+    [ components {
+       /elt exch def
+       elt type /nametype eq {                         % font
+           elt dup FM
+       } { first {                                     % first string
+           /first false def
+           elt GetPathBox
+           %% Bounding box of overall glyphs.
+           /LEFT LLX def
+           /RIGHT URX def
+           /TOP URY def
+           /BOTTOM LLY def
+           currentfont /RelativeCompose known {
+               /relative currentfont /RelativeCompose get def
+           } {
+               %% Disable relative composition by setting sufficiently low
+               %% and high positions.
+               /relative [ -100000 100000 ] def
+           } ifelse
+           [ elt 0 0 ]
+       } {                                             % other strings
+           elt GetPathBox
+           [ elt                                       % str
+             LLX 0 lt { RIGHT } { 0 } ifelse           % xoff
+             LLY relative 1 get ge {                   % compose on TOP
+                 TOP LLY sub RelativeCompositionSkip add       % yoff
+                 /TOP TOP URY LLY sub add RelativeCompositionSkip add def
+             } { URY relative 0 get le {               % compose under BOTTOM
+                 BOTTOM URY sub RelativeCompositionSkip sub % yoff
+                 /BOTTOM BOTTOM URY LLY sub sub
+                       RelativeCompositionSkip sub def
+             } {
+                 0                                     % yoff
+                 URY TOP gt { /TOP URY def } if
+                 LLY BOTTOM lt { /BOTTOM LLY def } if
+             } ifelse } ifelse
+             ]
+           URX RIGHT gt { /RIGHT URX def } if
+       } ifelse } ifelse
+    } forall ] /components exch def

     grestore
     grestore

-} bind def

 
 

-%% Relative composition
-/RLC {                         % str  |-  --
+    %% Reflect special effects.
+    SpecialEffect
+
+    %% Draw components while ignoring effects other than shadow and outline.
+    components ShowComponents
+    /Composing false def
+
+} def
+
+%% Show rule-base composition.
+/RBC {         % [ font0? str0 rule1 font1? str1 rule2 ... strN ]  |-  --
+    /components exch def
+    /Composing true def
+    /first true def

     gsave
     gsave

-    dup GetPathBox
-    CmpcharRelativeCompose type /integertype eq {
-       LLY CmpcharRelativeCompose gt { % compose on top
-           currentpoint pop HIGH LLY sub CmpcharRelativeSkip add moveto
-           /HIGH HIGH URY LLY sub add CmpcharRelativeSkip add def
-       } { URY 0 le {                  % compose under bottom
-           currentpoint pop LOW LLY add CmpcharRelativeSkip sub moveto
-           /LOW LOW URY LLY sub sub CmpcharRelativeSkip sub def
-    } if } ifelse } if
-    S
+    [ components {
+       /elt exch def
+       elt type /nametype eq {                         % font
+           elt dup FM
+       } { elt type /integertype eq {                  % rule
+           %% This RULE decoding should be compatible with macro
+           %% COMPOSITION_DECODE_RULE in emacs/src/composite.h.
+           elt 12 idiv dup 3 mod /grefx exch def 3 idiv /grefy exch def
+           elt 12 mod dup 3 mod /nrefx exch def 3 idiv /nrefy exch def
+       } { first {                                     % first string
+           /first false def
+           elt GetPathBox
+           %% Bounding box of overall glyphs.
+           /LEFT LLX def
+           /RIGHT URX def
+           /TOP URY def
+           /BOTTOM LLY def
+           /WIDTH RIGHT LEFT sub def
+           [ elt 0 0 ]
+       } {                                             % other strings
+           elt GetPathBox
+           /width URX LLX sub def
+           /height URY LLY sub def
+           /left LEFT [ 0 WIDTH 2 div WIDTH ] grefx get add
+               [ 0 width 2 div width ] nrefx get sub def
+           /bottom [ TOP 0 BOTTOM TOP BOTTOM add 2 div ] grefy get
+               [ height LLY neg 0 height 2 div ] nrefy get sub def
+           %% Update bounding box
+           left LEFT lt { /LEFT left def } if
+           left width add RIGHT gt { /RIGHT left width add def } if
+           /WIDTH RIGHT LEFT sub def
+           bottom BOTTOM lt { /BOTTOM bottom def } if
+           bottom height add TOP gt { /TOP bottom height add def } if
+           [ elt left LLX sub bottom LLY sub ]
+       } ifelse } ifelse } ifelse
+    } forall ] /components exch def

     grestore
     grestore

-} bind def
-%%%% End of composite character handler
+
+    %% Reflect special effects.
+    SpecialEffect
+
+    %% Draw components while ignoring effects other than shadow and outline.
+    components ShowComponents
+
+    /Composing false def
+} def
+%%%% End of character composition handler

 
 "
 
 "

-  "PostScript code for printing composite characters.")
-
-(defun ps-mule-plot-rule-cmpchar (ch-rule-list total-width font-type)
-  (let ((leftmost 0.0)
-       (rightmost (float (char-width (car ch-rule-list))))
-       (the-list (cons '(3 . 3) ch-rule-list))
-       cmpchar-elements)
-    (while the-list
-      (let* ((this (car the-list))
-            (gref (car this))
-            (nref (cdr this))
-            ;; X-axis info (0:left, 1:center, 2:right)
-            (gref-x (% gref 3))
-            (nref-x (% nref 3))
-            ;; Y-axis info (0:top, 1:base, 2:bottom, 3:center)
-            (gref-y (if (= gref 4) 3 (/ gref 3)))
-            (nref-y (if (= nref 4) 3 (/ nref 3)))
-            (char (car (cdr the-list)))
-            (width (float (char-width char)))
-            left)
-       (setq left (+ leftmost
-                     (* (- rightmost leftmost) gref-x 0.5)
-                     (- (* nref-x width 0.5)))
-             cmpchar-elements (cons (list char left gref-y nref-y)
-                                    cmpchar-elements)
-             leftmost (min left leftmost)
-             rightmost (max (+ left width) rightmost)
-             the-list (nthcdr 2 the-list))))
-    (if (< leftmost 0)
-       (let ((the-list cmpchar-elements)
-             elt)
-         (while the-list
-           (setq elt (car the-list)
-                 the-list (cdr the-list))
-           (setcar (cdr elt) (- (nth 1 elt) leftmost)))))
-    (ps-mule-plot-cmpchar (nreverse cmpchar-elements)
-                         total-width nil font-type)))
-
-(defun ps-mule-plot-cmpchar (elements total-width relativep font-type)
-  (let* ((elt (car elements))
-        (ch (if relativep elt (car elt))))
-    (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
-    (ps-output (format " %d %d BC "
-                      (if relativep 0 (nth 1 elt))
-                      total-width))
-    (while (setq elements (cdr elements))
-      (setq elt (car elements)
-           ch (if relativep elt (car elt)))
-      (ps-output-string (ps-mule-prepare-cmpchar-font ch font-type))
-      (ps-output (if relativep
-                    " RLC "
-                  (format " %d %d %d RBC "
-                          (nth 1 elt) (nth 2 elt) (nth 3 elt))))))
-  (ps-output "EC\n"))
-
-(defun ps-mule-prepare-cmpchar-font (char font-type)
-  (let* ((ps-mule-current-charset (char-charset char))
-        (font-spec (ps-mule-get-font-spec ps-mule-current-charset font-type)))
-    (cond (font-spec
-          (ps-mule-string-encoding font-spec (char-to-string char)))
-
-         ((eq ps-mule-current-charset 'latin-iso8859-1)
-          (ps-mule-string-ascii (char-to-string char)))
-
-         (t
-          ;; No font for CHAR.
-          (ps-set-font ps-current-font)
-          " "))))
+  "PostScript code for printing character composition.")

 
 (defun ps-mule-string-ascii (str)
   (ps-set-font ps-current-font)
   (string-as-unibyte (encode-coding-string str 'iso-latin-1)))
 
 
 (defun ps-mule-string-ascii (str)
   (ps-set-font ps-current-font)
   (string-as-unibyte (encode-coding-string str 'iso-latin-1)))
 

-(defun ps-mule-string-encoding (font-spec str)
+;; Encode STR for a font specified by FONT-SPEC and return the result.
+;; If necessary, it generates the PostScript code for the font and glyphs to
+;; print STR.  If optional 4th arg HEADER-P is non-nil, it is assumed that STR
+;; is for headers.
+(defun ps-mule-string-encoding (font-spec str &optional no-setfont header-p)

   (let ((encoding (ps-mule-font-spec-encoding font-spec)))
     (setq str
          (string-as-unibyte
   (let ((encoding (ps-mule-font-spec-encoding font-spec)))
     (setq str
          (string-as-unibyte


@@ -887,8 +1145,11 @@ the sequence."
                 (t
                  str))))
     (if (ps-mule-font-spec-src font-spec)
                 (t
                  str))))
     (if (ps-mule-font-spec-src font-spec)

-       (ps-mule-prepare-font font-spec str ps-mule-current-charset)
-      (ps-set-font ps-current-font))
+       (ps-mule-prepare-font font-spec str ps-mule-current-charset
+                             (or no-setfont header-p)
+                             header-p)
+      (or no-setfont
+         (ps-set-font ps-current-font)))

     str))
 
 ;; Bitmap font support
     str))
 
 ;; Bitmap font support


@@ -955,12 +1216,12 @@ NewBitmapDict
        1 index /FontIndex get exch FirstCode exch
        GlobalCharName GetBitmap /bmp exch def
        %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ]
        1 index /FontIndex get exch FirstCode exch
        GlobalCharName GetBitmap /bmp exch def
        %% bmp == [ DWIDTH BBX-WIDTH BBX-HEIGHT BBX-XOFF BBX-YOFF BITMAP ]

-       Cmpchar { %ifelse
+       Composing { %ifelse

            /FontMatrix get [ exch { size div } forall ] /mtrx exch def
            bmp 3 get bmp 4 get mtrx transform
            /FontMatrix get [ exch { size div } forall ] /mtrx exch def
            bmp 3 get bmp 4 get mtrx transform

-           /LLY exch def pop
+           /LLY exch def /LLX exch def

            bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform
            bmp 1 get bmp 3 get add bmp 2 get bmp 4 get add mtrx transform

-           /URY exch def pop
+           /URY exch def /URX exch def

        } {
            pop
        } ifelse
        } {
            pop
        } ifelse


@@ -984,7 +1245,7 @@ NewBitmapDict
     1 index /BuildGlyph get exec
 } bind def
 
     1 index /BuildGlyph get exec
 } bind def
 

-%% Bitmap font creater
+%% Bitmap font creator

 
 %% Common Encoding shared by all bitmap fonts.
 /EncodingCommon 256 array def
 
 %% Common Encoding shared by all bitmap fonts.
 /EncodingCommon 256 array def


@@ -1070,16 +1331,86 @@ NewBitmapDict
   "Initialize global data for printing multi-byte characters."
   (setq ps-mule-font-cache nil
        ps-mule-prologue-generated nil
   "Initialize global data for printing multi-byte characters."
   (setq ps-mule-font-cache nil
        ps-mule-prologue-generated nil

-       ps-mule-cmpchar-prologue-generated nil
+       ps-mule-composition-prologue-generated nil

        ps-mule-bitmap-prologue-generated nil)
   (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil))
          ps-mule-external-libraries))
 
        ps-mule-bitmap-prologue-generated nil)
   (mapcar `(lambda (x) (setcar (nthcdr 2 x) nil))
          ps-mule-external-libraries))
 

+(defvar ps-mule-header-charsets nil)
+
+;;;###autoload
+(defun ps-mule-encode-header-string (string fonttag)
+  "Generate PostScript code for ploting STRING by font FONTTAG.
+FONTTAG should be a string \"/h0\" or \"/h1\"."
+  (setq string (cond ((not (stringp string))
+                     "")
+                    ((multibyte-string-p string)
+                     (copy-sequence string))
+                    (t
+                     (string-make-multibyte string))))
+  (when ps-mule-header-charsets
+    (if (eq (car ps-mule-header-charsets) 'latin-iso8859-1)
+       ;; Latin1 characters can be printed by the standard PostScript
+       ;; font.  Converts the other non-ASCII characters to `?'.
+       (let ((len (length string))
+             (i 0))
+         (while (< i len)
+           (or (memq (char-charset (aref string i)) '(ascii latin-iso8859-1))
+               (aset string i ??))
+           (setq i (1+ i)))
+         (setq string (encode-coding-string string 'iso-latin-1)))
+      ;; We must prepare a font for the first non-ASCII and non-Latin1
+      ;; character in STRING.
+      (let* ((ps-current-font (if (string= fonttag "/h0") 0 1))
+            (ps-mule-current-charset (car ps-mule-header-charsets))
+            (font-type (car (nth ps-current-font
+                                 (ps-font-alist 'ps-font-for-header))))
+            (font-spec (ps-mule-get-font-spec ps-mule-current-charset
+                                              font-type)))
+       (if (or (not font-spec)
+               (/= (charset-dimension ps-mule-current-charset) 1))
+           ;; We don't have a proper font, or we can't print them on
+           ;; header because this kind of charset is not ASCII
+           ;; compatible.
+           (let ((len (length string))
+                 (i 0))
+             (while (< i len)
+               (or (memq (char-charset (aref string i))
+                         '(ascii latin-iso8859-1))
+                   (aset string i ??))
+               (setq i (1+ i)))
+             (setq string (encode-coding-string string 'iso-latin-1)))
+         (let ((charsets (list 'ascii (car ps-mule-header-charsets)))
+               (len (length string))
+               (i 0))
+           (while (< i len)
+             (or (memq (char-charset (aref string i)) charsets)
+                 (aset string i ??))
+             (setq i (1+ i))))
+         (setq string (ps-mule-string-encoding font-spec string nil t))))))
+  string)
+
+;;;###autoload
+(defun ps-mule-header-string-charsets ()
+  "Return a list of character sets that appears in header strings."
+  (let* ((str (ps-header-footer-string))
+        (len (length str))
+        (i 0)
+        charset-list)
+    (while (< i len)
+      (let ((charset (char-charset (aref str i))))
+       (setq i (1+ i))
+       (or (eq charset 'ascii)
+           (memq charset charset-list)
+           (setq charset-list (cons charset charset-list)))))
+    charset-list))
+

 ;;;###autoload
 (defun ps-mule-begin-job (from to)
   "Start printing job for multi-byte chars between FROM and TO.
 This checks if all multi-byte characters in the region are printable or not."
   (setq ps-mule-charset-list nil
 ;;;###autoload
 (defun ps-mule-begin-job (from to)
   "Start printing job for multi-byte chars between FROM and TO.
 This checks if all multi-byte characters in the region are printable or not."
   (setq ps-mule-charset-list nil

+       ps-mule-header-charsets nil

        ps-mule-font-info-database
        (cond ((eq ps-multibyte-buffer 'non-latin-printer)
               ps-mule-font-info-database-ps)
        ps-mule-font-info-database
        (cond ((eq ps-multibyte-buffer 'non-latin-printer)
               ps-mule-font-info-database-ps)


@@ -1088,7 +1419,7 @@ This checks if all multi-byte characters in the region are printable or not."
              ((eq ps-multibyte-buffer 'bdf-font-except-latin)
               ps-mule-font-info-database-ps-bdf)
              (t
              ((eq ps-multibyte-buffer 'bdf-font-except-latin)
               ps-mule-font-info-database-ps-bdf)
              (t

-              ps-mule-font-info-database-latin)))
+              ps-mule-font-info-database-default)))

   (and (boundp 'enable-multibyte-characters)
        enable-multibyte-characters
        ;; Initialize `ps-mule-charset-list'.  If some characters aren't
   (and (boundp 'enable-multibyte-characters)
        enable-multibyte-characters
        ;; Initialize `ps-mule-charset-list'.  If some characters aren't


@@ -1101,6 +1432,15 @@ This checks if all multi-byte characters in the region are printable or not."
           (and (search-forward "\200" to t)
                (setq ps-mule-charset-list
                      (cons 'composition ps-mule-charset-list))))
           (and (search-forward "\200" to t)
                (setq ps-mule-charset-list
                      (cons 'composition ps-mule-charset-list))))

+        ;; We also have to check non-ASCII charsets in the header strings.
+        (let ((tail (ps-mule-header-string-charsets)))
+          (while tail
+            (unless (eq (car tail) 'ascii)
+              (setq ps-mule-header-charsets
+                    (cons (car tail) ps-mule-header-charsets))
+              (or (memq (car tail) charsets)
+                  (setq charsets (cons (car tail) charsets))))
+            (setq tail (cdr tail))))

         (while charsets
           (setq charsets
                 (cond
         (while charsets
           (setq charsets
                 (cond


@@ -1115,8 +1455,15 @@ This checks if all multi-byte characters in the region are printable or not."
 
   (setq ps-mule-current-charset 'ascii)
 
 
   (setq ps-mule-current-charset 'ascii)
 

-  (if ps-mule-charset-list
-      (let ((the-list ps-mule-charset-list)
+  (if (and (nth 2 (find-composition from to))
+          (not ps-mule-composition-prologue-generated))
+      (progn
+       (ps-mule-prologue-generated)
+       (ps-output-prologue ps-mule-composition-prologue)
+       (setq ps-mule-composition-prologue-generated t)))
+
+  (if (or ps-mule-charset-list ps-mule-header-charsets)
+      (let ((the-list (append ps-mule-header-charsets ps-mule-charset-list))

            font-spec elt)
        (ps-mule-prologue-generated)
        ;; If external functions are necessary, generate prologues for them.
            font-spec elt)
        (ps-mule-prologue-generated)
        ;; If external functions are necessary, generate prologues for them.


@@ -1124,14 +1471,14 @@ This checks if all multi-byte characters in the region are printable or not."
          (setq elt (car the-list)
                the-list (cdr the-list))
          (cond ((and (eq elt 'composition)
          (setq elt (car the-list)
                the-list (cdr the-list))
          (cond ((and (eq elt 'composition)

-                     (not ps-mule-cmpchar-prologue-generated))
-                (ps-output-prologue ps-mule-cmpchar-prologue)
-                (setq ps-mule-cmpchar-prologue-generated t))
+                     (not ps-mule-composition-prologue-generated))
+                (ps-output-prologue ps-mule-composition-prologue)
+                (setq ps-mule-composition-prologue-generated t))

                ((setq font-spec (ps-mule-get-font-spec elt 'normal))
                 (ps-mule-init-external-library font-spec))))))
 
   ;; If ASCII font is also specified in ps-mule-font-info-database,
                ((setq font-spec (ps-mule-get-font-spec elt 'normal))
                 (ps-mule-init-external-library font-spec))))))
 
   ;; If ASCII font is also specified in ps-mule-font-info-database,

-  ;; use it istead of what specified in ps-font-info-database.
+  ;; use it instead of what specified in ps-font-info-database.

   (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal)))
     (if font-spec
        (progn
   (let ((font-spec (ps-mule-get-font-spec 'ascii 'normal)))
     (if font-spec
        (progn


@@ -1146,6 +1493,18 @@ This checks if all multi-byte characters in the region are printable or not."
              (setq font (cdr font)
                    ps-current-font (1+ ps-current-font)))))))
 
              (setq font (cdr font)
                    ps-current-font (1+ ps-current-font)))))))
 

+  ;; If the header contains non-ASCII and non-Latin1 characters, prepare a font
+  ;; and glyphs for the first occurrence of such characters.
+  (if (and ps-mule-header-charsets
+          (not (eq (car ps-mule-header-charsets) 'latin-iso8859-1)))
+      (let ((font-spec (ps-mule-get-font-spec (car ps-mule-header-charsets)
+                                             'normal)))
+       (if font-spec
+           ;; Be sure to download glyphs for "0123456789/" in advance for page
+           ;; numbering.
+           (let ((ps-current-font 0))
+             (ps-mule-prepare-font font-spec "0123456789/" 'ascii t t)))))
+

   (if ps-mule-charset-list
       ;; We must change this regexp for multi-byte buffer.
       (setq ps-control-or-escape-regexp
   (if ps-mule-charset-list
       ;; We must change this regexp for multi-byte buffer.
       (setq ps-control-or-escape-regexp


@@ -1155,7 +1514,7 @@ This checks if all multi-byte characters in the region are printable or not."
                   (string-as-multibyte "[^\040-\176\240-\377]"))
                  ((eq ps-print-control-characters 'control)
                   (string-as-multibyte "[^\040-\176\200-\377]"))
                   (string-as-multibyte "[^\040-\176\240-\377]"))
                  ((eq ps-print-control-characters 'control)
                   (string-as-multibyte "[^\040-\176\200-\377]"))

-                 (t (string-as-multibyte "[^\000-\011\013\015-\377"))))))
+                 (t (string-as-multibyte "[^\000-\011\013\015-\377]"))))))

 
 ;;;###autoload
 (defun ps-mule-begin-page ()
 
 ;;;###autoload
 (defun ps-mule-begin-page ()


@@ -1164,4 +1523,5 @@ This checks if all multi-byte characters in the region are printable or not."
 
 (provide 'ps-mule)
 
 
 (provide 'ps-mule)
 

+;;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe

 ;;; ps-mule.el ends here
 ;;; ps-mule.el ends here