Function: print-fontset-element

print-fontset-element is a byte-compiled function defined in mule-diag.el.gz.

Signature

(print-fontset-element VAL)

Source Code

;; Defined in /usr/src/emacs/lisp/international/mule-diag.el.gz
(defun print-fontset-element (val)
  ;; VAL has this format:
  ;;  ((REQUESTED-FONT-NAME OPENED-FONT-NAME ...) ...)
  ;; CHAR RANGE is already inserted.  Get character codes from
  ;; the current line.
  (beginning-of-line)
  (let ((from (mule--kbd-at (point)))
	(to (if (looking-at "[^.]+[.][.] ")
		(mule--kbd-at (match-end 0)))))
    (if (re-search-forward "[ \t]*$" nil t)
	(delete-region (match-beginning 0) (match-end 0)))

    ;; For non-ASCII characters, insert also CODE RANGE.
    (if (or (>= from 128) (and to (>= to 128)))
	(if to
	    (insert (format " (#x%02X .. #x%02X)" from to))
	  (insert (format " (#x%02X)" from))))

    ;; Insert a requested font name.
    (dolist (elt val)
      (if (not elt)
	  (insert "\n    -- inhibit fallback fonts --")
	(let ((requested (car elt)))
	  (if (stringp requested)
	      (insert "\n    " requested)
	    (let (family registry weight slant width adstyle)
	      (if (and (fboundp 'fontp) (fontp requested))
		  (setq family (font-get requested :family)
			registry (font-get requested :registry)
			weight (font-get requested :weight)
			slant (font-get requested :slant)
			width (font-get requested :width)
			adstyle (font-get requested :adstyle))
		(setq family (aref requested 0)
		      registry (aref requested 5)
		      weight (aref requested 1)
		      slant (aref requested 2)
		      width (aref requested 3)
		      adstyle (aref requested 4)))
	      (if (not family)
		  (setq family "*-*")
		(if (symbolp family)
		    (setq family (symbol-name family)))
		(or (string-search "-" family)
		    (setq family (concat "*-" family))))
	      (if (not registry)
		  (setq registry "*-*")
		(if (symbolp registry)
		    (setq registry (symbol-name registry)))
		(or (string-search "-" registry)
		    (= (aref registry (1- (length registry))) ?*)
		    (setq registry (concat registry "*"))))
	      (insert (format"\n    -%s-%s-%s-%s-%s-*-*-*-*-*-*-%s"
			     family (or weight "*") (or slant "*") (or width "*")
			     (or adstyle "*") registry)))))

	;; Insert opened font names (if any).
	(if (bound-and-true-p mule--print-opened)
	    (dolist (opened (cdr elt))
	      (insert "\n\t[" opened "]")))))))