]> code.delx.au - gnu-emacs/blobdiff - lisp/international/fontset.el
(locale-language-names): Use "French" for "fr".
[gnu-emacs] / lisp / international / fontset.el
index efefa72ba7d03a50899210237f84916a4c07ac72..7baa89ae66cb1326a8d01419eb215457c70883dd 100644 (file)
@@ -1,7 +1,8 @@
-;;; fontset.el --- Commands for handling fontset.
+;;; fontset.el --- commands for handling fontset
 
 ;; Copyright (C) 1995, 1997 Electrotechnical Laboratory, JAPAN.
 ;; Licensed to the Free Software Foundation.
+;; Copyright (C) 2001 Free Software Foundation, Inc.
 
 ;; Keywords: mule, multilingual, fontset
 
@@ -22,6 +23,8 @@
 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
 ;; Boston, MA 02111-1307, USA.
 
+;;; Commentary:
+
 ;;; Code:
 
 ;; Set standard fontname specification of characters in the default
@@ -50,9 +53,9 @@
           (cyrillic-iso8859-5 . ("*" . "ISO8859-5"))
           (latin-iso8859-9 . (nil . "ISO8859-9"))
           (japanese-jisx0208-1978 . ("*" . "JISX0208.1978"))
-          (chinese-gb2312 . ("*" . "GB2312"))
-          (japanese-jisx0208 . ("*" . "JISX0208.1983"))
-          (korean-ksc5601 . ("*" . "KSC5601"))
+          (chinese-gb2312 . ("*" . "GB2312.1980"))
+          (japanese-jisx0208 . ("*" . "JISX0208.1990"))
+          (korean-ksc5601 . ("*" . "KSC5601.1989"))
           (japanese-jisx0212 . ("*" . "JISX0212"))
           (chinese-cns11643-1 . ("*" . "CNS11643.1992-1"))
           (chinese-cns11643-2 . ("*" . "CNS11643.1992-2"))
           (indian-2-column . ("*" . "MuleIndian-2"))
           (indian-1-column . ("*" . "MuleIndian-1"))
           (lao . ("*" . "MuleLao-1"))
-          (tibetan . ("*" . "MuleTibetan-0"))
+          (tibetan . ("proportional" . "MuleTibetan-2"))
           (tibetan-1-column . ("*" . "MuleTibetan-1"))
           (latin-iso8859-14 . (nil . "ISO8859-14"))
           (latin-iso8859-15 . (nil . "ISO8859-15"))
           (mule-unicode-0100-24ff . (nil . "ISO10646-1"))
