Mercurial > emacs
changeset 99119:6b4c01048db2
(describe-categories): Display the terse legend at the head.
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Sat, 25 Oct 2008 01:31:35 +0000 |
parents | 1fa22c8361b3 |
children | 43309e005911 |
files | lisp/help-fns.el |
diffstat | 1 files changed, 40 insertions(+), 12 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/help-fns.el Sat Oct 25 01:30:28 2008 +0000 +++ b/lisp/help-fns.el Sat Oct 25 01:31:35 2008 +0000 @@ -780,20 +780,48 @@ (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)