From: Kenichi Handa Date: Thu, 31 Jul 1997 05:53:31 +0000 (+0000) Subject: (fontset-name-p): New function. X-Git-Tag: emacs-20.1~897 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=35d4066a61b26a9686610e447cc7a23e25962c13;p=emacs.git (fontset-name-p): New function. (uninstanciated-fontset-alist): New variable. (create-fontset-from-fontset-spec): Delete arg STYLE. Register style-variants of FONTSET in uninstanciated-fontset-alist. (create-fontset-from-x-resource): Call create-fontset-from-fontset-spec correctly. --- diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 49604f9ab55..2aede0e2410 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -280,6 +280,14 @@ automatically." (setcdr (assq 'latin-iso8859-1 fontlist) (cdr (assq 'ascii fontlist)))) fontlist) +(defun fontset-name-p (fontset) + "Return non-nil if FONTSET is valid as fontset name. +A valid fontset name should conform to XLFD (X Logical Font Description) +with \"fontset\" in ` field." + (and (string-match xlfd-tight-regexp fontset) + (string= (match-string (1+ xlfd-regexp-registry-subnum) fontset) + "fontset"))) + ;; Return a list to be appended to `x-fixed-font-alist' when ;; `mouse-set-font' is called. (defun generate-fontset-menu () @@ -324,6 +332,15 @@ automatically." name)) fontset))) +(defvar uninstanciated-fontset-alist nil + "Alist of fontset names vs. information for instanciating them. +Each element has the form (FONTSET STYLE BASE-FONTSET), where +FONTSET is a name of fontset not yet instanciated. +STYLE is a style of FONTSET, one of the followings: + bold, demobold, italic, oblique, + bold-italic, demibold-italic, bold-oblique, demibold-oblique. +BASE-FONTSET is a name of fontset base from which FONSET is instanciated.") + (defun create-fontset-from-fontset-spec (fontset-spec &optional style noerror) "Create a fontset from fontset specification string FONTSET-SPEC. FONTSET-SPEC is a string of the format: @@ -347,21 +364,6 @@ signaled unless the optional 3rd argument NOERROR is non-nil." (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))) @@ -369,6 +371,43 @@ signaled unless the optional 3rd argument NOERROR is non-nil." (setq fontlist (x-complement-fontset-spec xlfd-fields fontlist)))) + ;; If STYLE is specified, modify fontset name (NAME) and FONTLIST. + (if nil + (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)))))) + (let ((funcs-alist + '((bold x-make-font-bold) + (demibold x-make-font-demibold) + (italic x-make-font-italic) + (oblique x-make-font-oblique) + (bold-italic x-make-font-bold x-make-font-italic) + (demibold-italic x-make-font-demibold x-make-font-italic) + (bold-oblique x-make-font-bold x-make-font-oblique) + (demibold-oblique x-make-font-demibold x-make-font-oblique))) + new-name style funcs) + (while funcs-alist + (setq funcs (car funcs-alist)) + (setq style (car funcs)) + (setq funcs (cdr funcs)) + (setq new-name name) + (while funcs + (setq new-name (funcall (car funcs) new-name)) + (setq funcs (cdr funcs))) + (setq uninstanciated-fontset-alist + (cons (list new-name style name) uninstanciated-fontset-alist)) + (setq funcs-alist (cdr funcs-alist))))) + (if (and noerror (query-fontset name)) ;; Don't try to create an already existing fontset. nil @@ -382,6 +421,51 @@ signaled unless the optional 3rd argument NOERROR is non-nil." (setq fontset-alias-alist (cons (cons name alias) fontset-alias-alist)))))))) +(defun instanciate-fontset (fontset) + "Create a new fontset FONTSET if it is not yet instanciated. +Return FONTSET if it is created successfully, else return nil." + (let ((fontset-data (assoc fontset uninstanciated-fontset-alist))) + (if (null fontset-data) + nil + (let ((style (nth 1 fontset-data)) + (base-fontset (nth 2 fontset-data)) + (funcs-alist + '((bold x-make-font-bold) + (demibold x-make-font-demibold) + (italic x-make-font-italic) + (oblique x-make-font-oblique) + (bold-italic x-make-font-bold x-make-font-italic) + (demibold-italic x-make-font-demibold x-make-font-italic) + (bold-oblique x-make-font-bold x-make-font-oblique) + (demibold-oblique x-make-font-demibold x-make-font-oblique))) + ascii-font font font2 funcs) + (setq uninstanciated-fontset-alist + (delete fontset-data uninstanciated-fontset-alist)) + (setq fontset-data (assoc base-fontset global-fontset-alist)) + (setq ascii-font (cdr (assq 'ascii (cdr fontset-data)))) + (setq funcs (cdr (assq style funcs-alist))) + (if (= (length funcs) 1) + (and (setq font (funcall (car funcs) ascii-font)) + (setq font (x-resolve-font-name font 'default))) + (and (setq font (funcall (car funcs) ascii-font)) + (not (equal font ascii-font)) + (setq font2 (funcall (nth 1 funcs) font)) + (not (equal font2 font)) + (setq font (x-resolve-font-name font2 'default)))) + (when font + (let ((new-fontset-data (copy-alist fontset-data))) + (setq funcs (cdr (assq style funcs-alist))) + (while funcs + (setcar new-fontset-data + (funcall (car funcs) (car new-fontset-data))) + (let ((l (cdr new-fontset-data))) + (while l + (if (setq font (funcall (car funcs) (cdr (car l)))) + (setcdr (car l) font)) + (setq l (cdr l)))) + (setq funcs (cdr funcs))) + (new-fontset (car new-fontset-data) (cdr new-fontset-data)) + (car new-fontset-data))))))) ;; Create standard fontset from 16 dots fonts which are the most widely ;; installed fonts. Fonts for Chinese-GB, Korean, and Chinese-CNS are