X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/ae1bb8acec2fc3b699a17f2d0f22a12debad3cfb..937640a621a4ce2e5e56eaecca37a2a28a584318:/lisp/help.el diff --git a/lisp/help.el b/lisp/help.el index 713dd6dfa2..5ec9b1f529 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1,6 +1,6 @@ ;;; help.el --- help commands for Emacs -;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002 +;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2004 ;; Free Software Foundation, Inc. ;; Maintainer: FSF @@ -49,6 +49,7 @@ (define-key help-map (char-to-string help-char) 'help-for-help) (define-key help-map [help] 'help-for-help) (define-key help-map [f1] 'help-for-help) +(define-key help-map "." 'display-local-help) (define-key help-map "?" 'help-for-help) (define-key help-map "\C-c" 'describe-copying) @@ -110,6 +111,9 @@ (define-key help-map "q" 'help-quit) +;; insert-button makes the action nil if it is not store somewhere +(defvar help-button-cache nil) + (defun help-quit () "Just exit from the Help command's command loop." @@ -177,7 +181,7 @@ If FUNCTION is nil, it applies `message', thus displaying the message." (defalias 'help 'help-for-help) (make-help-screen help-for-help - "a b c C e f F i I k C-k l L m p s t v w C-c C-d C-f C-n C-p C-t C-w or ? :" + "a b c C e f F i I k C-k l L m p s t v w C-c C-d C-f C-n C-p C-t C-w . or ? :" "You have typed %THIS-KEY%, the help character. Type a Help option: \(Use SPC or DEL to scroll through this text. Type \\\\[help-quit] to exit the Help command.) @@ -217,6 +221,8 @@ v describe-variable. Type name of a variable; it displays the variable's documentation and value. w where-is. Type command name; it prints which keystrokes invoke that command. +. display-local-help. Display any available local help at point + in the echo area. C-c Display Emacs copying permission (GNU General Public License). C-d Display Emacs ordering information. @@ -234,32 +240,35 @@ C-w Display information on absence of warranty for GNU Emacs." (defun function-called-at-point () "Return a function around point or else called by the list containing point. If that doesn't give a function, return nil." - (with-syntax-table emacs-lisp-mode-syntax-table - (or (condition-case () - (save-excursion - (or (not (zerop (skip-syntax-backward "_w"))) - (eq (char-syntax (following-char)) ?w) - (eq (char-syntax (following-char)) ?_) - (forward-sexp -1)) - (skip-chars-forward "'") - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj))) - (error nil)) - (condition-case () - (save-excursion - (save-restriction - (narrow-to-region (max (point-min) - (- (point) 1000)) (point-max)) - ;; Move up to surrounding paren, then after the open. - (backward-up-list 1) - (forward-char 1) - ;; If there is space here, this is probably something - ;; other than a real Lisp function call, so ignore it. - (if (looking-at "[ \t]") - (error "Probably not a Lisp function call")) - (let ((obj (read (current-buffer)))) - (and (symbolp obj) (fboundp obj) obj)))) - (error nil))))) + (or (with-syntax-table emacs-lisp-mode-syntax-table + (or (condition-case () + (save-excursion + (or (not (zerop (skip-syntax-backward "_w"))) + (eq (char-syntax (following-char)) ?w) + (eq (char-syntax (following-char)) ?_) + (forward-sexp -1)) + (skip-chars-forward "'") + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj))) + (error nil)) + (condition-case () + (save-excursion + (save-restriction + (narrow-to-region (max (point-min) + (- (point) 1000)) (point-max)) + ;; Move up to surrounding paren, then after the open. + (backward-up-list 1) + (forward-char 1) + ;; If there is space here, this is probably something + ;; other than a real Lisp function call, so ignore it. + (if (looking-at "[ \t]") + (error "Probably not a Lisp function call")) + (let ((obj (read (current-buffer)))) + (and (symbolp obj) (fboundp obj) obj)))) + (error nil)))) + (let* ((str (find-tag-default)) + (obj (if str (intern str)))) + (and (symbolp obj) (fboundp obj) obj)))) ;;; `User' help functions @@ -310,19 +319,61 @@ of the key sequence that ran this command." (defun view-emacs-news (&optional arg) "Display info on recent changes to Emacs. -With numeric argument, display information on correspondingly older changes." +With argument, display info only for the selected version." (interactive "P") - (let* ((arg (if arg (prefix-numeric-value arg) 0)) - (file (cond ((eq arg 0) "NEWS") - ((eq arg 1) "ONEWS") - (t - (nth (- arg 2) - (nreverse (directory-files data-directory - nil "^ONEWS\\.[0-9]+$" - nil))))))) - (if file - (view-file (expand-file-name file data-directory)) - (error "No such old news")))) + (if (not arg) + (view-file (expand-file-name "NEWS" data-directory)) + (let* ((map (sort + (delete-dups + (apply + 'nconc + (mapcar + (lambda (file) + (with-temp-buffer + (insert-file-contents + (expand-file-name file data-directory)) + (let (res) + (while (re-search-forward + (if (string-match "^ONEWS\\.[0-9]+$" file) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" + "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t) + (setq res (cons (list (match-string-no-properties 1) + file) res))) + res))) + (append '("NEWS" "ONEWS") + (directory-files data-directory nil + "^ONEWS\\.[0-9]+$" nil))))) + (lambda (a b) + (string< (car b) (car a))))) + (current (caar map)) + (version (completing-read + (format "Read NEWS for the version (default %s): " current) + (mapcar 'car map) nil nil nil nil current)) + (file (cadr (assoc version map))) + res) + (if (not file) + (error "No news is good news") + (view-file (expand-file-name file data-directory)) + (widen) + (goto-char (point-min)) + (when (re-search-forward + (concat (if (string-match "^ONEWS\\.[0-9]+$" file) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*" + "^\* [^0-9\n]*") version) + nil t) + (beginning-of-line) + (narrow-to-region + (point) + (save-excursion + (while (and (setq res + (re-search-forward + (if (string-match "^ONEWS\\.[0-9]+$" file) + "Changes in \\(?:Emacs\\|version\\)?[ \t]*\\([0-9]+\\(?:\\.[0-9]+\\)?\\)" + "^\* [^0-9\n]*\\([0-9]+\\.[0-9]+\\)") nil t)) + (equal (match-string-no-properties 1) version))) + (or res (goto-char (point-max))) + (beginning-of-line) + (point)))))))) (defun view-todo (&optional arg) "Display the Emacs TODO list." @@ -383,7 +434,8 @@ We put that list in a buffer, and display the buffer. The optional argument PREFIX, if non-nil, should be a key sequence; then we display only bindings that start with that prefix. The optional argument BUFFER specifies which buffer's bindings -to display (default, the current buffer)." +to display (default, the current buffer). BUFFER can be a buffer +or a buffer name." (interactive) (or buffer (setq buffer (current-buffer))) (help-setup-xref (list #'describe-bindings prefix buffer) (interactive-p)) @@ -413,28 +465,43 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer." (let ((fn (function-called-at-point)) (enable-recursive-minibuffers t) val) - (setq val (completing-read (if fn - (format "Where is command (default %s): " fn) - "Where is command: ") - obarray 'commandp t)) - (list (if (equal val "") - fn (intern val)) - current-prefix-arg))) - (let* ((remapped (remap-command definition)) - (keys (where-is-internal definition overriding-local-map nil nil remapped)) - (keys1 (mapconcat 'key-description keys ", ")) - (standard-output (if insert (current-buffer) t))) - (if insert - (if (> (length keys1) 0) - (if remapped - (princ (format "%s (%s) (remapped from %s)" keys1 remapped definition)) - (princ (format "%s (%s)" keys1 definition))) - (princ (format "M-x %s RET" definition))) - (if (> (length keys1) 0) - (if remapped - (princ (format "%s is remapped to %s which is on %s" definition remapped keys1)) - (princ (format "%s is on %s" definition keys1))) - (princ (format "%s is not on any key" definition))))) + (setq val (completing-read + (if fn + (format "Where is command (default %s): " fn) + "Where is command: ") + obarray 'commandp t)) + (list (if (equal val "") fn (intern val)) current-prefix-arg))) + (let ((func (indirect-function definition)) + (defs nil) + (standard-output (if insert (current-buffer) t))) + (mapatoms (lambda (symbol) + (and (fboundp symbol) + (not (eq symbol definition)) + (eq func (condition-case () + (indirect-function symbol) + (error symbol))) + (push symbol defs)))) + (princ (mapconcat + #'(lambda (symbol) + (let* ((remapped (command-remapping symbol)) + (keys (where-is-internal + symbol overriding-local-map nil nil remapped)) + (keys (mapconcat 'key-description keys ", "))) + (if insert + (if (> (length keys) 0) + (if remapped + (format "%s (%s) (remapped from %s)" + keys remapped symbol) + (format "%s (%s)" keys symbol)) + (format "M-x %s RET" symbol)) + (if (> (length keys) 0) + (if remapped + (format "%s is remapped to %s which is on %s" + definition symbol keys) + (format "%s is on %s" symbol keys)) + (format "%s is not on any key" symbol))))) + (cons definition defs) + ";\nand "))) nil) (defun string-key-binding (key) @@ -468,7 +535,7 @@ or `keymap' property, return the binding of KEY in the string's keymap." (if (equal string otherstring) string (format "%s (translated from %s)" string otherstring)))))) - + (defun describe-key-briefly (key &optional insert untranslated) "Print the name of the function KEY invokes. KEY is a string. If INSERT (the prefix arg) is non-nil, insert the message in the buffer. @@ -506,14 +573,14 @@ the last key hit are used." (if (symbolp defn) defn (prin1-to-string defn))))))))) -(defun describe-key (key &optional untranslated) +(defun describe-key (key &optional untranslated up-event) "Display documentation of the function invoked by KEY. KEY should be a key sequence--when calling from a program, pass a string or a vector. If non-nil UNTRANSLATED is a vector of the untranslated events. It can also be a number in which case the untranslated events from the last key hit are used." - (interactive "kDescribe key: \np") + (interactive "kDescribe key: \np\nU") (if (numberp untranslated) (setq untranslated (this-single-command-raw-keys))) (save-excursion @@ -541,16 +608,29 @@ the last key hit are used." (prin1 defn) (princ "\n which is ") (describe-function-1 defn) + (when up-event + (let ((defn (or (string-key-binding up-event) (key-binding up-event)))) + (unless (or (null defn) (integerp defn) (equal defn 'undefined)) + (princ "\n\n-------------- up event ---------------\n\n") + (princ (key-description up-event)) + (if (windowp window) + (princ " at that spot")) + (princ " runs the command ") + (prin1 defn) + (princ "\n which is ") + (describe-function-1 defn)))) (print-help-return-message))))))) (defun describe-mode (&optional buffer) "Display documentation of current major mode and minor modes. -The major mode description comes first, followed by the minor modes, -each on a separate page. -For this to work correctly for a minor mode, the mode's indicator variable -\(listed in `minor-mode-alist') must also be a function whose documentation -describes the minor mode." +A brief summary of the minor modes comes first, followed by the +major mode description. This is followed by detailed +descriptions of the minor modes, each on a separate page. + +For this to work correctly for a minor mode, the mode's indicator +variable \(listed in `minor-mode-alist') must also be a function +whose documentation describes the minor mode." (interactive) (help-setup-xref (list #'describe-mode (or buffer (current-buffer))) (interactive-p)) @@ -559,43 +639,162 @@ describes the minor mode." (with-output-to-temp-buffer (help-buffer) (save-excursion (when buffer (set-buffer buffer)) - (when minor-mode-alist - (princ "The major mode is described first. -For minor modes, see following pages.\n\n")) - (princ mode-name) - (princ " mode:\n") - (princ (documentation major-mode)) - (let ((minor-modes minor-mode-alist)) - (while minor-modes - (let* ((minor-mode (car (car minor-modes))) - (indicator (car (cdr (car minor-modes))))) - ;; Document a minor mode if it is listed in minor-mode-alist, - ;; bound locally in this buffer, non-nil, and has a function - ;; definition. - (if (and (boundp minor-mode) - (symbol-value minor-mode) - (fboundp minor-mode)) - (let ((pretty-minor-mode minor-mode)) - (if (string-match "\\(-minor\\)?-mode\\'" - (symbol-name minor-mode)) - (setq pretty-minor-mode - (capitalize - (substring (symbol-name minor-mode) - 0 (match-beginning 0))))) - (while (and indicator (symbolp indicator) - (boundp indicator) - (not (eq indicator (symbol-value indicator)))) - (setq indicator (symbol-value indicator))) + (let (minor-modes) + ;; Find enabled minor mode we will want to mention. + (dolist (mode minor-mode-list) + ;; Document a minor mode if it is listed in minor-mode-alist, + ;; non-nil, and has a function definition. + (and (boundp mode) (symbol-value mode) + (fboundp mode) + (let ((pretty-minor-mode mode) + indicator) + (if (string-match "\\(-minor\\)?-mode\\'" + (symbol-name mode)) + (setq pretty-minor-mode + (capitalize + (substring (symbol-name mode) + 0 (match-beginning 0))))) + (setq indicator (cadr (assq mode minor-mode-alist))) + (while (and indicator (symbolp indicator) + (boundp indicator) + (not (eq indicator (symbol-value indicator)))) + (setq indicator (symbol-value indicator))) + (push (list pretty-minor-mode mode indicator) + minor-modes)))) + (if auto-fill-function + ;; copy pure string so we can add face property to it below. + (push (list (copy-sequence "Auto Fill") 'auto-fill-mode " Fill") + minor-modes)) + (setq minor-modes + (sort minor-modes + (lambda (a b) (string-lessp (car a) (car b))))) + (when minor-modes + (princ "Summary of minor modes:\n") + (make-local-variable 'help-button-cache) + (with-current-buffer standard-output + (dolist (mode minor-modes) + (let ((pretty-minor-mode (nth 0 mode)) + (mode-function (nth 1 mode)) + (indicator (nth 2 mode))) + (add-text-properties 0 (length pretty-minor-mode) + '(face bold) pretty-minor-mode) + (save-excursion + (goto-char (point-max)) (princ "\n\f\n") - (princ (format "%s minor mode (%s):\n" - pretty-minor-mode + (push (point-marker) help-button-cache) + ;; Document the minor modes fully. + (insert pretty-minor-mode) + (princ (format " minor mode (%s):\n" (if indicator (format "indicator%s" indicator) "no indicator"))) - (princ (documentation minor-mode))))) - (setq minor-modes (cdr minor-modes)))) + (princ (documentation mode-function))) + (princ " ") + (insert-button pretty-minor-mode + 'action (car help-button-cache) + 'help-echo "mouse-2, RET: show full information") + (princ (format " minor mode (%s):\n" + (if indicator + (format "indicator%s" indicator) + "no indicator")))))) + (princ "\n(Full information about these minor modes +follows the description of the major mode.)\n\n")) + ;; Document the major mode. + (let ((mode mode-name)) + (with-current-buffer standard-output + (insert mode) + (add-text-properties (- (point) (length mode)) (point) '(face bold)))) + (princ " mode:\n") + (princ (documentation major-mode))) (print-help-return-message)))) + +(defun describe-minor-mode (minor-mode) + "Display documentation of a minor mode given as MINOR-MODE. +MINOR-MODE can be a minor mode symbol or a minor mode indicator string +appeared on the mode-line." + (interactive (list (completing-read + "Minor mode: " + (nconc + (describe-minor-mode-completion-table-for-symbol) + (describe-minor-mode-completion-table-for-indicator) + )))) + (if (symbolp minor-mode) + (setq minor-mode (symbol-name minor-mode))) + (let ((symbols (describe-minor-mode-completion-table-for-symbol)) + (indicators (describe-minor-mode-completion-table-for-indicator))) + (cond + ((member minor-mode symbols) + (describe-minor-mode-from-symbol (intern minor-mode))) + ((member minor-mode indicators) + (describe-minor-mode-from-indicator minor-mode)) + (t + (error "No such minor mode: %s" minor-mode))))) + +;; symbol +(defun describe-minor-mode-completion-table-for-symbol () + ;; In order to list up all minor modes, minor-mode-list + ;; is used here instead of minor-mode-alist. + (delq nil (mapcar 'symbol-name minor-mode-list))) +(defun describe-minor-mode-from-symbol (symbol) + "Display documentation of a minor mode given as a symbol, SYMBOL" + (interactive (list (intern (completing-read + "Minor mode symbol: " + (describe-minor-mode-completion-table-for-symbol))))) + (if (fboundp symbol) + (describe-function symbol) + (describe-variable symbol))) + +;; indicator +(defun describe-minor-mode-completion-table-for-indicator () + (delq nil + (mapcar (lambda (x) + (let ((i (format-mode-line x))) + ;; remove first space if existed + (cond + ((= 0 (length i)) + nil) + ((eq (aref i 0) ?\ ) + (substring i 1)) + (t + i)))) + minor-mode-alist))) +(defun describe-minor-mode-from-indicator (indicator) + "Display documentation of a minor mode specified by INDICATOR. +If you call this function interactively, you can give indicator which +is currently activated with completion." + (interactive (list + (completing-read + "Minor mode indicator: " + (describe-minor-mode-completion-table-for-indicator)))) + (let ((minor-mode (lookup-minor-mode-from-indicator indicator))) + (if minor-mode + (describe-minor-mode-from-symbol minor-mode) + (error "Cannot find minor mode for `%s'" indicator)))) + +(defun lookup-minor-mode-from-indicator (indicator) + "Return a minor mode symbol from its indicator on the modeline." + ;; remove first space if existed + (if (and (< 0 (length indicator)) + (eq (aref indicator 0) ?\ )) + (setq indicator (substring indicator 1))) + (let ((minor-modes minor-mode-alist) + result) + (while minor-modes + (let* ((minor-mode (car (car minor-modes))) + (anindicator (format-mode-line + (car (cdr (car minor-modes)))))) + ;; remove first space if existed + (if (and (stringp anindicator) + (> (length anindicator) 0) + (eq (aref anindicator 0) ?\ )) + (setq anindicator (substring anindicator 1))) + (if (equal indicator anindicator) + (setq result minor-mode + minor-modes nil) + (setq minor-modes (cdr minor-modes))))) + result)) + ;;; Automatic resizing of temporary buffers. @@ -643,4 +842,5 @@ out of view." ;; defcustoms which require 'help'. (provide 'help) +;;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423 ;;; help.el ends here