;;; help-fns.el --- Complex help functions
;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001,
-;; 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: help, internal
;; When the Elisp source file can be found in the install
;; directory return the name of that file - `file-name' should
;; have become an absolute file name ny now.
- (and (file-readable-p lib-name) lib-name)))
+ (or (and (file-readable-p lib-name) lib-name)
+ ;; The library might be compressed.
+ (and (file-readable-p (concat lib-name ".gz")) lib-name))))
((let* ((lib-name (file-name-nondirectory file-name))
;; The next form is from `describe-simplify-lib-file-name'.
(file-name
(princ " in `")
;; We used to add .el to the file name,
;; but that's completely wrong when the user used load-file.
- (princ (if (eq file-name 'C-source) "C source code" file-name))
+ (princ (if (eq file-name 'C-source)
+ "C source code"
+ (file-name-nondirectory file-name)))
(princ "'")
;; Make a hyperlink to the library.
(with-current-buffer standard-output
(point)))
(terpri)(terpri)
(when (commandp function)
- (let ((pt2 (with-current-buffer (help-buffer) (point))))
- (if (and (eq function 'self-insert-command)
- (eq (key-binding "a") 'self-insert-command)
- (eq (key-binding "b") 'self-insert-command)
- (eq (key-binding "c") 'self-insert-command))
- (princ "It is bound to many ordinary text characters.\n")
- (let* ((remapped (command-remapping function))
- (keys (where-is-internal
- (or remapped function) overriding-local-map nil nil))
- non-modified-keys)
- ;; Which non-control non-meta keys run this command?
- (dolist (key keys)
- (if (member (event-modifiers (aref key 0)) '(nil (shift)))
- (push key non-modified-keys)))
- (when remapped
- (princ "It is remapped to `")
- (princ (symbol-name remapped))
- (princ "'"))
-
- (when keys
- (princ (if remapped ", which is bound to " "It is bound to "))
- ;; If lots of ordinary text characters run this command,
- ;; don't mention them one by one.
- (if (< (length non-modified-keys) 10)
- (princ (mapconcat 'key-description keys ", "))
- (dolist (key non-modified-keys)
- (setq keys (delq key keys)))
- (if keys
- (progn
- (princ (mapconcat 'key-description keys ", "))
- (princ ", and many ordinary text characters"))
- (princ "many ordinary text characters"))))
- (when (or remapped keys non-modified-keys)
- (princ ".")
- (terpri))))
- (with-current-buffer (help-buffer) (fill-region-as-paragraph pt2 (point)))
- (terpri)))
+ (let ((pt2 (with-current-buffer (help-buffer) (point)))
+ (remapped (command-remapping function)))
+ (unless (memq remapped '(ignore undefined))
+ (let ((keys (where-is-internal
+ (or remapped function) overriding-local-map nil nil))
+ non-modified-keys)
+ (if (and (eq function 'self-insert-command)
+ (vectorp (car-safe keys))
+ (consp (aref (car keys) 0)))
+ (princ "It is bound to many ordinary text characters.\n")
+ ;; Which non-control non-meta keys run this command?
+ (dolist (key keys)
+ (if (member (event-modifiers (aref key 0)) '(nil (shift)))
+ (push key non-modified-keys)))
+ (when remapped
+ (princ "It is remapped to `")
+ (princ (symbol-name remapped))
+ (princ "'"))
+
+ (when keys
+ (princ (if remapped ", which is bound to " "It is bound to "))
+ ;; If lots of ordinary text characters run this command,
+ ;; don't mention them one by one.
+ (if (< (length non-modified-keys) 10)
+ (princ (mapconcat 'key-description keys ", "))
+ (dolist (key non-modified-keys)
+ (setq keys (delq key keys)))
+ (if keys
+ (progn
+ (princ (mapconcat 'key-description keys ", "))
+ (princ ", and many ordinary text characters"))
+ (princ "many ordinary text characters"))))
+ (when (or remapped keys non-modified-keys)
+ (princ ".")
+ (terpri)))))
+
+ (with-current-buffer (help-buffer)
+ (fill-region-as-paragraph pt2 (point))
+ (unless (looking-back "\n\n")
+ (terpri)))))
(let* ((arglist (help-function-arglist def))
(doc (documentation function))
(usage (help-split-fundoc doc function)))
(if file-name
(progn
(princ " is a variable defined in `")
- (princ (if (eq file-name 'C-source) "C source code" file-name))
+ (princ (if (eq file-name 'C-source)
+ "C source code"
+ (file-name-nondirectory file-name)))
(princ "'.\n")
(with-current-buffer standard-output
(save-excursion
(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)