Mercurial > emacs

changeset 45871:5e25142363ff

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(describe-char-after): Moved to descr-text.el.
author Richard M. Stallman <rms@gnu.org>
date Mon, 17 Jun 2002 16:15:32 +0000
parents 8da973b0df20
children 2793b29e84b3
files lisp/international/mule-diag.el
diffstat 1 files changed, 0 insertions(+), 132 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/international/mule-diag.el	Mon Jun 17 16:15:09 2002 +0000
+++ b/lisp/international/mule-diag.el	Mon Jun 17 16:15:32 2002 +0000
@@ -532,138 +532,6 @@
 	    (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