/[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.74 by walters, Sat Jun 8 22:44:00 2002 UTC revision 1.74.2.1 by miles, Fri Apr 4 06:20:22 2003 UTC
# Line 46  Line 46 
46  (defun sort-charset-list ()  (defun sort-charset-list ()
47    (setq charset-list    (setq charset-list
48          (sort charset-list          (sort charset-list
49                (function (lambda (x y) (< (charset-id x) (charset-id y)))))))                (lambda (x y) (< (charset-id x) (charset-id y))))))
50    
51  ;;; CHARSET  ;;; CHARSET
52    
# Line 61  Line 61 
61    'help-function #'list-charset-chars    'help-function #'list-charset-chars
62    'help-echo "mouse-2, RET: show table of characters for this character set")    'help-echo "mouse-2, RET: show table of characters for this character set")
63    
64    (defvar non-iso-charset-alist
65      `((mac-roman
66         (ascii latin-iso8859-1 mule-unicode-2500-33ff
67                mule-unicode-0100-24ff mule-unicode-e000-ffff)
68         mac-roman-decoder
69         ((0 255)))
70        (viscii
71         (ascii vietnamese-viscii-lower vietnamese-viscii-upper)
72         viet-viscii-nonascii-translation-table
73         ((0 255)))
74        (vietnamese-tcvn
75         (ascii vietnamese-viscii-lower vietnamese-viscii-upper)
76         viet-tcvn-nonascii-translation-table
77         ((0 255)))
78        (koi8-r
79         (ascii cyrillic-iso8859-5)
80         cyrillic-koi8-r-nonascii-translation-table
81         ((32 255)))
82        (alternativnyj
83         (ascii cyrillic-iso8859-5)
84         cyrillic-alternativnyj-nonascii-translation-table
85         ((32 255)))
86        (koi8-u
87         (ascii cyrillic-iso8859-5 mule-unicode-0100-24ff)
88         cyrillic-koi8-u-nonascii-translation-table
89         ((32 255)))
90        (big5
91         (ascii chinese-big5-1 chinese-big5-2)
92         decode-big5-char
93         ((32 127)
94          ((?\xA1 ?\xFE) . (?\x40 ?\x7E ?\xA1 ?\xFE))))
95        (sjis
96         (ascii katakana-jisx0201 japanese-jisx0208)
97         decode-sjis-char
98         ((32 127 ?\xA1 ?\xDF)
99          ((?\x81 ?\x9F ?\xE0 ?\xEF) . (?\x40 ?\x7E ?\x80 ?\xFC)))))
100      "Alist of charset names vs the corresponding information.
101    This is mis-named for historical reasons.  The charsets are actually
102    non-built-in ones.  They correspond to Emacs coding systems, not Emacs
103    charsets, i.e. what Emacs can read (or write) by mapping to (or
104    from) Emacs internal charsets that typically correspond to a limited
105    set of ISO charsets.
106    
107    Each element has the following format:
108      (CHARSET CHARSET-LIST TRANSLATION-METHOD [ CODE-RANGE ])
109    
110    CHARSET is the name (symbol) of the charset.
111    
112    CHARSET-LIST is a list of Emacs charsets into which characters of
113    CHARSET are mapped.
114    
115    TRANSLATION-METHOD is a translation table (symbol) to translate a
116    character code of CHARSET to the corresponding Emacs character
117    code.  It can also be a function to call with one argument, a
118    character code in CHARSET.
119    
120    CODE-RANGE specifies the valid code ranges of CHARSET.
121    It is a list of RANGEs, where each RANGE is of the form:
122      (FROM1 TO1 FROM2 TO2 ...)
123    or
124      ((FROM1-1 TO1-1 FROM1-2 TO1-2 ...) . (FROM2-1 TO2-1 FROM2-2 TO2-2 ...))
125    In the first form, valid codes are between FROM1 and TO1, or FROM2 and
126    TO2, or...
127    The second form is used for 2-byte codes.  The car part is the ranges
128    of the first byte, and the cdr part is the ranges of the second byte.")
129    
130  ;;;###autoload  ;;;###autoload
131  (defun list-character-sets (arg)  (defun list-character-sets (arg)
# Line 84  With prefix arg, the output format gets Line 149  With prefix arg, the output format gets
149  but still shows the full information."  but still shows the full information."
150    (interactive "P")    (interactive "P")
151    (help-setup-xref (list #'list-character-sets arg) (interactive-p))    (help-setup-xref (list #'list-character-sets arg) (interactive-p))
152    (with-output-to-temp-buffer (help-buffer)    (with-output-to-temp-buffer "*Character Set List*"
153      (with-current-buffer standard-output      (with-current-buffer standard-output
154        (if arg        (if arg
155            (list-character-sets-2)            (list-character-sets-2)
156          ;; Insert header.          ;; Insert header.
157            (insert "Indirectly supported character sets are shown below.\n")
158          (insert          (insert
159           (substitute-command-keys           (substitute-command-keys
160            (concat "Use "            (concat "Use "
# Line 117  but still shows the full information." Line 183  but still shows the full information."
183          (insert "------\t------------\t\t\t--------------\t- -- ----------\n")          (insert "------\t------------\t\t\t--------------\t- -- ----------\n")
184    
185          ;; Insert body sorted by charset IDs.          ;; Insert body sorted by charset IDs.
186          (list-character-sets-1 'id)))))          (list-character-sets-1 'id)
187    
188            ;; Insert non-directly-supported charsets.
189            (insert-char ?- 72)
190            (insert "\n\nINDIRECTLY SUPPORTED CHARSETS SETS:\n\n"
191                    (propertize "CHARSET NAME\tMAPPED TO" 'face 'bold)
192                    "\n------------\t---------\n")
193            (dolist (elt non-iso-charset-alist)
194              (insert-text-button (symbol-name (car elt))
195                                  :type 'list-charset-chars
196                                  'help-args (list (car elt)))
197              (indent-to 16)
198              (dolist (e (nth 1 elt))
199                (when (>= (+ (current-column) 1 (string-width (symbol-name e)))
200                          ;; This is an approximate value.  We don't know
201                          ;; the correct window width of this buffer yet.
202                          78)
203                  (insert "\n")
204                  (indent-to 16))
205    
206                (insert (format "%s " e)))
207              (insert "\n"))))))
208    
209  (defun sort-listed-character-sets (sort-key)  (defun sort-listed-character-sets (sort-key)
210    (if sort-key    (if sort-key
# Line 127  but still shows the full information." Line 214  but still shows the full information."
214            (goto-char (point-min))            (goto-char (point-min))
215            (re-search-forward "[0-9][0-9][0-9]")            (re-search-forward "[0-9][0-9][0-9]")
216            (beginning-of-line)            (beginning-of-line)
217            (delete-region (point) (point-max))            (let ((pos (point)))
218            (list-character-sets-1 sort-key)))))              (search-forward "----------")
219                (beginning-of-line)
220                (save-restriction
221                  (narrow-to-region pos (point))
222                  (delete-region (point-min) (point-max))
223                  (list-character-sets-1 sort-key)))))))
224    
225  (defun charset-multibyte-form-string (charset)  (defun charset-multibyte-form-string (charset)
226    (let ((info (charset-info charset)))    (let ((info (charset-info charset)))
# Line 175  but still shows the full information." Line 267  but still shows the full information."
267      ;; Determine a predicate for `sort' by SORT-KEY.      ;; Determine a predicate for `sort' by SORT-KEY.
268      (setq sort-func      (setq sort-func
269            (cond ((eq sort-key 'id)            (cond ((eq sort-key 'id)
270                   (function (lambda (x y) (< (car x) (car y)))))                   (lambda (x y) (< (car x) (car y))))
271    
272                  ((eq sort-key 'name)                  ((eq sort-key 'name)
273                   (function (lambda (x y) (string< (nth 1 x) (nth 1 y)))))                   (lambda (x y) (string< (nth 1 x) (nth 1 y))))
274    
275                  ((eq sort-key 'iso-spec)                  ((eq sort-key 'iso-spec)
276                   ;; Sort by DIMENSION CHARS FINAL-CHAR                   ;; Sort by DIMENSION CHARS FINAL-CHAR
277                   (function                   (lambda (x y)
278                    (lambda (x y)                     (or (< (nth 3 x) (nth 3 y))
279                      (or (< (nth 3 x) (nth 3 y))                         (and (= (nth 3 x) (nth 3 y))
280                          (and (= (nth 3 x) (nth 3 y))                              (or (< (nth 4 x) (nth 4 y))
281                               (or (< (nth 4 x) (nth 4 y))                                  (and (= (nth 4 x) (nth 4 y))
282                                   (and (= (nth 4 x) (nth 4 y))                                       (< (nth 5 x) (nth 5 y))))))))
                                       (< (nth 5 x) (nth 5 y)))))))))  
283                  (t                  (t
284                   (error "Invalid charset sort key: %s" sort-key))))                   (error "Invalid charset sort key: %s" sort-key))))
285    
# Line 248  but still shows the full information." Line 339  but still shows the full information."
339                       (charset-iso-graphic-plane charset)                       (charset-iso-graphic-plane charset)
340                       (charset-description charset))))))                       (charset-description charset))))))
341    
 (defvar non-iso-charset-alist  
   `((mac-roman  
      nil  
      mac-roman-decoder  
      ((0 255)))  
     (viscii  
      (ascii vietnamese-viscii-lower vietnamese-viscii-upper)  
      viet-viscii-nonascii-translation-table  
      ((0 255)))  
     (koi8-r  
      (ascii cyrillic-iso8859-5)  
      cyrillic-koi8-r-nonascii-translation-table  
      ((32 255)))  
     (alternativnyj  
      (ascii cyrillic-iso8859-5)  
      cyrillic-alternativnyj-nonascii-translation-table  
      ((32 255)))  
     (big5  
      (ascii chinese-big5-1 chinese-big5-2)  
      decode-big5-char  
      ((32 127)  
       ((?\xA1 ?\xFE) . (?\x40 ?\x7E ?\xA1 ?\xFE))))  
     (sjis  
      (ascii katakana-jisx0201 japanese-jisx0208)  
      decode-sjis-char  
      ((32 127 ?\xA1 ?\xDF)  
       ((?\x81 ?\x9F ?\xE0 ?\xEF) . (?\x40 ?\x7E ?\x80 ?\xFC)))))  
   "Alist of charset names vs the corresponding information.  
 This is mis-named for historical reasons.  The charsets are actually  
 non-built-in ones.  They correspond to Emacs coding systems, not Emacs  
 charsets, i.e. what Emacs can read (or write) by mapping to (or  
 from) Emacs internal charsets that typically correspond to a limited  
 set of ISO charsets.  
   
 Each element has the following format:  
   (CHARSET CHARSET-LIST TRANSLATION-METHOD [ CODE-RANGE ])  
   
 CHARSET is the name (symbol) of the charset.  
   
 CHARSET-LIST is a list of Emacs charsets into which characters of  
 CHARSET are mapped.  
   
 TRANSLATION-METHOD is a translation table (symbol) to translate a  
 character code of CHARSET to the corresponding Emacs character  
 code.  It can also be a function to call with one argument, a  
 character code in CHARSET.  
   
 CODE-RANGE specifies the valid code ranges of CHARSET.  
 It is a list of RANGEs, where each RANGE is of the form:  
   (FROM1 TO1 FROM2 TO2 ...)  
 or  
   ((FROM1-1 TO1-1 FROM1-2 TO1-2 ...) . (FROM2-1 TO2-1 FROM2-2 TO2-2 ...))  
 In the first form, valid codes are between FROM1 and TO1, or FROM2 and  
 TO2, or...  
 The second form is used for 2-byte codes.  The car part is the ranges  
 of the first byte, and the cdr part is the ranges of the second byte.")  
   
   
342  (defun decode-codepage-char (codepage code)  (defun decode-codepage-char (codepage code)
343    "Decode a character that has code CODE in CODEPAGE.    "Decode a character that has code CODE in CODEPAGE.
344  Return a decoded character string.  Each CODEPAGE corresponds to a  Return a decoded character string.  Each CODEPAGE corresponds to a
# Line 353  DEFAULT-VALUE, if non-nil, is the defaul Line 386  DEFAULT-VALUE, if non-nil, is the defaul
386  INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially.  INITIAL-INPUT, if non-nil, is a string inserted in the minibuffer initially.
387  See the documentation of the function `completing-read' for the  See the documentation of the function `completing-read' for the
388  detailed meanings of these arguments."  detailed meanings of these arguments."
389    (let* ((table (append (mapcar (function (lambda (x) (list (symbol-name x))))    (let* ((table (append (mapcar (lambda (x) (list (symbol-name x)))
390                                  charset-list)                                  charset-list)
391                          (mapcar (function (lambda (x)                          (mapcar (lambda (x) (list (symbol-name (car x))))
                                             (list (symbol-name (car x)))))  
392                                  non-iso-charset-alist)))                                  non-iso-charset-alist)))
393           (charset (completing-read prompt table           (charset (completing-read prompt table
394                                     nil t initial-input 'charset-history                                     nil t initial-input 'charset-history
# Line 489  This can list both Emacs `official' (ISO Line 521  This can list both Emacs `official' (ISO
521  characters encoded by various Emacs coding systems which correspond to  characters encoded by various Emacs coding systems which correspond to
522  PC `codepages' and other coded character sets.  See `non-iso-charset-alist'."  PC `codepages' and other coded character sets.  See `non-iso-charset-alist'."
523    (interactive (list (read-charset "Character set: ")))    (interactive (list (read-charset "Character set: ")))
524    (with-output-to-temp-buffer "*Help*"    (with-output-to-temp-buffer "*Character List*"
525      (with-current-buffer standard-output      (with-current-buffer standard-output
526          (setq mode-line-format (copy-sequence mode-line-format))
527          (let ((slot (memq 'mode-line-buffer-identification mode-line-format)))
528            (if slot
529                (setcdr slot
530                        (cons (format " (%s)" charset)
531                              (cdr slot)))))
532        (setq indent-tabs-mode nil)        (setq indent-tabs-mode nil)
533        (set-buffer-multibyte t)        (set-buffer-multibyte t)
534        (cond ((charsetp charset)        (cond ((charsetp charset)
# Line 532  PC `codepages' and other coded character Line 570  PC `codepages' and other coded character
570              (insert (format "Preferred coding system: %s\n" coding))              (insert (format "Preferred coding system: %s\n" coding))
571              (search-backward (symbol-name coding))              (search-backward (symbol-name coding))
572              (help-xref-button 0 'help-coding-system coding)))))))              (help-xref-button 0 'help-coding-system coding)))))))
   
 ;;;###autoload  
 (defun describe-char-after (&optional pos)  
   "Display information about the character at POS in the current buffer.  
 POS defaults to point.  
 The information includes character code, charset and code points in it,  
 syntax, category, how the character is encoded in a file,  
 which font is being used for displaying the character."  
   (interactive)  
   (or pos  
       (setq pos (point)))  
   (if (>= pos (point-max))  
       (error "No character at point"))  
   (let* ((char (char-after pos))  
          (charset (char-charset char))  
          (props (text-properties-at pos))  
          (composition (find-composition (point) nil nil t))  
          (composed (if composition (buffer-substring (car composition)  
                                                      (nth 1 composition))))  
          (multibyte-p enable-multibyte-characters)  
          item-list max-width)  
     (if (eq charset 'unknown)  
         (setq item-list  
               `(("character"  
                  ,(format "%s (0%o, %d, 0x%x) -- invalid character code"  
                           (if (< char 256)  
                               (single-key-description char)  
                             (char-to-string char))  
                           char char char))))  
       (setq item-list  
             `(("character"  
                ,(format "%s (0%o, %d, 0x%x)" (if (< char 256)  
                                                  (single-key-description char)  
                                                (char-to-string char))  
                         char char char))  
               ("charset"  
                ,(symbol-name charset)  
                ,(format "(%s)" (charset-description charset)))  
               ("code point"  
                ,(let ((split (split-char char)))  
                   (if (= (charset-dimension charset) 1)  
                       (format "%d" (nth 1 split))  
                     (format "%d %d" (nth 1 split) (nth 2 split)))))  
               ("syntax"  
                ,(let ((syntax (get-char-property (point) 'syntax-table)))  
                   (with-temp-buffer  
                     (internal-describe-syntax-value  
                      (if (consp syntax) syntax  
                        (aref (or syntax (syntax-table)) char)))  
                     (buffer-string))))  
               ("category"  
                ,@(let ((category-set (char-category-set char)))  
                    (if (not category-set)  
                        '("-- none --")  
                      (mapcar #'(lambda (x) (format "%c:%s  "  
                                                    x (category-docstring x)))  
                              (category-set-mnemonics category-set)))))  
               ,@(let ((props (aref char-code-property-table char))  
                       ps)  
                   (when props  
                     (while props  
                       (push (format "%s:" (pop props)) ps)  
                       (push (format "%s;" (pop props)) ps))  
                     (list (cons "Properties" (nreverse ps)))))  
               ("buffer code"  
                ,(encoded-string-description  
                  (string-as-unibyte (char-to-string char)) nil))  
               ("file code"  
                ,@(let* ((coding buffer-file-coding-system)  
                         (encoded (encode-coding-char char coding)))  
                    (if encoded  
                        (list (encoded-string-description encoded coding)  
                              (format "(encoded by coding system %S)" coding))  
                      (list "not encodable by coding system"  
                            (symbol-name coding)))))  
               ,@(if (or (memq 'mule-utf-8  
                           (find-coding-systems-region (point) (1+ (point))))  
                         (get-char-property (point) 'untranslated-utf-8))  
                     (let ((uc (or (get-char-property (point)  
                                                      'untranslated-utf-8)  
                                   (encode-char (char-after) 'ucs))))  
                       (if uc  
                           (list (list "Unicode"  
                                       (format "%04X" uc))))))  
               ,(if (display-graphic-p (selected-frame))  
                    (list "font" (or (internal-char-font (point))  
                                     "-- none --"))  
                  (list "terminal code"  
                        (let* ((coding (terminal-coding-system))  
                               (encoded (encode-coding-char char coding)))  
                          (if encoded  
                              (encoded-string-description encoded coding)  
                            "not encodable")))))))  
     (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))  
                                          item-list)))  
     (with-output-to-temp-buffer "*Help*"  
       (save-excursion  
         (set-buffer standard-output)  
         (set-buffer-multibyte multibyte-p)  
         (let ((formatter (format "%%%ds:" max-width)))  
           (dolist (elt item-list)  
             (insert (format formatter (car elt)))  
             (dolist (clm (cdr elt))  
               (when (>= (+ (current-column)  
                            (or (string-match "\n" clm)  
                                (string-width clm)) 1)  
                         (frame-width))  
                 (insert "\n")  
                 (indent-to (1+ max-width)))  
               (insert " " clm))  
             (insert "\n")))  
         (when composition  
           (insert "\nComposed with the following character(s) "  
                   (mapconcat (lambda (x) (format "`%c'" x))  
                              (substring composed 1)  
                              ", ")  
                   " to form `" composed "'")  
           (if (nth 3 composition)  
               (insert ".\n")  
             (insert "\nby the rule ("  
                     (mapconcat (lambda (x)  
                                  (format (if (consp x) "%S" "?%c") x))  
                                (nth 2 composition)  
                                " ")  
                     ").\n"  
                     "See the variable `reference-point-alist' for "  
                     "the meaning of the rule.\n")))  
         (when props  
           (insert "\nText properties\n")  
           (require 'descr-text)  
           (describe-text-properties props))))))  
   
573    
574  ;;; CODING-SYSTEM  ;;; CODING-SYSTEM
575    
# Line 718  which font is being used for displaying Line 624  which font is being used for displaying
624      (with-output-to-temp-buffer (help-buffer)      (with-output-to-temp-buffer (help-buffer)
625        (print-coding-system-briefly coding-system 'doc-string)        (print-coding-system-briefly coding-system 'doc-string)
626        (princ "\n")        (princ "\n")
627        (let ((coding-spec (coding-system-spec coding-system)))        (let ((vars (coding-system-get coding-system 'dependency)))
628          (princ "Type: ")          (when vars
629          (let ((type (coding-system-type coding-system))            (princ "See also the documentation of these customizable variables
630                (flags (coding-system-flags coding-system)))  which alter the behaviour of this coding system.\n")
631            (princ type)            (dolist (v vars)
632            (cond ((eq type nil)              (princ "  `")
633                   (princ " (do no conversion)"))              (princ v)
634                  ((eq type t)              (princ "'\n"))
635                   (princ " (do automatic conversion)"))            (princ "\n")))
636                  ((eq type 0)  
637                   (princ " (Emacs internal multibyte form)"))        (princ "Type: ")
638                  ((eq type 1)        (let ((type (coding-system-type coding-system))
639                   (princ " (Shift-JIS, MS-KANJI)"))              (flags (coding-system-flags coding-system)))
640                  ((eq type 2)          (princ type)
641                   (princ " (variant of ISO-2022)\n")          (cond ((eq type nil)
642                   (princ "Initial designations:\n")                 (princ " (do no conversion)"))
643                   (print-designation flags)                ((eq type t)
644                   (princ "Other Form: \n  ")                 (princ " (do automatic conversion)"))
645                   (princ (if (aref flags 4) "short-form" "long-form"))                ((eq type 0)
646                   (if (aref flags 5) (princ ", ASCII@EOL"))                 (princ " (Emacs internal multibyte form)"))
647                   (if (aref flags 6) (princ ", ASCII@CNTL"))                ((eq type 1)
648                   (princ (if (aref flags 7) ", 7-bit" ", 8-bit"))                 (princ " (Shift-JIS, MS-KANJI)"))
649                   (if (aref flags 8) (princ ", use-locking-shift"))                ((eq type 2)
650                   (if (aref flags 9) (princ ", use-single-shift"))                 (princ " (variant of ISO-2022)\n")
651                   (if (aref flags 10) (princ ", use-roman"))                 (princ "Initial designations:\n")
652                   (if (aref flags 11) (princ ", use-old-jis"))                 (print-designation flags)
653                   (if (aref flags 12) (princ ", no-ISO6429"))                 (princ "Other Form: \n  ")
654                   (if (aref flags 13) (princ ", init-bol"))                 (princ (if (aref flags 4) "short-form" "long-form"))
655                   (if (aref flags 14) (princ ", designation-bol"))                 (if (aref flags 5) (princ ", ASCII@EOL"))
656                   (if (aref flags 15) (princ ", convert-unsafe"))                 (if (aref flags 6) (princ ", ASCII@CNTL"))
657                   (if (aref flags 16) (princ ", accept-latin-extra-code"))                 (princ (if (aref flags 7) ", 7-bit" ", 8-bit"))
658                   (princ "."))                 (if (aref flags 8) (princ ", use-locking-shift"))
659                  ((eq type 3)                 (if (aref flags 9) (princ ", use-single-shift"))
660                   (princ " (Big5)"))                 (if (aref flags 10) (princ ", use-roman"))
661                  ((eq type 4)                 (if (aref flags 11) (princ ", use-old-jis"))
662                   (princ " (do conversion by CCL program)"))                 (if (aref flags 12) (princ ", no-ISO6429"))
663                  ((eq type 5)                 (if (aref flags 13) (princ ", init-bol"))
664                   (princ " (text with random binary characters)"))                 (if (aref flags 14) (princ ", designation-bol"))
665                  (t (princ ": invalid coding-system."))))                 (if (aref flags 15) (princ ", convert-unsafe"))
666          (princ "\nEOL type: ")                 (if (aref flags 16) (princ ", accept-latin-extra-code"))
667          (let ((eol-type (coding-system-eol-type coding-system)))                 (princ "."))
668            (cond ((vectorp eol-type)                ((eq type 3)
669                   (princ "Automatic selection from:\n\t")                 (princ " (Big5)"))
670                   (princ eol-type)                ((eq type 4)
671                   (princ "\n"))                 (princ " (do conversion by CCL program)"))
672                  ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))                ((eq type 5)
673                  ((eq eol-type 1) (princ "CRLF\n"))                 (princ " (text with random binary characters)"))
674                  ((eq eol-type 2) (princ "CR\n"))                (t (princ ": invalid coding-system."))))
675                  (t (princ "invalid\n")))))        (princ "\nEOL type: ")
676          (let ((eol-type (coding-system-eol-type coding-system)))
677            (cond ((vectorp eol-type)
678                   (princ "Automatic selection from:\n\t")
679                   (princ eol-type)
680                   (princ "\n"))
681                  ((or (null eol-type) (eq eol-type 0)) (princ "LF\n"))
682                  ((eq eol-type 1) (princ "CRLF\n"))
683                  ((eq eol-type 2) (princ "CR\n"))
684                  (t (princ "invalid\n"))))
685        (let ((postread (coding-system-get coding-system 'post-read-conversion)))        (let ((postread (coding-system-get coding-system 'post-read-conversion)))
686          (when postread          (when postread
687            (princ "After decoding text normally,")            (princ "After decoding text normally,")
# Line 852  in place of `..': Line 767  in place of `..':
767                     (coding-system-mnemonic coding-system)                     (coding-system-mnemonic coding-system)
768                     coding-system))                     coding-system))
769      (let ((aliases (coding-system-get coding-system 'alias-coding-systems)))      (let ((aliases (coding-system-get coding-system 'alias-coding-systems)))
770        (if (eq coding-system (car aliases))        (cond ((eq coding-system (car aliases))
771            (if (cdr aliases)               (if (cdr aliases)
772                (princ (format " %S" (cons 'alias: (cdr aliases)))))                   (princ (format " %S" (cons 'alias: (cdr aliases))))))
773          (if (memq coding-system aliases)              ((memq coding-system aliases)
774              (princ (format " (alias of %s)" (car aliases))))))               (princ (format " (alias of %s)" (car aliases))))
775                (t
776                 (let ((eol-type (coding-system-eol-type coding-system))
777                       (base-eol-type (coding-system-eol-type (car aliases))))
778                   (if (and (integerp eol-type)
779                            (vectorp base-eol-type)
780                            (not (eq coding-system (aref base-eol-type eol-type))))
781                       (princ (format " (alias of %s)"
782                                      (aref base-eol-type eol-type))))))))
783      (princ "\n\n")      (princ "\n\n")
784      (if (and doc-string      (if (and doc-string
785               (setq doc-string (coding-system-doc-string coding-system)))               (setq doc-string (coding-system-doc-string coding-system)))
# Line 924  Priority order for recognizing coding sy Line 847  Priority order for recognizing coding sy
847          (while categories          (while categories
848            (setq coding-system (symbol-value (car categories)))            (setq coding-system (symbol-value (car categories)))
849            (mapcar            (mapcar
850             (function             (lambda (x)
851              (lambda (x)               (if (and (not (eq x coding-system))
852                (if (and (not (eq x coding-system))                        (coding-system-get x 'no-initial-designation)
853                         (coding-system-get x 'no-initial-designation)                        (let ((flags (coding-system-flags x)))
854                         (let ((flags (coding-system-flags x)))                          (not (or (aref flags 10) (aref flags 11)))))
855                           (not (or (aref flags 10) (aref flags 11)))))                   (setq codings (cons x codings))))
                   (setq codings (cons x codings)))))  
856             (get (car categories) 'coding-systems))             (get (car categories) 'coding-systems))
857            (if codings            (if codings
858                (let ((max-col (frame-width))                (let ((max-col (frame-width))
# Line 1135  but still contains full information abou Line 1057  but still contains full information abou
1057    
1058  (defun print-fontset (fontset &optional print-fonts)  (defun print-fontset (fontset &optional print-fonts)
1059    "Print information about FONTSET.    "Print information about FONTSET.
1060    If FONTSET is nil, print information about the default fontset.
1061  If optional arg PRINT-FONTS is non-nil, also print names of all opened  If optional arg PRINT-FONTS is non-nil, also print names of all opened
1062  fonts for FONTSET.  This function actually inserts the information in  fonts for FONTSET.  This function actually inserts the information in
1063  the current buffer."  the current buffer."
1064      (or fontset
1065          (setq fontset (query-fontset "fontset-default")))
1066    (let ((tail (aref (fontset-info fontset) 2))    (let ((tail (aref (fontset-info fontset) 2))
1067          elt chars font-spec opened prev-charset charset from to)          elt chars font-spec opened prev-charset charset from to)
1068      (beginning-of-line)      (beginning-of-line)
# Line 1209  This shows which font is used for which Line 1134  This shows which font is used for which
1134     (if (not (and window-system (fboundp 'fontset-list)))     (if (not (and window-system (fboundp 'fontset-list)))
1135         (error "No fontsets being used")         (error "No fontsets being used")
1136       (let ((fontset-list (nconc       (let ((fontset-list (nconc
1137                            (mapcar 'list (fontset-list))                            (fontset-list)
1138                            (mapcar (lambda (x) (list (cdr x)))                            (mapcar 'cdr fontset-alias-alist)))
                                   fontset-alias-alist)))  
1139             (completion-ignore-case t))             (completion-ignore-case t))
1140         (list (completing-read         (list (completing-read
1141                "Fontset (default, used by the current frame): "                "Fontset (default, used by the current frame): "
1142                fontset-list nil t)))))                fontset-list nil t)))))
1143    (if (= (length fontset) 0)    (if (= (length fontset) 0)
1144        (setq fontset (cdr (assq 'font (frame-parameters)))))        (setq fontset (frame-parameter nil 'font)))
1145    (if (not (setq fontset (query-fontset fontset)))    (setq fontset (query-fontset fontset))
       (error "Current frame is using font, not fontset"))  
1146    (help-setup-xref (list #'describe-fontset fontset) (interactive-p))    (help-setup-xref (list #'describe-fontset fontset) (interactive-p))
1147    (with-output-to-temp-buffer (help-buffer)    (with-output-to-temp-buffer (help-buffer)
1148      (with-current-buffer standard-output      (with-current-buffer standard-output
# Line 1240  see the function `describe-fontset' for Line 1163  see the function `describe-fontset' for
1163          ;; This code is duplicated near the end of mule-diag.          ;; This code is duplicated near the end of mule-diag.
1164          (let ((fontsets          (let ((fontsets
1165                 (sort (fontset-list)                 (sort (fontset-list)
1166                       (function (lambda (x y)                       (lambda (x y)
1167                                   (string< (fontset-plain-name x)                         (string< (fontset-plain-name x)
1168                                            (fontset-plain-name y)))))))                                  (fontset-plain-name y))))))
1169            (while fontsets            (while fontsets
1170              (if arg              (if arg
1171                  (print-fontset (car fontsets) nil)                  (print-fontset (car fontsets) nil)
# Line 1253  see the function `describe-fontset' for Line 1176  see the function `describe-fontset' for
1176  (defun list-input-methods ()  (defun list-input-methods ()
1177    "Display information about all input methods."    "Display information about all input methods."
1178    (interactive)    (interactive)
1179    (with-output-to-temp-buffer "*Help*"    (help-setup-xref '(list-input-methods) (interactive-p))
1180      (with-output-to-temp-buffer (help-buffer)
1181      (list-input-methods-1)      (list-input-methods-1)
1182      (with-current-buffer standard-output      (with-current-buffer standard-output
1183        (save-excursion        (save-excursion
# Line 1262  see the function `describe-fontset' for Line 1186  see the function `describe-fontset' for
1186                  "^  \\([^ ]+\\) (`.*' in mode line)$" nil t)                  "^  \\([^ ]+\\) (`.*' in mode line)$" nil t)
1187            (help-xref-button 1 #'help-input-method            (help-xref-button 1 #'help-input-method
1188                                  (match-string 1)                                  (match-string 1)
1189                                  "mouse-2: describe this method")))                                  "mouse-2: describe this method"))))))
       (help-setup-xref '(list-input-methods) (interactive-p)))))  
1190    
1191  (defun list-input-methods-1 ()  (defun list-input-methods-1 ()
1192    (if (not input-method-alist)    (if (not input-method-alist)
# Line 1275  installed LEIM (Libraries of Emacs Input Line 1198  installed LEIM (Libraries of Emacs Input
1198      (princ "    SHORT-DESCRIPTION\n------------------------------\n")      (princ "    SHORT-DESCRIPTION\n------------------------------\n")
1199      (setq input-method-alist      (setq input-method-alist
1200            (sort input-method-alist            (sort input-method-alist
1201                  (function (lambda (x y) (string< (nth 1 x) (nth 1 y))))))                  (lambda (x y) (string< (nth 1 x) (nth 1 y)))))
1202      (let ((l input-method-alist)      (let ((l input-method-alist)
1203            language elt)            language elt)
1204        (while l        (while l
# Line 1387  system which uses fontsets)." Line 1310  system which uses fontsets)."
1310              (setq fontsets (cdr fontsets)))))              (setq fontsets (cdr fontsets)))))
1311        (print-help-return-message))))        (print-help-return-message))))
1312    
1313    (provide 'mule-diag)
1314    
1315  ;;; mule-diag.el ends here  ;;; mule-diag.el ends here

Legend:
Removed from v.1.74  
changed lines
  Added in v.1.74.2.1

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