X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4607e12b53afe473f6a638f5e29f1173cb8aa902..2de477650b66e89d055051c0980bd29b07cd54e0:/lisp/help.el

diff --git a/lisp/help.el b/lisp/help.el
index a38d621482..b36075b811 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 Free Software Foundation, Inc.
+;; Copyright (C) 1985, 1986, 1993, 1994, 1998, 1999, 2000 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: help, internal
@@ -661,7 +661,8 @@ It can also be nil, if the definition is not associated with any file."
       (save-excursion
 	(save-match-data
 	  (if (re-search-backward "alias for `\\([^`']+\\)'" nil t)
-	      (help-xref-button 1 #'describe-function def)))))
+	      (help-xref-button 1 #'describe-function def
+				"mouse-2, RET: describe this function")))))
     (or file-name
 	(setq file-name (symbol-file function)))
     (if file-name
@@ -680,7 +681,8 @@ It can also be nil, if the definition is not associated with any file."
 					     (find-function-noselect arg)))
 					(pop-to-buffer (car location))
 					(goto-char (cdr location))))
-				function)))))
+				function
+				"mouse-2, RET: find function's definition")))))
     (if need-close (princ ")"))
     (princ ".")
     (terpri)
@@ -693,21 +695,41 @@ It can also be nil, if the definition is not associated with any file."
 			  (car (append def nil)))
 			 ((eq (car-safe def) 'lambda)
 			  (nth 1 def))
+			 ((and (eq (car-safe def) 'autoload)
+			       (not (eq (nth 4 def) 'keymap)))
+			  (concat "[Arg list not available until "
+				  "function definition is loaded.]"))
 			 (t t))))
-      (if (listp arglist)
-	  (progn
-	    (princ (cons (if (symbolp function) function "anonymous")
-			 (mapcar (lambda (arg)
-				   (if (memq arg '(&optional &rest))
-				       arg
-				     (intern (upcase (symbol-name arg)))))
-				 arglist)))
-	    (terpri))))
+      (cond ((listp arglist)
+	     (princ (cons (if (symbolp function) function "anonymous")
+			  (mapcar (lambda (arg)
+				    (if (memq arg '(&optional &rest))
+					arg
+				      (intern (upcase (symbol-name arg)))))
+				  arglist)))
+	     (terpri))
+	    ((stringp arglist)
+	     (princ arglist)
+	     (terpri))))
     (let ((doc (documentation function)))
       (if doc
 	  (progn (terpri)
 		 (princ doc)
-		 (help-setup-xref (list #'describe-function function) interactive-p))
+		 (with-current-buffer standard-output
+		   (beginning-of-line)
+		   ;; Builtins get the calling sequence at the end of
+		   ;; the doc string.  Move it to the same place as
+		   ;; for other functions.
+		   (when (looking-at (format "(%S[ )]" function))
+		     (let ((start (point-marker)))
+		       (goto-char (point-min))
+		       (forward-paragraph)
+		       (insert-buffer-substring (current-buffer) start)
+		       (insert ?\n)
+		       (delete-region (1- start) (point-max))
+		       (goto-char (point-max)))))
+		 (help-setup-xref (list #'describe-function function)
+				  interactive-p))
 	(princ "not documented")))))
 
 (defun variable-at-point ()
@@ -770,6 +792,7 @@ Returns the documentation as a string, also."
 	    (set-buffer standard-output)
 	    (if (> (count-lines (point-min) (point-max)) 10)
 		(progn
+		  (set-syntax-table emacs-lisp-mode-syntax-table)
 		  (goto-char (point-min))
 		  (if valvoid
 		      (forward-line 1)
@@ -800,7 +823,9 @@ Returns the documentation as a string, also."
 		    (re-search-backward 
 		     (concat "\\(" customize-label "\\)") nil t)
 		    (help-xref-button 1 #'(lambda (v)
-					    (customize-variable v)) variable)
+					    (customize-variable v))
+				      variable
+				      "mouse-2, RET: customize variable")
 		    ))))
 	  ;; Make a hyperlink to the library if appropriate.  (Don't
 	  ;; change the format of the buffer's initial line in case
@@ -813,12 +838,13 @@ Returns the documentation as a string, also."
 	      (with-current-buffer "*Help*"
 		(save-excursion
 		  (re-search-backward "`\\([^`']+\\)'" nil t)
-		  (help-xref-button 1 (lambda (arg)
-					(let ((location
-					       (find-variable-noselect arg)))
-					  (pop-to-buffer (car location))
-					  (goto-char (cdr location))))
-				    variable)))))
+		  (help-xref-button
+		   1 (lambda (arg)
+		       (let ((location
+			      (find-variable-noselect arg)))
+			 (pop-to-buffer (car location))
+			 (goto-char (cdr location))))
+		   variable "mouse-2, RET: find variable's definition")))))
 
 	  (print-help-return-message)
 	  (save-excursion
@@ -1010,7 +1036,8 @@ that."
 		    (save-match-data
 		      (unless (string-match "^([^)]+)" data)
 			(setq data (concat "(emacs)" data))))
-		    (help-xref-button 1 #'info data))))
+		    (help-xref-button 1 #'info data
+				      "mouse-2, RET: read this Info node"))))
               ;; Quoted symbols
               (save-excursion
                 (while (re-search-forward help-xref-symbol-regexp nil t)
@@ -1021,15 +1048,29 @@ that."
                          ((match-string 3) ; `variable' &c
                           (and (boundp sym) ; `variable' doesn't ensure
                                         ; it's actually bound
-                               (help-xref-button 6 #'describe-variable sym)))
+                               (help-xref-button
+				6 #'describe-variable sym
+				"mouse-2, RET: describe this variable")))
                          ((match-string 4) ; `function' &c
                           (and (fboundp sym) ; similarly
-                               (help-xref-button 6 #'describe-function sym)))
+                               (help-xref-button
+				6 #'describe-function sym
+				"mouse-2, RET: describe this function")))
                          ((match-string 5)) ; nothing for symbol
-                         ((or (boundp sym) (fboundp sym))
+                         ((and (boundp sym) (fboundp sym))
                           ;; We can't intuit whether to use the
                           ;; variable or function doc -- supply both.
-                          (help-xref-button 6 #'help-xref-interned sym)))))))
+                          (help-xref-button
+			   6 #'help-xref-interned sym
+			   "mouse-2, RET: describe this symbol"))
+                         ((boundp sym)
+			  (help-xref-button
+			   6 #'describe-variable sym
+			   "mouse-2, RET: describe this variable"))
+			 ((fboundp sym)
+			  (help-xref-button
+			   6 #'describe-function sym
+			   "mouse-2, RET: describe this function")))))))
               ;; An obvious case of a key substitution:
               (save-excursion              
                 (while (re-search-forward
@@ -1038,7 +1079,9 @@ that."
                         "\\<M-x\\s-+\\(\\sw\\(\\sw\\|-\\)+\\)" nil t)
                   (let ((sym (intern-soft (match-string 1))))
                     (if (fboundp sym)
-                        (help-xref-button 1 #'describe-function sym)))))
+                        (help-xref-button
+			 1 #'describe-function sym
+			 "mouse-2, RET: describe this command")))))
               ;; Look for commands in whole keymap substitutions:
               (save-excursion
 		;; Make sure to find the first keymap.
@@ -1061,7 +1104,8 @@ that."
                                    (let ((sym (intern-soft (match-string 0))))
                                      (if (fboundp sym)
                                          (help-xref-button 
-                                          0 #'describe-function sym))))
+                                          0 #'describe-function sym
+					  "mouse-2, RET: describe this function"))))
 			       (zerop (forward-line)))))))))
           (set-syntax-table stab))
         ;; Make a back-reference in this buffer if appropriate.
@@ -1081,13 +1125,14 @@ that."
                          map))))
       (set-buffer-modified-p old-modified))))
 
-(defun help-xref-button (match-number function data)
+(defun help-xref-button (match-number function data &optional help-echo)
   "Make a hyperlink for cross-reference text previously matched.
 
 MATCH-NUMBER is the subexpression of interest in the last matched
 regexp.  FUNCTION is a function to invoke when the button is
 activated, applied to DATA.  DATA may be a single value or a list.
-See `help-make-xrefs'."
+See `help-make-xrefs'.
+If optional arg HELP-ECHO is supplied, it is used as a help string."
   ;; Don't mung properties we've added specially in some instances.
   (unless (get-text-property (match-beginning match-number) 'help-xref)
     (add-text-properties (match-beginning match-number)
@@ -1097,6 +1142,10 @@ See `help-make-xrefs'."
 						(if (listp data)
 						    data
 						  (list data)))))
