3 |
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. |
;; Copyright (C) 1995 Electrotechnical Laboratory, JAPAN. |
4 |
;; Licensed to the Free Software Foundation. |
;; Licensed to the Free Software Foundation. |
5 |
;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. |
;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. |
6 |
|
;; Copyright (C) 2001, 2002 |
7 |
|
;; National Institute of Advanced Industrial Science and Technology (AIST) |
8 |
|
;; Registration Number H13PRO009 |
9 |
|
|
10 |
;; Keywords: multilingual, charset, coding system, fontset, diagnosis, i18n |
;; Keywords: multilingual, charset, coding system, fontset, diagnosis, i18n |
11 |
|
|
680 |
;; Print information of designation of each graphic register in FLAGS |
;; Print information of designation of each graphic register in FLAGS |
681 |
;; in human readable format. See the documentation of |
;; in human readable format. See the documentation of |
682 |
;; `make-coding-system' for the meaning of FLAGS. |
;; `make-coding-system' for the meaning of FLAGS. |
683 |
(defun print-designation (flags) |
(defun print-designation (charset-list initial request) |
684 |
(let ((graphic-register 0) |
(let ((gr (make-vector 4 nil)) |
685 |
charset) |
charset) |
686 |
(while (< graphic-register 4) |
(dotimes (i 4) |
687 |
|
(let ((val (aref initial i))) |
688 |
|
(cond ((symbolp val) |
689 |
|
(aset gr i (list val))) |
690 |
|
((eq val -1) |
691 |
|
(aset gr i (list t)))))) |
692 |
|
(dolist (elt request) |
693 |
|
(let ((reg (cdr elt))) |
694 |
|
(nconc (aref gr reg) (list (car elt))))) |
695 |
|
(dotimes (i 4) |
696 |
(setq charset (aref flags graphic-register)) |
(setq charset (aref flags graphic-register)) |
697 |
(princ (format |
(princ (format |
698 |
" G%d -- %s\n" |
" G%d -- %s\n" |
699 |
graphic-register |
i |
700 |
(cond ((null charset) |
(cond ((null charset) |
701 |
"never used") |
"never used") |
702 |
((eq charset t) |
((eq charset t) |
726 |
(setq charset (cdr charset)))) |
(setq charset (cdr charset)))) |
727 |
(setq graphic-register (1+ graphic-register))))) |
(setq graphic-register (1+ graphic-register))))) |
728 |
|
|
729 |
|
(defun print-iso-2022-flags (flags) |
730 |
|
(princ "Other specifications: \n ") |
731 |
|
(let ((i 0) |
732 |
|
(l nil)) |
733 |
|
(dolist (elt coding-system-iso-2022-flags) |
734 |
|
(if (/= (logand flags (lsh 1 i)) 0) |
735 |
|
(setq l (cons elt l)))) |
736 |
|
(princ l)) |
737 |
|
(terpri)) |
738 |
|
|
739 |
;;;###autoload |
;;;###autoload |
740 |
(defun describe-coding-system (coding-system) |
(defun describe-coding-system (coding-system) |
741 |
"Display information about CODING-SYSTEM." |
"Display information about CODING-SYSTEM." |
746 |
(interactive-p)) |
(interactive-p)) |
747 |
(with-output-to-temp-buffer (help-buffer) |
(with-output-to-temp-buffer (help-buffer) |
748 |
(print-coding-system-briefly coding-system 'doc-string) |
(print-coding-system-briefly coding-system 'doc-string) |
749 |
(princ "\n") |
(let* ((type (coding-system-type coding-system)) |
750 |
(let ((coding-spec (coding-system-spec coding-system))) |
(extra-spec (coding-system-extra-spec coding-system))) |
751 |
(princ "Type: ") |
(princ "Type: ") |
752 |
(let ((type (coding-system-type coding-system)) |
(princ type) |
753 |
(flags (coding-system-flags coding-system))) |
(cond ((eq type 'undecided) |
754 |
(princ type) |
(princ " (do automatic conversion)")) |
755 |
(cond ((eq type nil) |
((eq type 'utf-8) |
756 |
(princ " (do no conversion)")) |
(princ " (UTF-8: Emacs internal multibyte form)")) |
757 |
((eq type t) |
((eq type 'sjis) |
758 |
(princ " (do automatic conversion)")) |
(princ " (Shift-JIS, MS-KANJI)")) |
759 |
((eq type 0) |
((eq type 'iso-2022) |
760 |
(princ " (Emacs internal multibyte form)")) |
(princ " (variant of ISO-2022)\n") |
761 |
((eq type 1) |
(princ "Initial designations:\n") |
762 |
(princ " (Shift-JIS, MS-KANJI)")) |
(print-designation (coding-system-charset-list coding-system) |
763 |
((eq type 2) |
(aref extra-spec 0) (aref extra-spec 1)) |
764 |
(princ " (variant of ISO-2022)\n") |
(print-iso-2022-flags (aref extra-spec 2)) |
765 |
(princ "Initial designations:\n") |
(princ ".")) |
766 |
(print-designation flags) |
((eq type 'charset) |
767 |
(princ "Other Form: \n ") |
(princ " (charset)")) |
768 |
(princ (if (aref flags 4) "short-form" "long-form")) |
((eq type 'ccl) |
769 |
(if (aref flags 5) (princ ", ASCII@EOL")) |
(princ " (do conversion by CCL program)")) |
770 |
(if (aref flags 6) (princ ", ASCII@CNTL")) |
((eq type 'raw-text) |
771 |
(princ (if (aref flags 7) ", 7-bit" ", 8-bit")) |
(princ " (text with random binary characters)")) |
772 |
(if (aref flags 8) (princ ", use-locking-shift")) |
(t (princ ": invalid coding-system."))) |
|
(if (aref flags 9) (princ ", use-single-shift")) |
|
|
(if (aref flags 10) (princ ", use-roman")) |
|
|
(if (aref flags 11) (princ ", use-old-jis")) |
|
|
(if (aref flags 12) (princ ", no-ISO6429")) |
|
|
(if (aref flags 13) (princ ", init-bol")) |
|
|
(if (aref flags 14) (princ ", designation-bol")) |
|
|
(if (aref flags 15) (princ ", convert-unsafe")) |
|
|
(if (aref flags 16) (princ ", accept-latin-extra-code")) |
|
|
(princ ".")) |
|
|
((eq type 3) |
|
|
(princ " (Big5)")) |
|
|
((eq type 4) |
|
|
(princ " (do conversion by CCL program)")) |
|
|
((eq type 5) |
|
|
(princ " (text with random binary characters)")) |
|
|
(t (princ ": invalid coding-system.")))) |
|
773 |
(princ "\nEOL type: ") |
(princ "\nEOL type: ") |
774 |
(let ((eol-type (coding-system-eol-type coding-system))) |
(let ((eol-type (coding-system-eol-type coding-system))) |
775 |
(cond ((vectorp eol-type) |
(cond ((vectorp eol-type) |
908 |
|
|
909 |
(princ " |
(princ " |
910 |
Priority order for recognizing coding systems when reading files:\n") |
Priority order for recognizing coding systems when reading files:\n") |
911 |
(let ((l coding-category-list) |
(let ((i 1)) |
912 |
(i 1) |
(dolist (elt (coding-system-priority-list)) |
913 |
(coding-list nil) |
(princ (format " %d. %s " i elt)) |
914 |
coding aliases) |
(let ((aliases (coding-system-aliases elt))) |
915 |
(while l |
(if (eq elt (car aliases)) |
|
(setq coding (symbol-value (car l))) |
|
|
;; Do not list up the same coding system twice. |
|
|
(when (and coding (not (memq coding coding-list))) |
|
|
(setq coding-list (cons coding coding-list)) |
|
|
(princ (format " %d. %s " i coding)) |
|
|
(setq aliases (coding-system-get coding 'alias-coding-systems)) |
|
|
(if (eq coding (car aliases)) |
|
916 |
(if (cdr aliases) |
(if (cdr aliases) |
917 |
(princ (cons 'alias: (cdr aliases)))) |
(princ (cons 'alias: (cdr base-aliases)))) |
918 |
(if (memq coding aliases) |
(princ (list 'alias 'of (car aliases)))) |
|
(princ (list 'alias 'of (car aliases))))) |
|
919 |
(terpri) |
(terpri) |
920 |
(setq i (1+ i))) |
(setq i (1+ i))))) |
|
(setq l (cdr l)))) |
|
921 |
|
|
922 |
(princ "\n Other coding systems cannot be distinguished automatically |
(princ "\n Other coding systems cannot be distinguished automatically |
923 |
from these, and therefore cannot be recognized automatically |
from these, and therefore cannot be recognized automatically |
924 |
with the present coding system priorities.\n\n") |
with the present coding system priorities.\n\n") |
925 |
|
|
926 |
|
(if nil |
927 |
(let ((categories '(coding-category-iso-7 coding-category-iso-7-else)) |
(let ((categories '(coding-category-iso-7 coding-category-iso-7-else)) |
928 |
coding-system codings) |
coding-system codings) |
929 |
(while categories |
(while categories |
952 |
(goto-char (point-max))) |
(goto-char (point-max))) |
953 |
(setq codings (cdr codings))) |
(setq codings (cdr codings))) |
954 |
(insert "\n\n"))) |
(insert "\n\n"))) |
955 |
(setq categories (cdr categories)))) |
(setq categories (cdr categories))))) |
956 |
|
|
957 |
(princ "Particular coding systems specified for certain file names:\n") |
(princ "Particular coding systems specified for certain file names:\n") |
958 |
(terpri) |
(terpri) |