Add 2012 to FSF copyright years for Emacs files (do not merge to trunk)
[bpt/emacs.git] / lisp / ps-mule.el
index 54054e4..9a95e36 100644 (file)
@@ -1,7 +1,7 @@
 ;;; ps-mule.el --- provide multi-byte character facility to ps-print
 
 ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;;   2005, 2006, 2007 Free Software Foundation, Inc.
+;;   2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
 
 ;; Author: Vinicius Jose Latorre <viniciusjl@ig.com.br>
 ;;     Kenichi Handa <handa@m17n.org> (multi-byte characters)
 
 ;; This file is part of GNU Emacs.
 
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -22,9 +22,7 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
@@ -96,7 +94,7 @@
 
 ;;;###autoload
 (defcustom ps-multibyte-buffer nil
-  "*Specifies the multi-byte buffer handling.
+  "Specifies the multi-byte buffer handling.
 
 Valid values are:
 
@@ -190,7 +188,7 @@ See also the variable `ps-font-info-database'.")
 
 (defcustom ps-mule-font-info-database-default
   ps-mule-font-info-database-latin
-  "*The default setting to use when `ps-multibyte-buffer' 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)
 
@@ -276,7 +274,7 @@ Currently, data for Japanese and Korean PostScript printers are listed.")
     (indian-1-column
      (normal bdf ("ind1c24-mule.bdf" "mule-indian-1col-24.bdf")))
     (ethiopic
-     (normal bdf ("ethio24f-uni.bdf" "ethiomx24f-uni.bdf") unicode-bmp))
+     (normal bdf ("ethio16f-uni.bdf" "ethiomx24f-uni.bdf") unicode-bmp))
     (chinese-cns11643-3
      (normal bdf ("cns3-40.bdf" "cns-3-40.bdf")))
     (chinese-cns11643-4
@@ -321,31 +319,19 @@ by `ps-font-family' and `ps-header-font-family'.
 
 See also `ps-mule-font-info-database-bdf'.")
 
-(defvar ps-mule-font-spec-list nil
-  "Array of FONT-SPEC lists for each font type.
-
-Elements are for `normal' font, `bold' font, `italic' font, and
-`bold-italic' font in this order.
-
-Each element is a list of FONT-SPEC which has this form:
-
-       (ID CHARSET (FONT-SRC FONT-NAME ENCODING) EXTRA-DATA)
-
-Where
-
-ID is a number for this FONT-SPEC and is unique in the list.
-
-CHARSET, FONT-SRC, FONT-NAME, ENCODING are the same as those in
-`ps-mule-font-info-database' (which see).
-
-EXTRA-DATA is a data attached by external libraries.
-
-Each list is ordered by the current charset priorities.
-
-This variable is setup by `ps-mule-begin-job' from
-`ps-mule-font-info-database'.")
-
 ;; Functions to access each element of FONT-SPEC.
+;;
+;; FONT-SPEC is a vector of this form:
+;;     [ID CHARSET FONT-ID FONT-SRC FONT-NAME ENCODING BYTES EXTRA-DATA]
+;; Where
+;;
+;; ID is an identification number for this FONT-SPEC and is unique in the list.
+;;
+;; CHARSET, FONT-SRC, FONT-NAME, ENCODING, and BYTES are the same as those in
+;; `ps-mule-font-info-database' (which see).
+;;
+;; EXTRA-DATA is a data attached by external libraries.
+
 (defsubst ps-mule-font-spec-id (font-spec) (aref font-spec 0))
 (defsubst ps-mule-font-spec-charset (font-spec) (aref font-spec 1))
 (defsubst ps-mule-font-spec-font-id (font-spec) (aref font-spec 2))
@@ -441,8 +427,8 @@ PostScript procedures that will be called by FONT-FUNC and GLYPHS-FUNC.  It is
 called with no argument, and should return a list of strings.
 
 CHECK-FUNC is a function to check if a font is available or not.
-It is called with one argument FONT-SPEC, and should return non-nil iff the
-font specified in FONT-SPEC is available.
+It is called with one argument FONT-SPEC, and should return non-nil if and
+only if the font specified in FONT-SPEC is available.
 
 FONT-FUNC is a function to generate PostScript code which define a new font.
 It is called with one argument FONT-SPEC, and should return a list of strings.
@@ -579,10 +565,7 @@ FONT-SPEC-TABLE is 0, 1, 2, 3, 4, 5, or 6, each represents font tags f0, f1,
 f2, f3, h0, h1, and H0 respectively."
   (let* ((font-spec nil)
         (font-id 0)
-        (string-list nil)
-        ;; At most 4-byte (EscChar FONT-ID CODE1 CODE2) per character.
-        (str (make-string (* (- to from) 4) 0))
-        (i 0))
+        (code-list nil))
     (goto-char from)
     (while (< (point) to)
       (let* ((char (following-char))
@@ -594,30 +577,20 @@ f2, f3, h0, h1, and H0 respectively."
          (setq char ??
                this-spec (ps-mule-get-font-spec char font-spec-table nil)
                this-id (ps-mule-font-spec-font-id this-spec)))
-       (or (= font-id this-id)
-           (progn
-             (if font-spec
-                 (setq string-list (cons (substring str 0 i) string-list)
-                       i 0))
-             (setq font-id this-id)
-             (or (= font-id 0)
-                 (progn
-                   (aset str i ps-mule-esc-char)
-                   (setq i (1+ i))
-                   (aset str i font-id)
-                   (setq i (1+ i))))))
+       (unless (= font-id this-id)
+         (setq font-id this-id)
+         (push ps-mule-esc-char code-list)
+         (push font-id code-list))
        (setq font-spec this-spec)
        (if (< char 128)
-           (aset str i char)
+           (push char code-list)
          (let* ((code (ps-mule-encode-char char font-spec)))
            (if (= (ps-mule-font-spec-bytes font-spec) 1)
-               (aset str i code)
-             (aset str i (/ code 256))
-             (setq i (1+ i))
-             (aset str i (% code 256)))))
-       (setq i (1+ i))
+               (push code code-list)
+             (push (/ code 256) code-list)
+             (push (% code 256) code-list))))
        (forward-char 1)))
