X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/918f2e56d9ab0bf94ea260aec9d224a20c80c44f..f0ad2f4c896ffd59f3f0e7fc3c717b52e8205c1a:/lisp/help.el

diff --git a/lisp/help.el b/lisp/help.el
index 992a9b85f4..cb634e2bda 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1,7 +1,7 @@
 ;;; help.el --- help commands for Emacs
 
-;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002, 2004
-;;   Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000, 2001, 2002,
+;;   2003, 2004, 2005 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: help, internal
@@ -20,8 +20,8 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
@@ -179,14 +179,17 @@ If FUNCTION is nil, it applies `message', thus displaying the message."
 ;; So keyboard macro definitions are documented correctly
 (fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
 
-(defalias 'help 'help-for-help)
-(make-help-screen help-for-help
+(defalias 'help 'help-for-help-internal)
+;; find-function can find this.
+(defalias 'help-for-help 'help-for-help-internal)
+;; It can't find this, but nobody will look.
+(make-help-screen help-for-help-internal
   "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-map>\\[help-quit] to exit the Help command.)
 
 a  command-apropos.  Give a substring, and see a list of commands
-	(functions interactively callable) that contain
+	(functions that are interactively callable) that contain
 	that substring.  See also the  apropos  command.
 b  describe-bindings.  Display table of all key bindings.
 c  describe-key-briefly.  Type a command key sequence;
@@ -194,24 +197,28 @@ c  describe-key-briefly.  Type a command key sequence;
 C  describe-coding-system.  This describes either a specific coding system
         (if you type its name) or the coding systems currently in use
 	(if you type just RET).
-e  view-echo-area-messages.  Show the `*Messages*' buffer.
-f  describe-function.  Type a function name and get documentation of it.
+e  view-echo-area-messages.  Show the buffer where the echo-area messages
+	are stored.
+f  describe-function.  Type a function name and get its documentation.
 F  Info-goto-emacs-command-node.  Type a function name;
-	it takes you to the Info node for that command.
+	it takes you to the on-line manual's section that describes
+	the command.
 h  Display the HELLO file which illustrates various scripts.
-i  info. The  info  documentation reader.
+i  info. The Info documentation reader: read on-line manuals.
 I  describe-input-method.  Describe a specific input method (if you type
 	its name) or the current input method (if you type just RET).
 k  describe-key.  Type a command key sequence;
-	it displays the full documentation.
+	it displays the full documentation for that key sequence.
 K Info-goto-emacs-key-command-node.  Type a command key sequence;
-	it takes you to the Info node for the command bound to that key.
+	it takes you to the on-line manual's section that describes
+	the command bound to that key.
 l  view-lossage.  Show last 100 characters you typed.
 L  describe-language-environment.  This describes either a
 	specific language environment (if you type its name)
 	or the current language environment (if you type just RET).
-m  describe-mode.  Print documentation of current minor modes,
+m  describe-mode.  Display documentation of current minor modes,
 	and the current major mode, including their special commands.
+n  view-emacs-news.  Display news of recent Emacs changes.
 p  finder-by-keyword. Find packages matching a given topic keyword.
 s  describe-syntax.  Display contents of syntax table, plus explanations.
 S  info-lookup-symbol.  Display the definition of a specific symbol
