Mercurial > emacs

comparison lisp/international/mule-diag.el @ 88648:dd88ab5e7207

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(describe-current-coding-system): Fix aliases listing. (print-iso-2022-flags): Deleted. (print-designation): Partly re-written. (describe-coding-system): Deal with iso-2022 designations, flags. Fix shift_jis case. (describe-char-after): Use characterp. Print explicit unicode. Remove some obsolete code.
author Dave Love <fx@gnu.org>
date Sun, 26 May 2002 17:19:34 +0000
parents 10c911c19787
children ea446bb886ad
comparison
equal deleted inserted replaced
88647:dd842797ba84 88648:dd88ab5e7207
390 (composition (find-composition (point) nil nil t)) 390 (composition (find-composition (point) nil nil t))
391 (composed (if composition (buffer-substring (car composition) 391 (composed (if composition (buffer-substring (car composition)
392 (nth 1 composition)))) 392 (nth 1 composition))))
393 (multibyte-p enable-multibyte-characters) 393 (multibyte-p enable-multibyte-characters)
394 item-list max-width) 394 item-list max-width)
395 (if (eq charset 'unknown) 395 (if (not (characterp char))
396 (setq item-list 396 (setq item-list
397 `(("character" 397 `(("character"
398 ,(format "%s (0%o, %d, 0x%x) -- invalid character code" 398 ,(format "%s (0%o, %d, 0x%x) -- invalid character code"
399 (if (< char 256) 399 (char-to-string char) char char char))))
400 (single-key-description char)
401 (char-to-string char))
402 char char char))))
403 (setq item-list 400 (setq item-list
404 `(("character" 401 `(("character"
405 ,(format "%s (0%o, %d, 0x%x)" (if (< char 256) 402 ,(format "%s (0%o, %d, 0x%x%s)"
406 (single-key-description char) 403 (if (< char 256)
407 (char-to-string char)) 404 (single-key-description char)
408 char char char)) 405 (char-to-string char))
409 ("charset" 406 char char char
407 (if (encode-char char 'ucs)
408 (format ", U+%04X" (encode-char char 'ucs))
409 "")))
410 ("preferred charset"
410 ,(symbol-name charset) 411 ,(symbol-name charset)
411 ,(format "(%s)" (charset-description charset))) 412 ,(format "(%s)" (charset-description charset)))
412 ("code point" 413 ("code point"
413 ,(let ((split (split-char char))) 414 ,(let ((split (split-char char)))
414 (mapconcat #'number-to-string (cdr split) " "))) 415 (mapconcat #'number-to-string (cdr split) " ")))
445 ,@(let* ((coding buffer-file-coding-system) 446 ,@(let* ((coding buffer-file-coding-system)
446 (encoded (encode-coding-char char coding))) 447 (encoded (encode-coding-char char coding)))
447 (if encoded 448 (if encoded
448 (list (encoded-string-description encoded coding) 449 (list (encoded-string-description encoded coding)
449 (format "(encoded by coding system %S)" coding)) 450 (format "(encoded by coding system %S)" coding))
450 ;; Fixme: this is wrong e.g. for chars in HELLO
451 (list "not encodable by coding system" 451 (list "not encodable by coding system"
452 (symbol-name coding))))) 452 (symbol-name coding)))))
453 ,@(if (or (memq 'mule-utf-8
454 (find-coding-systems-region (point) (1+ (point))))
455 (get-char-property (point) 'untranslated-utf-8))
456 (let ((uc (or (get-char-property (point)
457 'untranslated-utf-8)
458 (encode-char (char-after) 'ucs))))
459 (if uc
460 (list (list "Unicode"
461 (format "%04X" uc))))))
462 ,(if (display-graphic-p (selected-frame)) 453 ,(if (display-graphic-p (selected-frame))
463 (list "font" (or (internal-char-font (point)) 454 (list "font" (or (internal-char-font (point))
464 "-- none --")) 455 "-- none --"))
465 (list "terminal code" 456 (list "terminal code"
466 (let* ((coding (terminal-coding-system)) 457 (let* ((coding (terminal-coding-system))
510 )))) 501 ))))
511 502
512 503
513 ;;; CODING-SYSTEM 504 ;;; CODING-SYSTEM
514 505
515 ;; Fixme 506 (eval-when-compile ; dynamic bondage
516 (defun print-designation (charset-list initial request) 507 (defvar graphic-register))
517 ;; Print information of designation of each graphic register in FLAGS 508
518 ;; in human readable format. See the documentation of 509 ;; Print information about designation of each graphic register in
519 ;; `make-coding-system' for the meaning of FLAGS. 510 ;; DESIGNATIONS in human readable format. See the documentation of
520 (let ((gr (make-vector 4 nil)) 511 ;; `define-coding-system' for the meaning of DESIGNATIONS
521 charset) 512 ;; (`:designation' property).
522 (dotimes (i 4) 513 (defun print-designation (designations)
523 (let ((val (aref initial i))) 514 (let (charset)
524 (cond ((symbolp val) 515 (dotimes (graphic-register 4)
525 (aset gr i (list val))) 516 (setq charset (aref designations graphic-register))
526 ((eq val -1)
527 (aset gr i (list t))))))
528 (dolist (elt request)
529 (let ((reg (cdr elt)))
530 (nconc (aref gr reg) (list (car elt)))))
531 (dotimes (i 4)
532 ;; Fixme:
533 (setq charset (aref flags graphic-register))
534 (princ (format 517 (princ (format
535 " G%d -- %s\n" 518 " G%d -- %s\n"
536 i 519 graphic-register
537 (cond ((null charset) 520 (cond ((null charset)
538 "never used") 521 "never used")
539 ((eq charset t) 522 ((eq charset t)
540 "no initial designation, and used by any charsets") 523 "no initial designation, and used by any charsets")
541 ((symbolp charset) 524 ((symbolp charset)
542 (format "%s:%s" 525 (format "%s:%s"
543 charset (charset-description charset))) 526 charset (charset-description charset)))
544 ((listp charset) 527 ((listp charset)
545 (if (charsetp (car charset)) 528 (if (charsetp (car charset))
546 (format "%s:%s, and also used by the followings:" 529 (format "%s:%s, and also used by the following:"
547 (car charset) 530 (car charset)
548 (charset-description (car charset))) 531 (charset-description (car charset)))
549 "no initial designation, and used by the followings:")) 532 "no initial designation, and used by the followings:"))
550 (t 533 (t
551 "invalid designation information")))) 534 "invalid designation information"))))
558 (princ (format "\t%s:%s\n" 541 (princ (format "\t%s:%s\n"
559 (car charset) 542 (car charset)
560 (charset-description (car charset))))) 543 (charset-description (car charset)))))
561 (t 544 (t
562 "invalid designation information")) 545 "invalid designation information"))
563 (setq charset (cdr charset)))) 546 (setq charset (cdr charset)))))))
564 (setq graphic-register (1+ graphic-register)))))
565
566 (defun print-iso-2022-flags (flags)
567 (princ "Other specifications: \n ")
568 (let ((i 0)
569 (l nil))
570 (dolist (elt coding-system-iso-2022-flags)
571 (if (/= (logand flags (lsh 1 i)) 0)
572 (setq l (cons elt l))))
573 (princ l))
574 (terpri))
575 547
576 ;;;###autoload 548 ;;;###autoload
577 (defun describe-coding-system (coding-system) 549 (defun describe-coding-system (coding-system)
578 "Display information about CODING-SYSTEM." 550 "Display information about CODING-SYSTEM."
579 (interactive "zDescribe coding system (default, current choices): ") 551 (interactive "zDescribe coding system (default, current choices): ")
590 (princ type) 562 (princ type)
591 (cond ((eq type 'undecided) 563 (cond ((eq type 'undecided)
592 (princ " (do automatic conversion)")) 564 (princ " (do automatic conversion)"))
593 ((eq type 'utf-8) 565 ((eq type 'utf-8)
594 (princ " (UTF-8: Emacs internal multibyte form)")) 566 (princ " (UTF-8: Emacs internal multibyte form)"))
595 ((eq type 'sjis) 567 ((eq type 'shift-jis)
596 (princ " (Shift-JIS, MS-KANJI)")) 568 (princ " (Shift-JIS, MS-KANJI)"))
597 ((eq type 'iso-2022) 569 ((eq type 'iso-2022)
598 (princ " (variant of ISO-2022)\n") 570 (princ " (variant of ISO-2022)\n")
599 ;; Fixme: 571 (princ "Initial designations:\n")
600 ;; (princ "Initial designations:\n") 572 (print-designation (coding-system-get coding-system
601 ;; (print-designation (coding-system-charset-list coding-system) 573 :designation))
602 ;; (aref extra-spec 0) (aref extra-spec 1)) 574
603 ;; (print-iso-2022-flags (aref extra-spec 2)) 575 (when (coding-system-get coding-system :flags)
604 ;; (princ ".") 576 (princ "Other specifications: \n ")
605 ) 577 (apply #'print-list
578 (coding-system-get coding-system :flags))))
606 ((eq type 'charset) 579 ((eq type 'charset)
607 (princ " (charset)")) 580 (princ " (charset)"))
608 ((eq type 'ccl) 581 ((eq type 'ccl)
609 (princ " (do conversion by CCL program)")) 582 (princ " (do conversion by CCL program)"))
610 ((eq type 'raw-text) 583 ((eq type 'raw-text)
756 (dolist (elt (coding-system-priority-list)) 729 (dolist (elt (coding-system-priority-list))
757 (princ (format " %d. %s " i elt)) 730 (princ (format " %d. %s " i elt))
758 (let ((aliases (coding-system-aliases elt))) 731 (let ((aliases (coding-system-aliases elt)))
759 (if (eq elt (car aliases)) 732 (if (eq elt (car aliases))
760 (if (cdr aliases) 733 (if (cdr aliases)
761 ;; Fixme: 734 (princ (cons 'alias: (cdr aliases))))
762 (princ (cons 'alias: (cdr base-aliases))))
763 (princ (list 'alias 'of (car aliases)))) 735 (princ (list 'alias 'of (car aliases))))
764 (terpri) 736 (terpri)
765 (setq i (1+ i))))) 737 (setq i (1+ i)))))
766 738
767 (princ "\n Other coding systems cannot be distinguished automatically 739 (princ "\n Other coding systems cannot be distinguished automatically