X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/8b31363957453c57c0b316fe41846f02d5855bac..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/ps-mule.el

diff --git a/lisp/ps-mule.el b/lisp/ps-mule.el
index 91997c9610..ec7b3b22fc 100644
--- 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
 
-;; Copyright (C) 1998,99,00,2001 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; Free Software Foundation, Inc.
 
 ;; 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: <2001/08/07 13:50:53 vinicius>
+;; Time-stamp: <2003/05/14 22:19:41 vinicius>
 
 ;; This file is part of GNU Emacs.
 
@@ -159,7 +160,10 @@
 	    (setq i (1+ i)))
 	  multibyte)))
   (or (fboundp 'string-make-multibyte)
-      (defalias 'string-make-multibyte 'copy-sequence)))
+      (defalias 'string-make-multibyte 'copy-sequence))
+  (or (fboundp 'encode-char)
+      (defun encode-char (ch ccs)
+	ch)))
 
 
 ;;;###autoload
@@ -209,53 +213,6 @@ Any other value is treated as nil."
 		 (const bdf-font-except-latin) (const :tag "nil" nil))
   :group 'ps-print-font)
 
-
-(eval-and-compile
-  ;; For Emacs 20.2 and the earlier version.
-  (if (and (boundp 'mule-version)
-	   (not (string< (symbol-value 'mule-version) "4.0")))
-      ;; mule package is loaded
-      (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)))
-    ;; mule package isn't loaded or mule version lesser than 4.0
-    (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)))))
-    )
-  ;; For Emacs 20.4 and the earlier version.
-  (if (and (boundp 'mule-version)
-	   (string< (symbol-value 'mule-version) "5.0"))
-      ;; mule package is loaded and mule version is lesser than 5.0
-      (progn
-	(defun encode-composition-rule (rule)
-	  (if (= (car rule) 4) (setcar rule 10))
-	  (if (= (cdr rule) 4) (setcdr rule 10))
-	  (+ (* (car rule) 12) (cdr rule)))
-	(defun find-composition (pos &rest ignore)
-	  (let ((ch (char-after pos)))
-	    (if (eq (char-charset ch) 'composition)
-		(let ((components (decompose-composite-char ch 'vector t)))
-		  (list pos (ps-mule-next-point pos) components
-			(integerp (aref components 1)) nil
-			(char-width ch)))))))
-    ;; mule package isn't loaded
-    (or (fboundp 'encode-composition-rule)
-	(defun encode-composition-rule (rule)
-	  130))
-    (or (fboundp 'find-composition)
-	(defun find-composition (pos &rest ignore)
-	  nil))
-    ))
-
 (defvar ps-mule-font-info-database
   nil
   "Alist of charsets with the corresponding font information.
@@ -269,7 +226,7 @@ CHARSET is a charset (symbol) for this font family,
 
 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 built-in PostScript font name.
 
@@ -417,16 +374,22 @@ Currently, data for Japanese and Korean PostScript printers are listed.")
      (normal bdf ("ind24-mule.bdf" "mule-indian-24.bdf") ps-mule-encode-7bit 2))
     (tibetan
      (normal bdf ("tib24p-mule.bdf" "tib24-mule.bdf" "mule-tibmdx-24.bdf")
-	     ps-mule-encode-7bit 2)))
+	     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.
 
-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.
+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'.")
 
@@ -435,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.
 
-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.
+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'.")
 
@@ -455,21 +418,21 @@ 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))))
-	 (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
-		(+ (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)
-	(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))
-	  (setq i (ps-mule-next-index string i)
+	  (setq i (1+ i)
 		j (+ j 2)))))
     str))
 
@@ -503,6 +466,23 @@ See also `ps-mule-font-info-database-bdf'.")
   (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)
 
@@ -816,11 +796,11 @@ the sequence."
 	    (cons from ps-width-remaining)
 	  (cons (if composition
 		    (nth 1 composition)
-		  (ps-mule-next-point from))
+		  (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)))
-    (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
@@ -869,7 +849,7 @@ the sequence."
 
      ;; This case is obsolete for Emacs 21.
      ((eq ps-mule-current-charset 'composition)
-      (ps-mule-plot-composition from (ps-mule-next-point from) bg-color))
+      (ps-mule-plot-composition from (1+ from) bg-color))
 
      (t
       ;; No way to print this charset.  Just show a vacant box of an
@@ -1130,10 +1110,10 @@ the sequence."
 	} ifelse } ifelse } ifelse
     } forall ] /components exch def
     grestore
-    
+
     %% Reflect special effects.
     SpecialEffect
-    
+
     %% Draw components while ignoring effects other than shadow and outline.
     components ShowComponents
 
@@ -1413,36 +1393,17 @@ FONTTAG should be a string \"/h0\" or \"/h1\"."
 ;;;###autoload
 (defun ps-mule-header-string-charsets ()
   "Return a list of character sets that appears in header strings."
-  (let ((str ""))
-    (when ps-print-header
-      (let ((tail (list ps-left-header ps-right-header)))
-	(while tail
-	  ;; Simulate what is done by ps-generate-header-line to get a
-	  ;; string to plot.
-	  (let ((count 0)
-		(tmp (car tail)))
-	    (setq tail (cdr tail))
-	    (while (and tmp (< count ps-header-lines))
-	      (let ((elt (car tmp)))
-		(setq tmp (cdr tmp)
-		      count (1+ count)
-		      str (concat str
-				  (cond ((stringp elt) elt)
-					((and (symbolp elt) (fboundp elt))
-					 (funcall elt))
-					((and (symbolp elt) (boundp elt))
-					 (symbol-value elt))
-					(t ""))))))))))
-    (let ((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)))
+  (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)
@@ -1533,7 +1494,7 @@ This checks if all multi-byte characters in the region are printable or not."
 		    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 occurance of such characters.
+  ;; 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)
@@ -1562,4 +1523,5 @@ This checks if all multi-byte characters in the region are printable or not."
 
 (provide 'ps-mule)
 
+;;; arch-tag: bca017b2-66a7-4e59-8584-103e749eadbe
 ;;; ps-mule.el ends here