@@ -479,6 +486,7 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
   (let ((func (indirect-function definition))
         (defs nil)
         (standard-output (if insert (current-buffer) t)))
+    ;; In DEFS, find all symbols that are aliases for DEFINITION.
     (mapatoms (lambda (symbol)
 		(and (fboundp symbol)
 		     (not (eq symbol definition))
@@ -486,27 +494,37 @@ If INSERT (the prefix arg) is non-nil, insert the message in the buffer."
 				  (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 ")))
+    ;; Look at all the symbols--first DEFINITION,
+    ;; then its aliases.
+    (dolist (symbol (cons definition defs))
+      (let* ((remapped (command-remapping symbol))
+	     (keys (where-is-internal
+		    symbol overriding-local-map nil nil remapped))
+	     (keys (mapconcat 'key-description keys ", "))
+	     string)
+	(setq string
+	      (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))
+		  ;; If this is the command the user asked about,
+		  ;; and it is not on any key, say so.
+		  ;; For other symbols, its aliases, say nothing
+		  ;; about them unless they are on keys.
+		  (if (eq symbol definition)
+		      (format "%s is not on any key" symbol)))))
+	(when string
+	  (unless (eq symbol definition)
+	    (princ ";\n its alias "))
+	  (princ string)))))
   nil)
 
 (defun string-key-binding (key)
@@ -568,7 +586,16 @@ the last key hit are used."
       ;; Ok, now look up the key and name the command.
       (let ((defn (or (string-key-binding key)
 		      (key-binding key)))
-	    (key-desc (help-key-description key untranslated)))
+	    key-desc)
+	;; Don't bother user with strings from (e.g.) the select-paste menu.
+	(if (stringp (aref key (1- (length key))))
+	    (aset key (1- (length key)) "(any string)"))
+	(if (and (> (length untranslated) 0)
+		 (stringp (aref untranslated (1- (length untranslated)))))
+	    (aset untranslated (1- (length untranslated))
+		  "(any string)"))
+	;; Now describe the key, perhaps as changed.
+	(setq key-desc (help-key-description key untranslated))
 	(if (or (null defn) (integerp defn) (equal defn 'undefined))
 	    (princ (format "%s is undefined" key-desc))
 	  (princ (format (if (windowp window)
@@ -577,7 +604,6 @@ the last key hit are used."
 			 key-desc
 			 (if (symbolp defn) defn (prin1-to-string defn)))))))))
 
-
 (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,
@@ -585,6 +611,7 @@ 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."
+  ;; UP-EVENT is the up-event that was discarded by reading KEY, or nil.
   (interactive "kDescribe key: \np\nU")
   (if (numberp untranslated)
       (setq untranslated (this-single-command-raw-keys)))
@@ -605,6 +632,13 @@ the last key hit are used."
 	(if (or (null defn) (integerp defn) (equal defn 'undefined))
 	    (message "%s is undefined" (help-key-description key untranslated))
 	  (help-setup-xref (list #'describe-function defn) (interactive-p))
+	  ;; Don't bother user with strings from (e.g.) the select-paste menu.
+	  (if (stringp (aref key (1- (length key))))
+	      (aset key (1- (length key)) "(any string)"))
+	  (if (and untranslated
+		   (stringp (aref untranslated (1- (length untranslated)))))
+	      (aset untranslated (1- (length untranslated))
+		    "(any string)"))
 	  (with-output-to-temp-buffer (help-buffer)
 	    (princ (help-key-description key untranslated))
 	    (if (windowp window)
@@ -614,16 +648,57 @@ the last key hit are used."
 	    (princ "\n   which is ")
 	    (describe-function-1 defn)
 	    (when up-event
-	      (let ((defn (or (string-key-binding up-event) (key-binding up-event))))
+	      (let ((ev (aref up-event 0))
+		    (descr (key-description up-event))
+		    (hdr "\n\n-------------- up event ---------------\n\n")
+		    defn
+		    mouse-1-tricky mouse-1-remapped)
+		(when (and (consp ev)
+			   (eq (car ev) 'mouse-1)
+			   (windowp window)
+			   mouse-1-click-follows-link
+			   (not (eq mouse-1-click-follows-link 'double))
+			   (with-current-buffer (window-buffer window)
+			     (mouse-on-link-p (posn-point (event-start ev)))))
+		  (setq mouse-1-tricky (integerp mouse-1-click-follows-link)
+			mouse-1-remapped (or (not mouse-1-tricky)
+					     (> mouse-1-click-follows-link 0)))
+		  (if mouse-1-remapped
+		      (setcar ev 'mouse-2)))
+		(setq 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))
+		  (princ (if mouse-1-tricky
+			     "\n\n----------------- up-event (short click) ----------------\n\n"
+			   hdr))
+		  (setq hdr nil)
+		  (princ descr)
 		  (if (windowp window)
 		      (princ " at that spot"))
+		  (if mouse-1-remapped
+		      (princ " is remapped to <mouse-2>\n  which" ))
 		  (princ " runs the command ")
 		  (prin1 defn)
 		  (princ "\n   which is ")
-		  (describe-function-1 defn))))
+		  (describe-function-1 defn))
+		(when mouse-1-tricky
+		  (setcar ev
+			  (if (> mouse-1-click-follows-link 0) 'mouse-1 'mouse-2))
+		  (setq defn (or (string-key-binding up-event) (key-binding up-event)))
+		  (unless (or (null defn) (integerp defn) (equal defn 'undefined))
+		    (princ (or hdr
+			       "\n\n----------------- up-event (long click) ----------------\n\n"))
+		    (princ "Pressing ")
+		    (princ descr)
+		    (if (windowp window)
+			(princ " at that spot"))
+		    (princ (format " for longer than %d milli-seconds\n"
+				   (abs mouse-1-click-follows-link)))
+		    (if (not mouse-1-remapped)
+			(princ " remaps it to <mouse-2> which" ))
+		    (princ " runs the command ")
+		    (prin1 defn)
+		    (princ "\n   which is ")
+		    (describe-function-1 defn)))))
 	    (print-help-return-message)))))))
 
 
@@ -637,50 +712,51 @@ 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)))
+  (unless buffer (setq buffer (current-buffer)))
+  (help-setup-xref (list #'describe-mode buffer)
 		   (interactive-p))
   ;; For the sake of help-do-xref and help-xref-go-back,
   ;; don't switch buffers before calling `help-buffer'.
   (with-output-to-temp-buffer (help-buffer)
-    (save-excursion
-      (when buffer (set-buffer buffer))
+    (with-current-buffer buffer
       (let (minor-modes)
+	;; Older packages do not register in minor-mode-list but only in
+	;; minor-mode-alist.
+	(dolist (x minor-mode-alist)
+	  (setq x (car x))
+	  (unless (memq x minor-mode-list)
+	    (push x minor-mode-list)))
 	;; 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))
+	  (let ((fmode (or (get mode :minor-mode-function) mode)))
+	    (and (boundp mode) (symbol-value mode)
+		 (fboundp fmode)
+		 (let ((pretty-minor-mode
+			(if (string-match "\\(\\(-minor\\)?-mode\\)?\\'"
+					  (symbol-name fmode))
+			    (capitalize
+			     (substring (symbol-name fmode)
+					0 (match-beginning 0)))
+			  fmode)))
+		   (push (list fmode pretty-minor-mode
+			       (format-mode-line (assq mode minor-mode-alist)))
+			 minor-modes)))))
 	(setq minor-modes
 	      (sort minor-modes
-		    (lambda (a b) (string-lessp (car a) (car b)))))
+		    (lambda (a b) (string-lessp (cadr a) (cadr 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))
+	      (let ((mode-function (nth 0 mode))
+		    (pretty-minor-mode (nth 1 mode))
 		    (indicator (nth 2 mode)))
+		(setq indicator (if (zerop (length indicator))
+				    "no indicator"
+				  (format "indicator%s" indicator)))
 		(add-text-properties 0 (length pretty-minor-mode)
 				     '(face bold) pretty-minor-mode)
 		(save-excursion
@@ -689,19 +765,14 @@ whose documentation describes the 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 (format " minor mode (%s):\n" indicator))
 		  (princ (documentation mode-function)))
 		(princ "  ")
 		(insert-button pretty-minor-mode
 			       'action (car help-button-cache)
+			       'follow-link t
 			       'help-echo "mouse-2, RET: show full information")
-		(princ (format " minor mode (%s):\n"
-			       (if indicator
-				   (format "indicator%s" indicator)
-				 "no indicator"))))))
+		(princ (format " minor mode (%s):\n" indicator)))))
 	  (princ "\n(Full information about these minor modes
 follows the description of the major mode.)\n\n"))
 	;; Document the major mode.
@@ -847,5 +918,5 @@ out of view."
 ;; defcustoms which require 'help'.
 (provide 'help)
 
-;;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423
+;; arch-tag: cf427352-27e9-49b7-9a6f-741ebab02423
 ;;; help.el ends here