comparison lisp/descr-text.el @ 89483:2f877ed80fa6

*** empty log message ***
author Kenichi Handa <handa@m17n.org>
date Mon, 08 Sep 2003 12:53:41 +0000
parents 375f2633d815
children dbdc71c3c9f4
comparison
equal deleted inserted replaced
88123:375f2633d815 89483:2f877ed80fa6
450 (buffer (current-buffer)) 450 (buffer (current-buffer))
451 (composition (find-composition pos nil nil t)) 451 (composition (find-composition pos nil nil t))
452 (composed (if composition (buffer-substring (car composition) 452 (composed (if composition (buffer-substring (car composition)
453 (nth 1 composition)))) 453 (nth 1 composition))))
454 (multibyte-p enable-multibyte-characters) 454 (multibyte-p enable-multibyte-characters)
455 item-list max-width unicode) 455 item-list max-width)
456 (if (eq charset 'unknown) 456 (if (eq charset 'eight-bit)
457 (setq item-list 457 (setq item-list
458 `(("character" 458 `(("character"
459 ,(format "%s (0%o, %d, 0x%x) -- invalid character code" 459 ,(format "%s (0%o, %d, 0x%x) -- raw byte 0x%x"
460 (if (< char 256) 460 (char-to-string char) char char char
461 (single-key-description char) 461 (multibyte-char-to-unibyte char)))))
462 (char-to-string char)) 462
463 char char char))))
464
465 (if (or (< char 256)
466 (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos)))
467 (get-char-property pos 'untranslated-utf-8))
468 (setq unicode (or (get-char-property pos 'untranslated-utf-8)
469 (encode-char char 'ucs))))
470 (setq item-list 463 (setq item-list
471 `(("character" 464 `(("character"
472 ,(format "%s (0%o, %d, 0x%x%s)" (if (< char 256) 465 ,(format "%s (0%o, %d, 0x%x)" (if (< char 256)
473 (single-key-description char) 466 (single-key-description char)
474 (char-to-string char)) 467 (char-to-string char))
475 char char char 468 char char char))
476 (if unicode 469 ("preferred charset"
477 (format ", U+%04X" unicode)
478 "")))
479 ("charset"
480 ,(symbol-name charset) 470 ,(symbol-name charset)
481 ,(format "(%s)" (charset-description charset))) 471 ,(format "(%s)" (charset-description charset)))
482 ("code point" 472 ("code point"
483 ,(let ((split (split-char char))) 473 ,(let ((split (split-char char)))
484 (if (= (charset-dimension charset) 1) 474 (mapconcat #'number-to-string (cdr split) " ")))
485 (format "%d" (nth 1 split))
486 (format "%d %d" (nth 1 split) (nth 2 split)))))
487 ("syntax" 475 ("syntax"
488 ,(let ((syntax (syntax-after pos))) 476 ,(let ((syntax (syntax-after pos)))
489 (with-temp-buffer 477 (with-temp-buffer
490 (internal-describe-syntax-value syntax) 478 (internal-describe-syntax-value syntax)
491 (buffer-string)))) 479 (buffer-string))))
521 (let* ((coding (terminal-coding-system)) 509 (let* ((coding (terminal-coding-system))
522 (encoded (encode-coding-char char coding))) 510 (encoded (encode-coding-char char coding)))
523 (if encoded 511 (if encoded
524 (encoded-string-description encoded coding) 512 (encoded-string-description encoded coding)
525 "not encodable")))) 513 "not encodable"))))
526 ,@(let ((unicodedata (and unicode 514 ,@(let ((unicodedata (unicode-data char)))
527 (describe-char-unicode-data unicode))))
528 (if unicodedata 515 (if unicodedata
529 (cons (list "Unicode data" " ") unicodedata)))))) 516 (cons (list "Unicode data" " ") unicodedata))))))
530 (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x))) 517 (setq max-width (apply #'max (mapcar #'(lambda (x)
518 (if (cadr x)
519 (length (car x))
520 0))
531 item-list))) 521 item-list)))
532 (when (eq (current-buffer) (get-buffer "*Help*")) 522 (when (eq (current-buffer) (get-buffer "*Help*"))
533 (error "Can't describe char in Help buffer")) 523 (error "Can't describe char in Help buffer"))
534 (with-output-to-temp-buffer "*Help*" 524 (with-output-to-temp-buffer "*Help*"
535 (with-current-buffer standard-output 525 (with-current-buffer standard-output