/[emacs]/emacs/lisp/international/mule-diag.el
ViewVC logotype

Diff of /emacs/lisp/international/mule-diag.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.68 by rms, Thu Feb 14 01:53:38 2002 UTC revision 1.68.2.1 by handa, Fri Mar 1 02:21:53 2002 UTC
# Line 3  Line 3 
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    
# Line 677  which font is being used for displaying Line 680  which font is being used for displaying
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)
# Line 714  which font is being used for displaying Line 726  which font is being used for displaying
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."
# Line 724  which font is being used for displaying Line 746  which font is being used for displaying
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)
# Line 902  in place of `..': Line 908  in place of `..':
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
# Line 954  Priority order for recognizing coding sy Line 952  Priority order for recognizing coding sy
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)

Legend:
Removed from v.1.68  
changed lines
  Added in v.1.68.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26