Mercurial > emacs

comparison lisp/descr-text.el @ 97005:8e17e43e57e9

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
* descr-text.el (describe-char): Don't overwrite local variable char when describing characters with display-table entries. Display font backend when describing composed characters. Simplify: use `let' instead of `let*', and `or x y' instead of `if x x y'.
author Juanma Barranquero <lekktu@gmail.com>
date Fri, 25 Jul 2008 12:01:59 +0000
parents 79e210b5bd7b
children 15d4d10ad710
comparison
equal deleted inserted replaced
97004:1b8d15c8653f 97005:8e17e43e57e9
333 (defun describe-char-display (pos char) 333 (defun describe-char-display (pos char)
334 (if (display-graphic-p (selected-frame)) 334 (if (display-graphic-p (selected-frame))
335 (let ((char-font-info (internal-char-font pos char))) 335 (let ((char-font-info (internal-char-font pos char)))
336 (if char-font-info 336 (if char-font-info
337 (let ((type (font-get (car char-font-info) :type)) 337 (let ((type (font-get (car char-font-info) :type))
338 (name (font-xlfd-name (car char-font-info))) 338 (name (font-xlfd-name (car char-font-info)))
339 (code (cdr char-font-info))) 339 (code (cdr char-font-info)))
340 (if (integerp code) 340 (if (integerp code)
341 (format "%s:%s (#x%02X)" type name code) 341 (format "%s:%s (#x%02X)" type name code)
342 (format "%s:%s (#x%04X%04X)" 342 (format "%s:%s (#x%04X%04X)"
343 type name (car code) (cdr code)))))) 343 type name (car code) (cdr code))))))
459 ("display" 459 ("display"
460 ,(cond 460 ,(cond
461 (disp-vector 461 (disp-vector
462 (setq disp-vector (copy-sequence disp-vector)) 462 (setq disp-vector (copy-sequence disp-vector))
463 (dotimes (i (length disp-vector)) 463 (dotimes (i (length disp-vector))
464 (setq char (aref disp-vector i))
465 (aset disp-vector i 464 (aset disp-vector i
466 (cons char (describe-char-display 465 (cons (aref disp-vector i)
467 pos (glyph-char char))))) 466 (describe-char-display
467 pos (glyph-char (aref disp-vector i))))))
468 (format "by display table entry [%s] (see below)" 468 (format "by display table entry [%s] (see below)"
469 (mapconcat 469 (mapconcat
470 #'(lambda (x) 470 #'(lambda (x)
471 (format "?%c" (glyph-char (car x)))) 471 (format "?%c" (glyph-char (car x))))
472 disp-vector " "))) 472 disp-vector " ")))
542 542
543 (when overlays 543 (when overlays
544 (save-excursion 544 (save-excursion
545 (goto-char (point-min)) 545 (goto-char (point-min))
546 (re-search-forward "character:[ \t\n]+") 546 (re-search-forward "character:[ \t\n]+")
547 (let* ((end (+ (point) (length char-description)))) 547 (let ((end (+ (point) (length char-description))))
548 (mapc #'(lambda (props) 548 (mapc #'(lambda (props)
549 (let ((o (make-overlay (point) end))) 549 (let ((o (make-overlay (point) end)))
550 (while props 550 (while props
551 (overlay-put o (car props) (nth 1 props)) 551 (overlay-put o (car props) (nth 1 props))
552 (setq props (cddr props))))) 552 (setq props (cddr props)))))
559 (progn 559 (progn
560 (insert "these fonts (glyph codes):\n") 560 (insert "these fonts (glyph codes):\n")
561 (dotimes (i (length disp-vector)) 561 (dotimes (i (length disp-vector))
562 (insert (glyph-char (car (aref disp-vector i))) ?: 562 (insert (glyph-char (car (aref disp-vector i))) ?:
563 (propertize " " 'display '(space :align-to 5)) 563 (propertize " " 'display '(space :align-to 5))
564 (if (cdr (aref disp-vector i)) 564 (or (cdr (aref disp-vector i)) "-- no font --")
565 (cdr (aref disp-vector i))
566 "-- no font --")
567 "\n") 565 "\n")
568 (let ((face (glyph-face (car (aref disp-vector i))))) 566 (let ((face (glyph-face (car (aref disp-vector i)))))
569 (when face 567 (when face
570 (insert (propertize " " 'display '(space :align-to 5)) 568 (insert (propertize " " 'display '(space :align-to 5))
571 "face: ") 569 "face: ")
598 (mapconcat 'describe-char-padded-string 596 (mapconcat 'describe-char-padded-string
599 (cadr composition) "") 597 (cadr composition) "")
600 "\""))) 598 "\"")))
601 (if (and (vectorp (nth 2 composition)) 599 (if (and (vectorp (nth 2 composition))
602 (vectorp (aref (nth 2 composition) 0))) 600 (vectorp (aref (nth 2 composition) 0)))
603 (progn 601 (let ((font (aref (aref (nth 2 composition) 0) 0)))
604 (insert " using this font:\n " 602 (insert " using this font:\n "
605 (aref (query-font (aref (aref (nth 2 composition) 0) 0)) 603 (symbol-name (font-get font :type))
606 0) 604 ?:
605 (aref (query-font font) 0)
607 "\nby these glyphs:\n") 606 "\nby these glyphs:\n")
608 (mapc (lambda (x) (insert (format " %S\n" x))) 607 (mapc (lambda (x) (insert (format " %S\n" x)))
609 (nth 2 composition))) 608 (nth 2 composition)))
610 (insert " by the rule:\n\t(") 609 (insert " by the rule:\n\t(")
611 (let ((first t)) 610 (let ((first t))
612 (mapc (lambda (x) 611 (mapc (lambda (x)
613 (if first (setq first nil) 612 (if first (setq first nil)
614 (insert " ")) 613 (insert " "))
615 (if (consp x) (insert (format "%S" x)) 614 (if (consp x) (insert (format "%S" x))
616 (if (= x ?\t) (insert (single-key-description x)) 615 (if (= x ?\t) (insert (single-key-description x))
617 (insert ??) 616 (insert ??)
621 (if (display-graphic-p (selected-frame)) 620 (if (display-graphic-p (selected-frame))
622 (progn 621 (progn
623 (insert "these fonts (glyph codes):") 622 (insert "these fonts (glyph codes):")
624 (dolist (elt component-chars) 623 (dolist (elt component-chars)
625 (if (/= (car elt) ?\t) 624 (if (/= (car elt) ?\t)
626 (insert "\n " 625 (insert "\n "
627 (describe-char-padded-string (car elt)) 626 (describe-char-padded-string (car elt))
628 ?: 627 ?:
629 (propertize " " 'display '(space :align-to 5)) 628 (propertize " " 'display '(space :align-to 5))
630 (or (cdr elt) "-- no font --"))))) 629 (or (cdr elt) "-- no font --")))))
631 (insert "these terminal codes:") 630 (insert "these terminal codes:")