973 |
If optional arg PRINT-FONTS is non-nil, also print names of all opened |
If optional arg PRINT-FONTS is non-nil, also print names of all opened |
974 |
fonts for FONTSET. This function actually inserts the information in |
fonts for FONTSET. This function actually inserts the information in |
975 |
the current buffer." |
the current buffer." |
976 |
(let ((tail (aref (fontset-info fontset) 2)) |
(beginning-of-line) |
977 |
elt chars font-spec opened prev-charset charset from to) |
(insert "Fontset: " fontset "\n") |
978 |
(beginning-of-line) |
(insert "CHAR RANGE (CODE RANGE)\n") |
979 |
(insert "Fontset: " fontset "\n") |
(insert "-----------------------\n") |
980 |
(insert "CHARSET or CHAR RANGE") |
(insert " FONT NAME (REQUESTED and [OPENED])\n") |
981 |
(indent-to 24) |
(insert " ----------------------------------") |
982 |
(insert "FONT NAME\n") |
(describe-vector |
983 |
(insert "---------------------") |
(fontset-info fontset) |
984 |
(indent-to 24) |
#'(lambda (val) |
985 |
(insert "---------") |
;; VAL has this format: |
986 |
(insert "\n") |
;; ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...) |
987 |
(while tail |
|
988 |
(setq elt (car tail) tail (cdr tail)) |
;; CHAR RANGE is already inserted. Get character codes from |
989 |
(setq chars (car elt) font-spec (car (cdr elt)) opened (cdr (cdr elt))) |
;; the current line. |
990 |
(if (symbolp chars) |
(beginning-of-line) |
991 |
(setq charset chars from nil to nil) |
(let ((from (following-char)) |
992 |
(if (integerp chars) |
(to (if (looking-at "[^.]*[.]* ") |
993 |
(setq charset (char-charset chars) from chars to chars) |
(char-after (match-end 0))))) |
994 |
(setq charset (char-charset (car chars)) |
(if (re-search-forward "[ \t]*$" nil t) |
995 |
from (car chars) to (cdr chars)))) |
(delete-region (match-beginning 0) (match-end 0))) |
996 |
(unless (eq charset prev-charset) |
|
997 |
(insert (symbol-name charset)) |
;; For non-ASCII characters, insert also CODE RANGE. |
998 |
(if from |
(if (>= from 128) |
999 |
(insert "\n"))) |
(if to |
1000 |
(when from |
(insert (format "\t(#x%02X .. #x%02X)" from to)) |
1001 |
(let ((split (split-char from))) |
(insert (format "\t(#x%02X)" from)))) |
1002 |
(if (and (= (charset-dimension charset) 2) |
|
1003 |
(= (nth 2 split) 0)) |
;; Insert a requested font name. |
1004 |
(setq from |
(dolist (elt val) |
1005 |
(make-char charset (nth 1 split) |
(let ((requested (car elt))) |
1006 |
(if (= (charset-chars charset) 94) 33 32)))) |
(if (stringp requested) |
1007 |
(insert " " from)) |
(insert requested) |
1008 |
(when (/= from to) |
(let ((family (aref requested 0)) |
1009 |
(insert "-") |
(registry (aref requested 5))) |
1010 |
(let ((split (split-char to))) |
(if (not family) |
1011 |
(if (and (= (charset-dimension charset) 2) |
(setq family "*-*") |
1012 |
(= (nth 2 split) 0)) |
(or (string-match "-" family) |
1013 |
(setq to |
(setq family (concat "*-" family)))) |
1014 |
(make-char charset (nth 1 split) |
(or (string-match "-" registry) |
1015 |
(if (= (charset-chars charset) 94) 126 127)))) |
(= (aref registry (1- (length registry))) ?*) |
1016 |
(insert to)))) |
(setq registry (concat registry "*"))) |
1017 |
(indent-to 24) |
(insert "\n -" family |
1018 |
(cond ((stringp font-spec) |
?- (or (aref requested 1) ?*) ; weight |
1019 |
(insert font-spec)) |
?- (or (aref requested 2) ?*) ; slant |
1020 |
((vectorp font-spec) |
"-*-" (or (aref requested 3) ?*) ; width |
1021 |
(insert "*-" (or (aref font-spec 0) ?*) ; family |
"-*-" (or (aref requested 4) ?*) ; adstyle |
1022 |
?- (or (aref font-spec 1) ?*) ; weight |
"-*-*-*-*-*-*-" registry)))) |
1023 |
?- (or (aref font-spec 2) ?*) ; slant |
|
1024 |
"-*-" (or (aref font-spec 3) ?*) ; width |
;; Insert opened font names (if any). |
1025 |
"-*-" (or (aref font-spec 4) ?*) ; adstyle |
(dolist (opened (cdr elt)) |
1026 |
"-*-*-*-*-*-*-" (aref font-spec 5))) ; registry |
(insert "\n\t[" opened "]"))))))) |
|
(t |
|
|
(if (car font-spec) |
|
|
(if (string-match "-" (car font-spec)) |
|
|
(insert "-" (car font-spec) "-*-") |
|
|
(insert "-*-" (car font-spec) "-*-")) |
|
|
(insert "-*-")) |
|
|
(if (cdr font-spec) |
|
|
(if (string-match "-" (cdr font-spec)) |
|
|
(insert (cdr font-spec)) |
|
|
(insert (cdr font-spec) "-*")) |
|
|
(insert "*")))) |
|
|
(insert "\n") |
|
|
(when print-fonts |
|
|
(while opened |
|
|
(indent-to 5) |
|
|
(insert "[" (car opened) "]\n") |
|
|
(setq opened (cdr opened)))) |
|
|
(setq prev-charset charset) |
|
|
))) |
|
1027 |
|
|
1028 |
;;;###autoload |
;;;###autoload |
1029 |
(defun describe-fontset (fontset) |
(defun describe-fontset (fontset) |