# HG changeset patch
# User Juanma Barranquero <lekktu@gmail.com>
# Date 1232380095 0
# Node ID 017ab5339c4c79e7525cea12671931d4defd91e6
# Parent  fb88ce22284677d978296c04a8b90945c0cfbae5
* descr-text.el (describe-char-categories): New defsubst.
  (describe-char): Use it.

diff -r fb88ce222846 -r 017ab5339c4c lisp/ChangeLog
--- a/lisp/ChangeLog	Mon Jan 19 15:29:18 2009 +0000
+++ b/lisp/ChangeLog	Mon Jan 19 15:48:15 2009 +0000
@@ -1,3 +1,8 @@
+2009-01-19  Juanma Barranquero  <lekktu@gmail.com>
+
+	* descr-text.el (describe-char-categories): New defsubst.
+	(describe-char): Use it.
+
 2009-01-19  Michael Albinus  <michael.albinus@gmx.de>
 
 	* net/tramp.el (tramp-ipv6-regexp): The regexp shall cover also
diff -r fb88ce222846 -r 017ab5339c4c lisp/descr-text.el
--- a/lisp/descr-text.el	Mon Jan 19 15:29:18 2009 +0000
+++ b/lisp/descr-text.el	Mon Jan 19 15:48:15 2009 +0000
@@ -353,6 +353,21 @@
 (defsubst describe-char-padded-string (ch)
   (compose-string (string ch) 0 1 (format "\t%c\t" ch)))
 
+;; Return a nicely formated list of categories; extended category
+;; description is added to the category name as a tooltip
+(defsubst describe-char-categories (category-set)
+  (let ((mnemonics (category-set-mnemonics category-set)))
+    (unless (eq mnemonics "")
+      (list (mapconcat
+	     #'(lambda (x)
+		 (let* ((c (category-docstring x))
+			(doc (if (string-match "\\`\\(.*?\\)\n\\(.*\\)\\'" c)
+				 (propertize (match-string 1 c)
+					     'help-echo (match-string 2 c))
+			       c)))
+		   (format "%c:%s" x doc)))
+	     mnemonics ", ")))))
+
 ;;;###autoload
 (defun describe-char (pos)
   "Describe the character after POS (interactively, the character after point).
@@ -430,11 +445,9 @@
 		  (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)))))
+		 (if category-set
+		     (describe-char-categories category-set)
+		   '("-- none --"))))
 	    ("to input"
 	     ,@(let ((key-list (and (eq input-method-function
 					'quail-input-method)