218 |
;; Append Unicode fonts. |
;; Append Unicode fonts. |
219 |
;; This may find fonts with more variants (bold, italic) but which don't cover |
;; This may find fonts with more variants (bold, italic) but which don't cover |
220 |
;; many characters. |
;; many characters. |
221 |
(set-fontset-font "fontset-default" '(#x00A0 . #xFFFF) |
(set-fontset-font "fontset-default" '(0 . #xFFFF) |
222 |
'(nil . "iso10646-1") nil 'append) |
'(nil . "iso10646-1") nil 'append) |
223 |
;; These may find fonts that cover many characters but with fewer variants. |
;; These may find fonts that cover many characters but with fewer variants. |
224 |
(set-fontset-font "fontset-default" '(#x00A0 . #xFFFF) |
(set-fontset-font "fontset-default" '(0 . #xFFFF) |
225 |
'("gnu-unifont" . "iso10646-1") nil 'append) |
'("gnu-unifont" . "iso10646-1") nil 'append) |
226 |
(set-fontset-font "fontset-default" '(#x00A0 . #xFFFF) |
(set-fontset-font "fontset-default" '(0 . #xFFFF) |
227 |
'("mutt-clearlyu" . "iso10646-1") nil 'append) |
'("mutt-clearlyu" . "iso10646-1") nil 'append) |
228 |
|
|
229 |
;; These are the registered registries/encodings from |
;; These are the registered registries/encodings from |
408 |
)) |
)) |
409 |
|
|
410 |
(defun x-decompose-font-name (pattern) |
(defun x-decompose-font-name (pattern) |
411 |
"Decompose PATTERN into XLFD fields and return vector of the fields. |
"Decompose PATTERN into XLFD fields and return a vector of the fields. |
412 |
The length of the vector is 12. |
The length of the vector is 12. |
413 |
|
The FOUNDRY and FAMILY fields are concatinated and stored in the first |
414 |
If PATTERN doesn't conform to XLFD, try to get a full XLFD name from |
element of the vector. |
415 |
X server and use the information of the full name to decompose |
The REGISTRY and ENCODING fields are concatinated and stored in the last |
416 |
PATTERN. If no full XLFD name is gotten, return nil." |
element of the vector. |
417 |
(let (xlfd-fields fontname) |
|
418 |
(if (string-match xlfd-tight-regexp pattern) |
Return nil if PATTERN doesn't conform to XLFD." |
419 |
(progn |
(if (string-match xlfd-tight-regexp pattern) |
420 |
(setq xlfd-fields (make-vector 12 nil)) |
(let ((xlfd-fields (make-vector 12 nil))) |
421 |
(dotimes (i 12) |
(dotimes (i 12) |
422 |
(aset xlfd-fields i (match-string (1+ i) pattern))) |
(aset xlfd-fields i (match-string (1+ i) pattern))) |
423 |
(dotimes (i 12) |
(dotimes (i 12) |
424 |
(if (string-match "^[*-]+$" (aref xlfd-fields i)) |
(if (string-match "^[*-]+$" (aref xlfd-fields i)) |
425 |
(aset xlfd-fields i nil))) |
(aset xlfd-fields i nil))) |
426 |
xlfd-fields) |
xlfd-fields))) |
|
(setq fontname (condition-case nil |
|
|
(x-resolve-font-name pattern) |
|
|
(error))) |
|
|
(if (and fontname |
|
|
(string-match xlfd-tight-regexp fontname)) |
|
|
;; We get a full XLFD name. |
|
|
(let ((len (length pattern)) |
|
|
(i 0) |
|
|
l) |
|
|
;; Setup xlfd-fields by the full XLFD name. Each element |
|
|
;; should be a cons of matched index and matched string. |
|
|
(setq xlfd-fields (make-vector 12 nil)) |
|
|
(dotimes (i 12) |
|
|
(aset xlfd-fields i |
|
|
(cons (match-beginning (1+ i)) |
|
|
(match-string (1+ i) fontname)))) |
|
|
|
|
|
;; Replace wild cards in PATTERN by regexp codes. |
|
|
(setq i 0) |
|
|
(while (< i len) |
|
|
(let ((ch (aref pattern i))) |
|
|
(if (= ch ??) |
|
|
(setq pattern (concat (substring pattern 0 i) |
|
|
"\\(.\\)" |
|
|
(substring pattern (1+ i))) |
|
|
len (+ len 4) |
|
|
i (+ i 4)) |
|
|
(if (= ch ?*) |
|
|
(setq pattern (concat (substring pattern 0 i) |
|
|
"\\(.*\\)" |
|
|
(substring pattern (1+ i))) |
|
|
len (+ len 5) |
|
|
i (+ i 5)) |
|
|
(setq i (1+ i)))))) |
|
|
|
|
|
;; Set each element of xlfd-fields to proper strings. |
|
|
(if (string-match pattern fontname) |
|
|
;; The regular expression PATTERN matches the full XLFD |
|
|
;; name. Set elements that correspond to a wild card |
|
|
;; in PATTERN to nil, set the other elements to the |
|
|
;; exact strings in PATTERN. |
|
|
(let ((l (cdr (cdr (match-data))))) |
|
|
(setq i 0) |
|
|
(while (< i 12) |
|
|
(if (or (null l) (< (car (aref xlfd-fields i)) (car l))) |
|
|
(progn |
|
|
(aset xlfd-fields i (cdr (aref xlfd-fields i))) |
|
|
(setq i (1+ i))) |
|
|
(if (< (car (aref xlfd-fields i)) (car (cdr l))) |
|
|
(progn |
|
|
(aset xlfd-fields i nil) |
|
|
(setq i (1+ i))) |
|
|
(setq l (cdr (cdr l))))))) |
|
|
;; Set each element of xlfd-fields to the exact string |
|
|
;; in the corresponding fields in full XLFD name. |
|
|
(dotimes (i 12) |
|
|
(aset xlfd-fields i (cdr (aref xlfd-fields i))))) |
|
|
xlfd-fields))))) |
|
427 |
|
|
428 |
(defun x-compose-font-name (fields &optional reduce) |
(defun x-compose-font-name (fields &optional reduce) |
429 |
"Compose X fontname from FIELDS. |
"Compose X fontname from FIELDS. |
454 |
|
|
455 |
|
|
456 |
(defun x-complement-fontset-spec (xlfd-fields fontlist) |
(defun x-complement-fontset-spec (xlfd-fields fontlist) |
457 |
"Complement FONTLIST for charsets based on XLFD-FIELDS and return it. |
"Complement elements of FONTLIST based on XLFD-FIELDS. |
458 |
XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields. |
XLFD-FIELDS is a vector of XLFD (X Logical Font Description) fields. |
459 |
FONTLIST is an alist of charsets vs the corresponding font names. |
FONTLIST is an alist of script names vs the corresponding font names. |
|
|
|
|
The fonts are complemented as below. |
|
460 |
|
|
461 |
At first, if FONTLIST doesn't specify a font for ASCII charset, |
The font names are complemented as below. |
|
generate a font name for the charset from XLFD-FIELDS, and add that |
|
|
information to FONTLIST. |
|
|
|
|
|
Then, replace font names with the corresponding XLFD field vectors |
|
|
while substituting default field names for wild cards if they match |
|
|
`xlfd-style-regexp'. The default field names are decided by |
|
|
XLFD-FIELDS." |
|
|
(let* ((default-spec (vector (aref xlfd-fields xlfd-regexp-family-subnum) |
|
|
(aref xlfd-fields xlfd-regexp-weight-subnum) |
|
|
(aref xlfd-fields xlfd-regexp-slant-subnum) |
|
|
(aref xlfd-fields xlfd-regexp-swidth-subnum) |
|
|
(aref xlfd-fields xlfd-regexp-adstyle-subnum) |
|
|
(aref xlfd-fields xlfd-regexp-registry-subnum))) |
|
|
(slot (assq 'ascii fontlist)) |
|
|
(ascii-font (cadr slot)) |
|
|
xlfd-ascii) |
|
|
(if ascii-font |
|
|
(progn |
|
|
(setq ascii-font (x-resolve-font-name ascii-font)) |
|
|
(setcar (cdr slot) ascii-font) |
|
|
(setq xlfd-ascii (x-decompose-font-name ascii-font)) |
|
|
(dotimes (i 11) |
|
|
(or (aref xlfd-fields i) |
|
|
(aset xlfd-fields i (aref xlfd-ascii i))))) |
|
|
;; If font for ASCII is not specified, add it. |
|
|
(setq xlfd-ascii (copy-sequence xlfd-fields)) |
|
|
(aset xlfd-ascii xlfd-regexp-registry-subnum "iso8859-1") |
|
|
(setq ascii-font (x-must-resolve-font-name xlfd-ascii)) |
|
|
(setq fontlist (cons (list 'ascii ascii-font) fontlist))) |
|
462 |
|
|
463 |
|
If a font name matches `xlfd-style-regexp', each field of wild card is |
464 |
|
replaced by the corresponding fields in XLFD-FIELDS." |
465 |
|
(let ((default-spec (vector (aref xlfd-fields xlfd-regexp-family-subnum) |
466 |
|
(aref xlfd-fields xlfd-regexp-weight-subnum) |
467 |
|
(aref xlfd-fields xlfd-regexp-slant-subnum) |
468 |
|
(aref xlfd-fields xlfd-regexp-swidth-subnum) |
469 |
|
(aref xlfd-fields xlfd-regexp-adstyle-subnum) |
470 |
|
(aref xlfd-fields xlfd-regexp-registry-subnum)))) |
471 |
(dolist (elt fontlist) |
(dolist (elt fontlist) |
472 |
(let ((name (cadr elt)) |
(let ((name (cadr elt)) |
473 |
font-spec) |
font-spec) |
597 |
FONTSET-NAME,SCRIPT-NAME0:FONT-NAME0,SCRIPT-NAME1:FONT-NAME1, ... |
FONTSET-NAME,SCRIPT-NAME0:FONT-NAME0,SCRIPT-NAME1:FONT-NAME1, ... |
598 |
Any number of SPACE, TAB, and NEWLINE can be put before and after commas. |
Any number of SPACE, TAB, and NEWLINE can be put before and after commas. |
599 |
|
|
600 |
Optional 2nd argument is ignored. It exists just for backward |
When a frame uses the fontset as the `font' parameter, the frame's |
601 |
compatibility. |
default font name is derived from FONTSET-NAME by substituting |
602 |
|
\"iso8859-1\" for the tail part \"fontset-XXX\". But, if SCRIPT-NAMEn |
603 |
|
is \"ascii\", use the corresponding FONT-NAMEn as the default font |
604 |
|
name. |
605 |
|
|
606 |
If this function attempts to create already existing fontset, error is |
Optional 2nd and 3rd arguments are ignored. They exist just for |
607 |
signaled unless the optional 3rd argument NOERROR is non-nil. |
backward compatibility. |
608 |
|
|
609 |
It returns a name of the created fontset. |
It returns a name of the created fontset. |
610 |
|
|
611 |
For backward compatibility, SCRIPT-NAME may be a charset name, in |
For backward compatibility, SCRIPT-NAME may be a charset name, in |
612 |
which case, the corresponding script is decided by the variable |
which case, the corresponding script is decided by the variable |
613 |
`charset-script-alist' (which see)." |
`charset-script-alist' (which see)." |
614 |
(if (not (string-match "^[^,]+" fontset-spec)) |
(or (string-match "^[^,]+" fontset-spec) |
615 |
(error "Invalid fontset spec: %s" fontset-spec)) |
(error "Invalid fontset spec: %s" fontset-spec)) |
616 |
(let ((idx (match-end 0)) |
(let ((idx (match-end 0)) |
617 |
(name (match-string 0 fontset-spec)) |
(name (match-string 0 fontset-spec)) |
618 |
xlfd-fields script fontlist ascii-font) |
xlfd-fields script fontlist) |
619 |
(if (query-fontset name) |
(setq xlfd-fields (x-decompose-font-name name)) |
620 |
(or noerror |
(or xlfd-fields |
621 |
(error "Fontset \"%s\" already exists" name)) |
(error "Fontset name \"%s\" not conforming to XLFD" name)) |
622 |
(setq xlfd-fields (x-decompose-font-name name)) |
|
623 |
(or xlfd-fields |
;; At first, extract pairs of charset and fontname from FONTSET-SPEC. |
624 |
(error "Fontset \"%s\" not conforming to XLFD" name)) |
(while (string-match "[, \t\n]*\\([^:]+\\):\\([^,]+\\)" fontset-spec idx) |
625 |
|
(setq idx (match-end 0)) |
626 |
;; At first, extract pairs of charset and fontname from FONTSET-SPEC. |
(setq script (intern (match-string 1 fontset-spec))) |
627 |
(while (string-match "[, \t\n]*\\([^:]+\\):\\([^,]+\\)" fontset-spec idx) |
(if (or (eq script 'ascii) |
628 |
(setq idx (match-end 0)) |
(memq script (char-table-extra-slot char-script-table 0)) |
629 |
(setq script (intern (match-string 1 fontset-spec))) |
(setq script (cdr (assq script charset-script-alist)))) |
630 |
(if (or (memq script (char-table-extra-slot char-script-table 0)) |
(setq fontlist (cons (list script (match-string 2 fontset-spec)) |
631 |
(setq script (cdr (assq script charset-script-alist)))) |
fontlist)))) |
632 |
(setq fontlist (cons (list script (match-string 2 fontset-spec)) |
|
633 |
fontlist)))) |
;; Complement FONTLIST. |
634 |
(setq ascii-font (cadr (assq 'ascii fontlist))) |
(setq fontlist (x-complement-fontset-spec xlfd-fields fontlist)) |
|
|
|
|
;; Complement FONTLIST. |
|
|
(setq fontlist (x-complement-fontset-spec xlfd-fields fontlist)) |
|
|
(setq name (x-compose-font-name xlfd-fields)) |
|
|
(new-fontset name fontlist) |
|
|
|
|
|
;; Define the short name alias. |
|
|
(if (and (string-match "fontset-.*$" name) |
|
|
(not (assoc name fontset-alias-alist))) |
|
|
(let ((alias (match-string 0 name))) |
|
|
(or (rassoc alias fontset-alias-alist) |
|
|
(setq fontset-alias-alist |
|
|
(cons (cons name alias) fontset-alias-alist))))) |
|
|
|
|
|
;; Define the ASCII font name alias. |
|
|
(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) |
|
|
fontset-alias-alist)))) |
|
635 |
|
|
636 |
name)) |
;; Create a fontset. |
637 |
|
(new-fontset name fontlist))) |
638 |
|
|
639 |
(defun create-fontset-from-ascii-font (font &optional resolved-font |
(defun create-fontset-from-ascii-font (font &optional resolved-font |
640 |
fontset-name) |
fontset-name) |