Mercurial > emacs

changeset 55305:b1c52f4076c4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(describe-char): Copy the character with text properties and overlays into the first line, and call describe-text-properties on it.
author Kenichi Handa <handa@m17n.org>
date Sun, 02 May 2004 01:49:08 +0000
parents a052e022db03
children 3757f583f280
files lisp/descr-text.el
diffstat 1 files changed, 26 insertions(+), 24 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/descr-text.el	Sun May 02 00:26:40 2004 +0000
+++ b/lisp/descr-text.el	Sun May 02 01:49:08 2004 +0000
@@ -465,6 +465,7 @@
   (if (>= pos (point-max))
       (error "No character follows specified position"))
   (let* ((char (char-after pos))
+	 (char-string (buffer-substring pos (1+ pos)))
 	 (charset (char-charset char))
 	 (buffer (current-buffer))
 	 (composition (find-composition pos nil nil t))
@@ -474,16 +475,11 @@
 			    standard-display-table))
 	 (disp-vector (and display-table (aref display-table char)))
 	 (multibyte-p enable-multibyte-characters)
-	 text-prop-description
+	 (overlays (mapcar #'(lambda (o) (overlay-properties o))
+			   (overlays-at pos)))
 	 item-list max-width unicode)
     (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"))
 
       (if (or (< char 256)
 	      (memq 'mule-utf-8 (find-coding-systems-region pos (1+ pos)))
@@ -491,14 +487,7 @@
 	  (setq unicode (or (get-char-property pos 'untranslated-utf-8)
 			    (encode-char char 'ucs))))
       (setq item-list
-	    `(("character"
-	       ,(format "%s (0%o, %d, 0x%x%s)" (if (< char 256)
-						 (single-key-description char)
-					       (char-to-string char))
-			char char char
-			(if unicode
-			    (format ", U+%04X" unicode)
-			  "")))
+	    `(("character")
 	      ("charset"
 	       ,(symbol-name charset)
 	       ,(format "(%s)" (charset-description charset)))
@@ -583,18 +572,31 @@
 		      (cons (list "Unicode data" " ") unicodedata))))))
     (setq max-width (apply #'max (mapcar #'(lambda (x) (length (car x)))
 					 item-list)))
-    (setq text-prop-description
-	  (with-temp-buffer
-	    (let ((buf (current-buffer)))
-	      (save-excursion
-		(set-buffer buffer)
-		(describe-text-properties pos buf)))
-	    (buffer-string)))
+    (pop item-list)
 
     (with-output-to-temp-buffer "*Help*"
       (with-current-buffer standard-output
 	(set-buffer-multibyte multibyte-p)
 	(let ((formatter (format "%%%ds:" max-width)))
+	  (insert (format formatter "character") " ")
+	  (setq pos (point))
+	  (insert char-string
+		  (format " (`%s', 0%o, %d, 0x%x"
+			  (if (< char 256)
+			      (single-key-description char)
+			    (char-to-string char))
+			  char char char)
+		  (if (eq charset 'unknown)
+		      ") -- invalid character code\n"
+		    (if unicode
+			(format ", U+%04X)\n" unicode)
+		      ")\n")))
+	  (mapc #'(lambda (props)
+		    (let ((o (make-overlay pos (1+ pos))))
+		      (while props
+			(overlay-put o (car props) (nth 1 props))
+			(setq props (cddr props)))))
+		overlays)
 	  (dolist (elt item-list)
 	    (when (cadr elt)
 	      (insert (format formatter (car elt)))
@@ -665,7 +667,7 @@
 	  (insert "\nSee the variable `reference-point-alist' for "
 		  "the meaning of the rule.\n"))
 
-	(insert text-prop-description)
+	(describe-text-properties pos (current-buffer))
 	(describe-text-mode)))))
 
 (defalias 'describe-char-after 'describe-char)