/[emacs]/emacs/lisp/international/mule-diag.el
ViewVC logotype

Diff of /emacs/lisp/international/mule-diag.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.68.2.12 by fx, Mon Jul 1 20:41:34 2002 UTC revision 1.68.2.13 by handa, Fri Jul 26 04:03:50 2002 UTC
# Line 973  but still contains full information abou Line 973  but still contains full information abou
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)

Legend:
Removed from v.1.68.2.12  
changed lines
  Added in v.1.68.2.13

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26