-          (japanese-jisx0213-1 . ("*" . "JISX0213"))
-          (japanese-jisx0213-2 . ("*" . "JISX0213"))
+          (mule-unicode-2500-33ff . (nil . "ISO10646-1"))
+          (mule-unicode-e000-ffff . (nil . "ISO10646-1"))
+          (japanese-jisx0213-1 . ("*" . "JISX0213.2000-1"))
+          (japanese-jisx0213-2 . ("*" . "JISX0213.2000-2"))
           ))
       charset font-spec arg)
   (while l
     (setq charset (car (car l)) font-spec (cdr (car l)) l (cdr l))
-    (or (string-match "-" (cdr font-spec))
-       (setcdr font-spec (concat (cdr font-spec) "*")))
     (if (symbolp charset)
        (setq arg (make-char charset))
       (setq arg charset))
 (set-font-encoding "ISO8859-1" 'ascii 0)
 (set-font-encoding "JISX0201" 'latin-jisx0201 0)
 
+(define-ccl-program ccl-encode-unicode-font
+  `(0
+    (if (r0 == ,(charset-id 'ascii))
+       ((r2 = r1)
+        (r1 = 0))
+      (if (r0 == ,(charset-id 'latin-iso8859-1))
+         ((r2 = (r1 + 128))
+          (r1 = 0))
+       (if (r0 == ,(charset-id 'mule-unicode-0100-24ff))
+           ((r1 *= 96)
+            (r1 += r2)
+            (r1 += ,(- #x100 (* 32 96) 32))
+            (r1 >8= 0)
+            (r2 = r7))
+         (if (r0 == ,(charset-id 'mule-unicode-2500-33ff))
+             ((r1 *= 96)
+              (r1 += r2)
+              (r1 += ,(- #x2500 (* 32 96) 32))
+              (r1 >8= 0)
+              (r2 = r7))
+           (if (r0 == ,(charset-id 'mule-unicode-e000-ffff))
+               ((r1 *= 96)
+                (r1 += r2)
+                (r1 += ,(- #xe000 (* 32 96) 32))
+                (r1 >8= 0)
+                (r2 = r7)))))))))
+
+(setq font-ccl-encoder-alist
+      (cons '("ISO10646-1" . ccl-encode-unicode-font)
+           font-ccl-encoder-alist))
+
 ;; Setting for suppressing XLoadQueryFont on big fonts.
 (setq x-pixel-size-width-font-regexp
       "gb2312\\|jisx0208\\|ksc5601\\|cns11643\\|big5")
     ("koi8" ascii cyrillic-iso8859-5)
     ("viscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower)
     ("vscii" ascii vietnamese-viscii-upper vietnamese-viscii-lower)
-    ("mulelao-1" ascii lao))
+    ("mulelao-1" ascii lao)
+    ("iso10646-1" ascii latin-iso8859-1 mule-unicode-0100-24ff
+     mule-unicode-2500-33ff mule-unicode-e000-ffff))
   "Alist of font names vs list of charsets the font can display.
 
 When a font name which matches some element of this alist is given as
@@ -268,6 +304,27 @@ Optional argument REDUCE is always ignored.  It exists just for
 backward compatibility."
   (concat "-" (mapconcat (lambda (x) (or x "*")) fields "-")))
 
+
+(defun x-must-resolve-font-name (xlfd-fields)
+  "Like `x-resolve-font-name', but always return a font name.
+XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields.
+If no font matching XLFD-FIELDS is available, successively replace
+parts of the font name pattern with \"*\" until some font is found.
+Value is name of that font."
+  (let ((ascii-font nil) (index 0))
+    (while (and (null ascii-font) (<= index xlfd-regexp-encoding-subnum))
+      (let ((pattern (x-compose-font-name xlfd-fields)))
+       (condition-case nil
+           (setq ascii-font (x-resolve-font-name pattern))
+         (error
+          (message "Warning: no fonts matching `%s' available" pattern)
+          (aset xlfd-fields index "*")
+          (setq index (1+ index))))))
+    (unless ascii-font
+      (error "No fonts founds"))
+    ascii-font))
+
+
 (defun x-complement-fontset-spec (xlfd-fields fontlist)
   "Complement FONTLIST for charsets based on XLFD-FIELDS and return it.
 XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields.
@@ -281,17 +338,29 @@ FONTLIST.
 
 If a font specifid for ASCII supports the other charsets (see the
 variable `x-font-name-charset-alist'), add that information to FONTLIST."
-  (let ((ascii-font (cdr (assq 'ascii fontlist))))
-
-    ;; If font for ASCII is not specified, add it.
-    (unless ascii-font
+  (let* ((slot (assq 'ascii fontlist))
+        (ascii-font (cdr slot))
+        ascii-font-spec)
+    (if ascii-font
+       (setcdr slot (setq ascii-font (x-resolve-font-name ascii-font)))
+      ;; If font for ASCII is not specified, add it.
       (aset xlfd-fields xlfd-regexp-registry-subnum "iso8859")
       (aset xlfd-fields xlfd-regexp-encoding-subnum "1")
-      (setq ascii-font (x-compose-font-name xlfd-fields))
+      (setq ascii-font (x-must-resolve-font-name xlfd-fields))
       (setq fontlist (cons (cons 'ascii ascii-font) fontlist)))
 
     ;; If the font for ASCII also supports the other charsets, and
     ;; they are not specified in FONTLIST, add them.
+    (setq xlfd-fields (x-decompose-font-name ascii-font))
+    (if (not xlfd-fields)
+       (setq ascii-font-spec ascii-font)
+      (setq ascii-font-spec
+           (cons (format "%s-%s"
+                         (aref xlfd-fields xlfd-regexp-foundry-subnum)
+                         (aref xlfd-fields xlfd-regexp-family-subnum))
+                 (format "%s-%s"
+                         (aref xlfd-fields xlfd-regexp-registry-subnum)
+                         (aref xlfd-fields xlfd-regexp-encoding-subnum)))))
     (let ((tail x-font-name-charset-alist)
          elt)
       (while tail
@@ -303,7 +372,7 @@ variable `x-font-name-charset-alist'), add that information to FONTLIST."
                (setq charset (car charsets) charsets (cdr charsets))
                (or (assq charset fontlist)
                    (setq fontlist
-                         (cons (cons charset ascii-font) fontlist))))))))
+                         (cons (cons charset ascii-font-spec) fontlist))))))))
     
     fontlist))
 
@@ -395,6 +464,7 @@ It returns a name of the created fontset."
        (if (charsetp charset)
            (setq fontlist (cons (cons charset (match-string 2 fontset-spec))
                                 fontlist))))
+      (setq ascii-font (cdr (assq 'ascii fontlist)))
 
       ;; Complement FONTLIST.
       (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist))
@@ -410,7 +480,8 @@ It returns a name of the created fontset."
                      (cons (cons name alias) fontset-alias-alist)))))
 
       ;; Define the ASCII font name alias.
-      (setq ascii-font (cdr (assq 'ascii fontlist)))
+      (or ascii-font
+         (setq ascii-font (cdr (assq 'ascii fontlist))))
       (or (rassoc ascii-font fontset-alias-alist)
          (setq fontset-alias-alist
                (cons (cons name ascii-font)