(describe-categories): Display the terse legend at the head.

1 files changed, 40 insertions, 12 deletions

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 612b90ff62b..d08c184e1f5 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -780,20 +780,48 @@ BUFFER should be a buffer or a buffer name."
   (setq buffer (or buffer (current-buffer)))
   (help-setup-xref (list #'describe-categories buffer) (interactive-p))
   (with-help-window (help-buffer)
-    (let ((table (with-current-buffer buffer (category-table))))
+    (let* ((table (with-current-buffer buffer (category-table)))
+	   (docs (char-table-extra-slot table 0)))
+      (if (or (not (vectorp docs)) (/= (length docs) 95))
+	  (error "Invalid first extra slot in this category table\n"))
       (with-current-buffer standard-output
+	(insert "Legend of category mnemonics (see the tail for the longer description)\n")
+	(let ((pos (point)) (items 0) lines n)
+	  (dotimes (i 95)
+	    (if (aref docs i) (setq items (1+ items))))
+	  (setq lines (1+ (/ (1- items) 4)))
+	  (setq n 0)
+	  (dotimes (i 95)
+	    (let ((elt (aref docs i)))
+	      (when elt
+		(string-match ".*" elt)
+		(setq elt (match-string 0 elt))
+		(if (>= (length elt) 17)
+		    (setq elt (concat (substring elt 0 14) "...")))
+		(if (< (point) (point-max))
+		    (move-to-column (* 20 (/ n lines)) t))
+		(insert (+ i ?\s) ?: elt)
+		(if (< (point) (point-max))
+		    (forward-line 1)
+		  (insert "\n"))
+		(setq n (1+ n))
+		(if (= (% n lines) 0)
+		    (goto-char pos))))))
+	(goto-char (point-max))
+	(insert "\n"
+		"character(s)\tcategory mnemonics\n"
+		"------------\t------------------")
 	(describe-vector table 'help-describe-category-set)
-	(let ((docs (char-table-extra-slot table 0)))
-	  (if (or (not (vectorp docs)) (/= (length docs) 95))
-	      (insert "Invalid first extra slot in this char table\n")
-	    (insert "Meanings of mnemonic characters are:\n")
-	    (dotimes (i 95)
-	      (let ((elt (aref docs i)))
-		(when elt
-		  (insert (+ i ?\s) ": " elt "\n"))))
-	    (while (setq table (char-table-parent table))
-	      (insert "\nThe parent category table is:")
-	      (describe-vector table 'help-describe-category-set))))))))
+	(insert "Legend of category mnemonics:\n")
+	(dotimes (i 95)
+	  (let ((elt (aref docs i)))
+	    (when elt
+	      (if (string-match "\n" elt)
+		  (setq elt (substring elt (match-end 0))))
+	      (insert (+ i ?\s) ": " elt "\n"))))
+	(while (setq table (char-table-parent table))
+	  (insert "\nThe parent category table is:")
+	  (describe-vector table 'help-describe-category-set))))))
 
 (provide 'help-fns)