Mercurial > emacs

changeset 17755:4c82e87c7d7c

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(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.
author Kenichi Handa <handa@m17n.org>
date Mon, 12 May 1997 06:56:20 +0000
parents 8be34c35fa73
children 0000a992fd24
files lisp/international/fontset.el
diffstat 1 files changed, 72 insertions(+), 40 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/international/fontset.el	Mon May 12 06:56:19 1997 +0000
+++ b/lisp/international/fontset.el	Mon May 12 06:56:20 1997 +0000
@@ -195,7 +195,7 @@
 		    (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 @@
 	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