-    (nreverse (cons (substring str 0 i) string-list))))
+    (apply 'unibyte-string (nreverse code-list))))
 
 (defun ps-mule-plot-composition (composition font-spec-table)
   "Generate PostScript code for plotting COMPOSITION with FONT-SPEC-TABLE."
@@ -674,7 +647,10 @@ the sequence."
   (let* ((average-width (ps-avg-char-width 'ps-font-for-text))
         (point (point))
         (composition (find-composition from to nil t))
-        (stop (if composition (car composition) to))
+        (stop (if (and composition
+                       (not (vectorp (aref (nth 2 composition) 0))))
+                  (car composition)
+                to))
         (ascii-or-latin-1 "[\000-\377]+")
         (run-width 0)
         (endpos nil)
@@ -687,11 +663,10 @@ the sequence."
       (cond ((= (point) stop)
             (if (= stop to)
                 (setq endpos stop)
-              (if (< from stop)
-                  (dolist (l (ps-mule-encode-region from (point)
-                                                    font-spec-table))
-                    (ps-output-string l)
-                    (ps-output " S\n")))
+              (when (< from stop)
+                (ps-output-string (ps-mule-encode-region from (point)
+                                                         font-spec-table))
+                (ps-output " S\n"))
               (setq width (* (nth 5 composition) average-width))
               (if (< ps-width-remaining (+ run-width width))
                   (setq endpos stop)
@@ -721,10 +696,9 @@ the sequence."
                 (setq run-width (+ run-width width))
                 (forward-char 1))))))
 
-    (if (< from endpos)
-       (dolist (l (ps-mule-encode-region from endpos font-spec-table))
-         (ps-output-string l)
-         (ps-output " S\n")))
+    (when (< from endpos)
+      (ps-output-string (ps-mule-encode-region from endpos font-spec-table))
+      (ps-output " S\n"))
     (goto-char point)
     (cons endpos run-width)))
 
@@ -750,7 +724,7 @@ the sequence."
        } ifelse def
        dup 0 get stringwidth pop dup /WIDTH exch def bmp 0 get div
        dup LLY mul /LLY exch def
-       URY mul /URY exch def   
+       URY mul /URY exch def
     } {
        pop
        dup 0 get stringwidth pop /WIDTH exch def
@@ -805,7 +779,7 @@ the sequence."
     /RIGHT WIDTH def
     /TOP URY def
     /BOTTOM LLY def
-       
+
     1 1 components length 1 sub {
        components exch get
        [ exch
@@ -985,7 +959,7 @@ the sequence."
 
 (defun ps-mule-generate-bitmap-glyph (font-spec char code bitmap)
   (let* ((id (ps-mule-font-spec-id font-spec))
-        ;; FONT-RECORD ::= ([(SUBFONT-OUTPUT-LIST ...) | t] 
+        ;; FONT-RECORD ::= ([(SUBFONT-OUTPUT-LIST ...) | t]
         ;;                  BASEFONT-OUTPUT-LIST SIZE REL-COMP B-OFFSET BBX)
         (font-record (aref ps-mule-bitmap-font-record id))
         enc-name
@@ -1042,23 +1016,22 @@ FONTTAG should be a string \"/h0\", \"/h1\", \"/L0\", or \"/H0\".
 Any other value is treated as \"/H0\"."
   (with-temp-buffer
     (insert string)
-    (ps-mule-encode-region (point-min) (point-max)
-                          (aref ps-mule-font-spec-tables
-                                (aref ps-mule-font-number-to-type
-                                      (cond ((string= fonttag "/h0") 4)
-                                            ((string= fonttag "/h1") 5)
-                                            ((string= fonttag "/L0") 6)
-                                            (t 0)))))))
+    (list (ps-mule-encode-region (point-min) (point-max)
+                                (aref ps-mule-font-spec-tables
+                                      (aref ps-mule-font-number-to-type
+                                            (cond ((string= fonttag "/h0") 4)
+                                                  ((string= fonttag "/h1") 5)
+                                                  ((string= fonttag "/L0") 6)
+                                                  (t 0))))))))
 
 ;;;###autoload
 (defun ps-mule-begin-job (from to)
   "Start printing job for multi-byte chars between FROM and TO.
 It checks if all multi-byte characters in the region are printable or not."
-  (auto-compose-region from to)
   (if (and (not (find-composition from to))
           (save-excursion
             (goto-char from)
-            (= (skip-chars-forward "\x00-\xFF" to) to)))
+            (= (skip-chars-forward "\x00-\x7F" to) to)))
       ;; All characters can be printed by normal PostScript fonts.
       (setq ps-basic-plot-string-function 'ps-basic-plot-string
            ps-encode-header-string-function 'identity)
@@ -1100,17 +1073,19 @@ It checks if all multi-byte characters in the region are printable or not."
              (setq font-info-list (cons font-info font-info-list))))
        (setq font-info-list (nreverse font-info-list)))
 
+      ;; Now font-info-list is an alist ordered by charset priority.
       ;; Store FONT-SPECs in each element of font-spec-alist.
       (dolist (font-info font-info-list)
        (let ((font-spec-vec (make-vector 4 nil))
              (charset (car font-info))
-             encoding font-spec)
+             encoding bytes font-spec)
          (dolist (e (cdr font-info))
-           (setq encoding (or (nth 3 e) charset)
-                 font-spec (vector id-max charset font-id
+           (setq encoding (nth 3 e) bytes (nth 4 e))
+           (unless encoding
+             (setq encoding charset bytes (charset-dimension charset)))
+           (setq font-spec (vector id-max charset font-id
                                    (nth 1 e) (nth 2 e) encoding
-                                   (or (nth 4 e) (charset-dimension encoding))
-                                   nil)
+                                   (or bytes 1) nil)
                  id-max (1+ id-max))
            (if (ps-mule-check-font font-spec)
                (aset font-spec-vec
@@ -1163,7 +1138,7 @@ It checks if all multi-byte characters in the region are printable or not."
 
 (defun ps-mule-redefine-font (font-number fonttag size ps-font)
   (let* ((font-type (aref ps-mule-font-number-to-type font-number))
-        (font-spec-alist (char-table-extra-slot 
+        (font-spec-alist (char-table-extra-slot
                           (aref ps-mule-font-spec-tables font-type) 0)))
     (ps-output-prologue
      (list (if (ps-mule-font-spec-src (cdr (car font-spec-alist)))
@@ -1184,7 +1159,7 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
   (let ((output-head (list t))
        (ps-mule-output-list (list t)))
     (dotimes (i 4)
-      (map-char-table 'ps-mule-prepare-glyph 
+      (map-char-table 'ps-mule-prepare-glyph
                      (aref ps-mule-font-spec-tables i)))
     (ps-mule-restruct-output-list (cdr ps-mule-output-list) output-head)
     (ps-output-prologue (cdr output-head)))
@@ -1212,7 +1187,7 @@ V%s 0 /%s-latin1 /%s Latin1Encoding put\n"
                                  (mapconcat #'(lambda (x)
                                                 (format "F%02X" (cdr x)))
                                             font-list " ")))))
-       
+
   ;; Redefine fonts f0, f1, f2, f3, h0, h1, H0.
   (ps-mule-redefine-font 4 "h0" ps-header-title-font-size-internal
                         (ps-font 'ps-font-for-header 'bold))