comparison lisp/international/mule-diag.el @ 89713:dd442ee53657

(stretches-for-character-list): Delete it. (list-block-of-chars): Use tabs instead of `display' property for aligning characters. (print-fontset-element): Fix the printing of XLFD.

89712:37b673654269

				   nil t initial-input 'charset-history
				   default-value)))
    (if (> (length charset) 0)
	(intern charset))))

;; Vector of 16 space-only strings.  Nth string has display property
;; '(space :align-to COL) when COL is the column number to align the
;; Nth character in a row.  Used by `list-block-of-chars'.

(defconst stretches-for-character-list
  (let ((stretches (make-vector 16 nil)))
    (dotimes (i 16)
      (aset stretches i
	    (propertize " " 'display `(space :align-to ,(+ 6 (* i 4))))))
    stretches)
  "For internal use only.")

;; List characters of the range MIN and MAX of CHARSET.  If dimension
;; of CHARSET is two (i.e. 2-byte charset), ROW is the first byte
;; (block index) of the characters, and MIN and MAX are the second
;; bytes of the characters.  If the dimension is one, ROW should be 0.

(defun list-block-of-chars (charset row min max)
  (let (i ch)
    (insert-char ?- (+ 5 (* 4 16)))
    (insert "\n   ")
    (setq i 0)
    (while (< i 16)
      (insert (format "%4X" i))
      (setq i (1+ i)))
    (setq i (* (/ min 16) 16))
    (while (<= i max)
      (if (= (% i 16) 0)
	  (insert (format "\n%4Xx" (/ (+ (* row 256) i) 16))))
      (setq ch (if (< i min)
		   32
		 (or (decode-char charset (+ (* row 256) i))
		     32)))		; gap in mapping
      ;; Don't insert a control code.
      (if (or (< ch 32) (= ch 127))
	  (setq ch (single-key-description ch))
	(if (and (>= ch 128) (< ch 160))
	    (setq ch (format "%02Xh" ch))))
      (insert (aref stretches-for-character-list (% i 16)) ch)
      (setq i (1+ i))))
  (insert "\n"))

;;;###autoload
(defun list-charset-chars (charset)

      (let ((slot (memq 'mode-line-buffer-identification mode-line-format)))
	(if slot
	    (setcdr slot
		    (cons (format " (%s)" charset)
			  (cdr slot)))))
      (setq indent-tabs-mode nil)
      (set-buffer-multibyte t)
      (unless (charsetp charset)
	(error "Invalid character set %s" charset))
      (let ((dim (charset-dimension charset))
	    (chars (charset-chars charset))

		(= (aref registry (1- (length registry))) ?*)
		(setq registry (concat registry "*")))
	    (insert "\n    -" family
		    ?- (or (aref requested 1) ?*) ; weight
		    ?- (or (aref requested 2) ?*) ; slant
		    "-*-" (or (aref requested 3) ?*) ; width
		    "-*-" (or (aref requested 4) ?*) ; adstyle
		    "-*-*-*-*-*-*-" registry))))

      ;; Insert opened font names (if any).
      (if (and (boundp 'print-opened) (symbol-value 'print-opened))
	  (dolist (opened (cdr elt))

89713:dd442ee53657

				   nil t initial-input 'charset-history
				   default-value)))
    (if (> (length charset) 0)
	(intern charset))))

;; List characters of the range MIN and MAX of CHARSET.  If dimension
;; of CHARSET is two (i.e. 2-byte charset), ROW is the first byte
;; (block index) of the characters, and MIN and MAX are the second
;; bytes of the characters.  If the dimension is one, ROW should be 0.

(defun list-block-of-chars (charset row min max)
  (let (i ch)
    (insert-char ?- (+ 7 (* 4 16)))
    (insert "\n     ")
    (setq i 0)
    (while (< i 16)
      (insert (format "%4X" i))
      (setq i (1+ i)))
    (setq i (* (/ min 16) 16))
    (while (<= i max)
      (if (= (% i 16) 0)
	  (insert (format "\n%6Xx" (/ (+ (* row 256) i) 16))))
      (setq ch (if (< i min)
		   32
		 (or (decode-char charset (+ (* row 256) i))
		     32)))		; gap in mapping
      ;; Don't insert a control code.
      (if (or (< ch 32) (= ch 127))
	  (setq ch (single-key-description ch))
	(if (and (>= ch 128) (< ch 160))
	    (setq ch (format "%02Xh" ch))))
      (insert "\t" ch)
      (setq i (1+ i))))
  (insert "\n"))

;;;###autoload
(defun list-charset-chars (charset)

      (let ((slot (memq 'mode-line-buffer-identification mode-line-format)))
	(if slot
	    (setcdr slot
		    (cons (format " (%s)" charset)
			  (cdr slot)))))
      (setq tab-width 4)
      (set-buffer-multibyte t)
      (unless (charsetp charset)
	(error "Invalid character set %s" charset))
      (let ((dim (charset-dimension charset))
	    (chars (charset-chars charset))

		(= (aref registry (1- (length registry))) ?*)
		(setq registry (concat registry "*")))
	    (insert "\n    -" family
		    ?- (or (aref requested 1) ?*) ; weight
		    ?- (or (aref requested 2) ?*) ; slant
		    ?- (or (aref requested 3) ?*) ; width
		    ?- (or (aref requested 4) ?*) ; adstyle
		    "-*-*-*-*-*-*-" registry))))

      ;; Insert opened font names (if any).
      (if (and (boundp 'print-opened) (symbol-value 'print-opened))
	  (dolist (opened (cdr elt))