(x-decompose-font-name): While seting each field of

XLFD, set "*" instead of nil to a field which is omitted in the
original font name.
(generate-fontset-menu): Delete code for handling alias (or
nickname). It is now handled in fontset-plain-name.
(fontset-plain-name): Handle alias of fontset name, show more
user-friendy names.
(create-fontset-from-fontset-spec): Add an optional arg STYLE to
create bold, italic, and bold-italic variants of a fonset.

1 files changed, 72 insertions, 40 deletions

diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el
index 2e5545576b3..e3dd5e1c063 100644
--- a/lisp/international/fontset.el
+++ b/lisp/international/fontset.el
@@ -195,7 +195,7 @@ PATTERN.  If no full XLFD name is gotten, return nil."
                     (setq i (1+ i)))
                 (if (< (car (aref xlfd-fields i)) (car (cdr l)))
                     (progn
-                      (aset xlfd-fields i nil)
+                      (aset xlfd-fields i "*")
                       (setq i (1+ i)))
                   (setq l (cdr (cdr l))))))
             xlfd-fields)))))
@@ -272,63 +272,95 @@ automatically."
         l)
     (while fontsets
       (setq fontset-name (car (car fontsets)) fontsets (cdr fontsets))
-      (if (string-match "fontset-\\([^-]+\\)" fontset-name)
-          ;; This fontset has a nickname.  Just show it.
-          (let ((nickname (match-string 1 fontset-name)))
-            (setq l (cons (list (concat ".." nickname) fontset-name) l)))
-        (setq l (cons (list fontset-name fontset-name) l))))
+      (setq l (cons (list (fontset-plain-name fontset-name) fontset-name) l)))
     (cons "Fontset" l)))
 
 (defun fontset-plain-name (fontset)
   "Return a plain and descriptive name of FONTSET."
+  (if (not (setq fontset (query-fontset fontset)))
+      (error "Invalid fontset: %s" fontset))
   (let ((xlfd-fields (x-decompose-font-name fontset)))
     (if xlfd-fields
         (let ((weight (aref xlfd-fields xlfd-regexp-weight-subnum))
               (slant  (aref xlfd-fields xlfd-regexp-slant-subnum))
               (swidth (aref xlfd-fields xlfd-regexp-swidth-subnum))
               (size   (aref xlfd-fields xlfd-regexp-pixelsize-subnum))
+              (charset (aref xlfd-fields xlfd-regexp-registry-subnum))
+              (nickname (aref xlfd-fields xlfd-regexp-encoding-subnum))
               name)
-          (if (> (string-to-int size) 0)
-              (setq name (format "%s " size))
-            (setq name ""))
-          (if (string-match "bold\\|demibold" weight)
-              (setq name (concat name weight " ")))
-          (cond ((string= slant "i")
-                 (setq name (concat name "italic ")))
-                ((string= slant "o")
-                 (setq name (concat name "slant ")))
-                ((string= slant "ri")
-                 (setq name (concat name "reverse italic ")))
-                ((string= slant "ro")
-                 (setq name (concat name "reverse slant "))))
-          (if (= (length name) 0)
-              ;; No descriptive fields found.
+          (if (not (string= "fontset" charset))
               fontset
+            (if (> (string-to-int size) 0)
+                (setq name (format "%s: %s-dot" nickname size))
+              (setq name nickname))
+            (cond ((string-match "^medium$" weight)
+                   (setq name (concat name " " "medium")))
+                  ((string-match "^bold$\\|^demibold$" weight)
+                   (setq name (concat name " " weight))))
+            (cond ((string-match "^i$" slant)
+                   (setq name (concat name " " "italic")))
+                  ((string-match "^o$" slant)
+                   (setq name (concat name " " "slant")))
+                  ((string-match "^ri$" slant)
+                   (setq name (concat name " " "reverse italic")))
+                  ((string-match "^ro$" slant)
+                   (setq name (concat name " " "reverse slant"))))
             name))
       fontset)))
 
-(defun create-fontset-from-fontset-spec (fontset-spec)
+(defun create-fontset-from-fontset-spec (fontset-spec &optional style)
   "Create a fontset from fontset specification string FONTSET-SPEC.
 FONTSET-SPEC is a string of the format:
         FONTSET-NAME,CHARSET-NAME0:FONT-NAME0,CHARSET-NAME1:FONT-NAME1, ...
-Any number of SPACE, TAB, and NEWLINE can be put before and after commas."
-  (if (string-match "[^,]+" fontset-spec)
-      (let* ((idx2 (match-end 0))
-             (name (match-string 0 fontset-spec))
-             fontlist charset xlfd-fields)
-        (while (string-match "[, \t\n]*\\([^:]+\\):\\([^,]+\\)"
-                             fontset-spec idx2)
-          (setq idx2 (match-end 0))
-          (setq charset (intern (match-string 1 fontset-spec)))
-          (if (charsetp charset)
-              (setq fontlist (cons (cons charset (match-string 2 fontset-spec))
-                                   fontlist))))
-        (if (setq xlfd-fields (x-decompose-font-name name))
-            ;; If NAME conforms to XLFD, complement FONTLIST for
-            ;; charsets not specified in FONTSET-SPEC.
-            (setq fontlist
-                  (x-complement-fontset-spec xlfd-fields fontlist)))
-        (new-fontset name fontlist))))
+Any number of SPACE, TAB, and NEWLINE can be put before and after commas.
+If optional argument STYLE is specified, create a fontset of STYLE
+by modifying FONTSET-SPEC appropriately.  STYLE can be one of `bold',
+`italic', and `bold-italic'."
+  (if (not (string-match "^[^,]+" fontset-spec))
+      (error "Invalid fontset spec: %s" fontset-spec))
+  (let ((idx (match-end 0))
+        (name (match-string 0 fontset-spec))
+        fontlist charset)
+    ;; At first, extract pairs of charset and fontname from FONTSET-SPEC.
+    (while (string-match "[, \t\n]*\\([^:]+\\):\\([^,]+\\)" fontset-spec idx)
+      (setq idx (match-end 0))
+      (setq charset (intern (match-string 1 fontset-spec)))
+      (if (charsetp charset)
+          (setq fontlist (cons (cons charset (match-string 2 fontset-spec))
+                               fontlist))))
+
+    ;; If STYLE is specified, modify fontset name (NAME) and FONTLIST.
+    (let ((func (cdr (assq style '((bold . x-make-font-bold)
+                                   (italic . x-make-font-italic)
+                                   (bold-italic . x-make-font-bold-italic)))))
+          (l fontlist)
+          new-name)
+      (if (and func
+               (setq new-name (funcall func name)))
+          (progn
+            (setq name new-name)
+            (while l
+              (if (setq new-name (funcall func (cdr (car l))))
+                  (setcdr (car l) new-name))
+              (setq l (cdr l))))))
+
+    ;; If NAME conforms to XLFD, complement FONTLIST for charsets not
+    ;; specified in FONTSET-SPEC.
+    (let ((xlfd-fields (x-decompose-font-name name)))
+      (if xlfd-fields
+          (setq fontlist
+                (x-complement-fontset-spec xlfd-fields fontlist))))
+
+    ;; Create the fontset, and define the alias if appropriate.
+    (new-fontset name fontlist)
+    (if (and (not style)
+             (not (assoc name fontset-alias-alist))
+             (string-match "fontset-.*$" name))
+        (let ((alias (match-string 0 name)))
+          (or (rassoc alias fontset-alias-alist)
+              (setq fontset-alias-alist
+                    (cons (cons name alias) fontset-alias-alist)))))
+    ))
 
 
 ;; Create default fontset from 16 dots fonts which are the most widely