+    (if help-echo
+	(put-text-property (match-beginning match-number)
+			   (match-end match-number)
+			   'help-echo help-echo))
     (if help-highlight-p
 	(put-text-property (match-beginning match-number)
 			   (match-end match-number)
@@ -1150,7 +1199,10 @@ help buffer."
 	      args (cddr item))
 	(setq help-xref-stack (cdr help-xref-stack))))
     (apply method args)
-    (goto-char position)))
+    ;; We're not in the right buffer to do this, and we don't actually
+    ;; know which we should be in.
+    ;;(goto-char position)
+    ))
 
 (defun help-go-back ()
   "Invoke the [back] button (if any) in the Help mode buffer."
@@ -1290,4 +1342,82 @@ out of view."
            (new-height (max (min text-height max-height) min-height)))
       (enlarge-window (- new-height win-height)))))
 
+;; `help-manyarg-func-alist' is defined primitively (in doc.c).
+;; New primitives with `MANY' or `UNEVALLED' arglists should be added
+;; to this alist.
+;; The parens and function name are redundant, but it's messy to add
+;; them in `documentation'.
+(defconst help-manyarg-func-alist
+  (purecopy
+   '((list . "(list &rest OBJECTS)")
+     (vector . "(vector &rest OBJECTS)")
+     (make-byte-code . "(make-byte-code &rest ELEMENTS)")
+     (call-process
+      . "(call-process PROGRAM &optional INFILE BUFFER DISPLAY &rest ARGS)")
+     (string . "(string &rest CHARACTERS)")
+     (+ . "(+ &rest NUMBERS-OR-MARKERS)")
+     (- . "(- &optional NUMBER-OR-MARKER &rest MORE-NUMBERS-OR-MARKERS)")
+     (* . "(* &rest NUMBERS-OR-MARKERS)")
+     (/ . "(/ DIVIDEND DIVISOR &rest DIVISORS)")
+     (max . "(max NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)")
+     (min . "(min NUMBER-OR-MARKER &rest NUMBERS-OR-MARKERS)")
+     (logand . "(logand &rest INTS-OR-MARKERS)")
+     (logior . "(logior &rest INTS-OR-MARKERS)")
+     (logxor . "(logxor &rest INTS-OR-MARKERS)")
+     (encode-time
+      . "(encode-time SECOND MINUTE HOUR DAY MONTH YEAR &optional ZONE)")
+     (insert . "(insert &rest ARGS)")
+     (insert-before-markers . "(insert-before-markers &rest ARGS)")
+     (message . "(message STRING &rest ARGUMENTS)")
+     (message-box . "(message-box STRING &rest ARGUMENTS)")
+     (message-or-box . "(message-or-box STRING &rest ARGUMENTS)")
+     (propertize . "(propertize STRING &rest PROPERTIES)")
+     (format . "(format STRING &rest OBJECTS)")
+     (apply . "(apply FUNCTION &rest ARGUMENTS)")
+     (run-hooks . "(run-hooks &rest HOOKS)")
+     (run-hook-with-args . "(run-hook-with-args HOOK &rest ARGS)")
+     (run-hook-with-args-until-failure
+      . "(run-hook-with-args-until-failure HOOK &rest ARGS)")
+     (run-hook-with-args-until-success
+      . "(run-hook-with-args-until-success HOOK &rest ARGS)")
+     (funcall . "(funcall FUNCTION &rest ARGUMENTS)")
+     (append . "(append &rest SEQUENCES)")
+     (concat . "(concat &rest SEQUENCES)")
+     (vconcat . "(vconcat vconcat)")
+     (nconc . "(nconc &rest LISTS)")
+     (widget-apply . "(widget-apply WIDGET PROPERTY &rest ARGS)")
+     (make-hash-table . "(make-hash-table &rest KEYWORD-ARGS)")
+     (insert-string . "(insert-string &rest ARGS)")
+     (start-process . "(start-process NAME BUFFER PROGRAM &rest PROGRAM-ARGS)")
+     (setq-default . "(setq-default SYMBOL VALUE [SYMBOL VALUE...])")
+     (save-excursion . "(save-excursion &rest BODY)")
+     (save-current-buffer . "(save-current-buffer &rest BODY)")
+     (save-restriction . "(save-restriction &rest BODY)")
+     (or . "(or CONDITIONS ...)")
+     (and . "(and CONDITIONS ...)")
+     (if . "(if COND THEN ELSE...)")
+     (cond . "(cond CLAUSES...)")
+     (progn . "(progn BODY ...)")
+     (prog1 . "(prog1 FIRST BODY...)")
+     (prog2 . "(prog2 X Y BODY...)")
+     (setq . "(setq SYM VAL SYM VAL ...)")
+     (quote . "(quote ARG)")
+     (function . "(function ARG)")
+     (defun . "(defun NAME ARGLIST [DOCSTRING] BODY...)")
+     (defmacro . "(defmacro NAME ARGLIST [DOCSTRING] BODY...)")
+     (defvar . "(defvar SYMBOL [INITVALUE DOCSTRING])")
+     (defconst . "(defconst SYMBOL INITVALUE [DOCSTRING])")
+     (let* . "(let* VARLIST BODY...)")
+     (let . "(let VARLIST BODY...)")
+     (while . "(while TEST BODY...)")
+     (catch . "(catch TAG BODY...)")
+     (unwind-protect . "(unwind-protect BODYFORM UNWINDFORMS...)")
+     (condition-case . "(condition-case VAR BODYFORM HANDLERS...)")
+     (track-mouse . "(track-mouse BOFY ...)")
+     (ml-if . "(ml-if COND THEN ELSE...)")
+     (ml-provide-prefix-argument . "(ml-provide-prefix-argument ARG1 ARG2)")
+     (with-output-to-temp-buffer
+	 . "(with-output-to-temp-buffer BUFFNAME BODY ...)")
+     (save-window-excursion . "(save-window-excursion BODY ...)"))))
+
 ;;; help.el ends here