(x-complement-fontset-spec): Setup

alternative-fontname-alist while complementing fontnames.

1 files changed, 28 insertions, 13 deletions

diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 9c8c2766e8f..0d4c5ee8f5c 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -222,25 +222,40 @@ FONTLIST is an alist of cons of charset and fontname.
 Fontnames for charsets not listed in FONTLIST are generated from
 XLFD-FIELDS and a property of x-charset-register of each charset
 automatically."
-  (let ((charsets charset-list))
+  (let ((charsets charset-list)
+        (loose-xlfd-fields (copy-sequence xlfd-fields)))
+    (aset loose-xlfd-fields xlfd-regexp-pixelsize-subnum nil)
+    (aset loose-xlfd-fields xlfd-regexp-pointsize-subnum nil)
+    (aset loose-xlfd-fields xlfd-regexp-resx-subnum nil)
+    (aset loose-xlfd-fields xlfd-regexp-resy-subnum nil)
+    (aset loose-xlfd-fields xlfd-regexp-spacing-subnum nil)
+    (aset loose-xlfd-fields xlfd-regexp-avgwidth-subnum nil)
     (while charsets
       (let ((charset (car charsets)))
         (if (null (assq charset fontlist))
             (let ((registry (get-charset-property charset
-                                                  'x-charset-registry)))
+                                                  'x-charset-registry))
+                  registry-val encoding-val fontname loose-fontname)
               (if (string-match "-" registry)
                   ;; REGISTRY contains `CHARSET_ENCODING' field.
-                  (progn
-                    (aset xlfd-fields xlfd-regexp-registry-subnum
-                          (substring registry 0 (match-beginning 0)))
-                    (aset xlfd-fields xlfd-regexp-encoding-subnum
-                          (substring registry (match-end 0))))
-                (aset xlfd-fields xlfd-regexp-registry-subnum
-                      (concat registry "*"))
-                (aset xlfd-fields xlfd-regexp-encoding-subnum "*"))
-              (setq fontlist
-                    (cons (cons charset (x-compose-font-name xlfd-fields t))
-                          fontlist)))))
+                  (setq registry-val (substring registry 0 (match-beginning 0))
+                        encoding-val (substring registry (match-end 0)))
+                (setq registry-val (concat registry "*")
+                      encoding-val "*"))
+              (aset xlfd-fields xlfd-regexp-registry-subnum registry-val)
+              (aset xlfd-fields xlfd-regexp-encoding-subnum encoding-val)
+              (aset loose-xlfd-fields xlfd-regexp-registry-subnum registry-val)
+              (aset loose-xlfd-fields xlfd-regexp-encoding-subnum encoding-val)
+              (setq fontname (x-compose-font-name xlfd-fields t))
+              (setq fontlist (cons (cons charset fontname) fontlist))
+              (or (assoc fontname alternative-fontname-alist)
+                  (setq alternative-fontname-alist
+                        (cons (list
+                               fontname
+                               (x-compose-font-name loose-xlfd-fields t)
+                               (concat "*-" registry-val "-" encoding-val))
+                              alternative-fontname-alist)))
+              )))
       (setq charsets (cdr charsets))))
   fontlist)