[Emacs-diffs] Changes to emacs/lisp/international/mule-diag.el

[Richard M. Stallman]

Index: emacs/lisp/international/mule-diag.el
diff -c emacs/lisp/international/mule-diag.el:1.75 
emacs/lisp/international/mule-diag.el:1.76
*** emacs/lisp/international/mule-diag.el:1.75  Wed Jun 12 08:22:09 2002
--- emacs/lisp/international/mule-diag.el       Mon Jun 17 12:15:32 2002
***************
*** 532,669 ****
            (insert (format "Preferred coding system: %s\n" coding))
            (search-backward (symbol-name 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,
- and text properties."
-   (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))))))
  
  ;;; CODING-SYSTEM
  
--- 532,537 ----