X-Git-Url: https://git.hcoop.net/bpt/emacs.git/blobdiff_plain/d2fc7e3d0f6f57f962cbd94df3bf4fd15a37bb68..91af3942e9ab5540b3ab4dde6733bc883dc2abdd:/lisp/help-fns.el

diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 97ce7ca44e..efdc237d11 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -65,7 +65,9 @@
 
 (defun help-split-fundoc (docstring def)
   "Split a function DOCSTRING into the actual doc and the usage info.
-Return (USAGE . DOC) or nil if there's no usage info.
+Return (USAGE . DOC) or nil if there's no usage info, where USAGE info
+is a string describing the argument list of DEF, such as
+\"(apply FUNCTION &rest ARGUMENTS)\".
 DEF is the function whose usage we're looking for in DOCSTRING."
   ;; Functions can get the calling sequence at the end of the doc string.
   ;; In cases where `function' has been fset to a subr we can't search for
@@ -156,12 +158,7 @@ the same names as used in the original source code, when possible."
 (defun help-make-usage (function arglist)
   (cons (if (symbolp function) function 'anonymous)
 	(mapcar (lambda (arg)
-		  (if (not (symbolp arg))
-		      (if (and (consp arg) (symbolp (car arg)))
-			  ;; CL style default values for optional args.
-			  (cons (intern (upcase (symbol-name (car arg))))
-				(cdr arg))
-			arg)
+		  (if (not (symbolp arg)) arg
 		    (let ((name (symbol-name arg)))
 		      (cond
                        ((string-match "\\`&" name) arg)
@@ -222,7 +219,7 @@ if the variable `help-downcase-arguments' is non-nil."
 (defun help-do-arg-highlight (doc args)
   (with-syntax-table (make-syntax-table emacs-lisp-mode-syntax-table)
     (modify-syntax-entry ?\- "w")
-    (dolist (arg args doc)
+    (dolist (arg args)
       (setq doc (replace-regexp-in-string
                  ;; This is heuristic, but covers all common cases
                  ;; except ARG1-ARG2
@@ -236,7 +233,8 @@ if the variable `help-downcase-arguments' is non-nil."
                          "\\(?:-[{([<`\"].*?\\)?"; for ARG-{x}, (x), <x>, [x], `x'
                          "\\>")                  ; end of word
                  (help-highlight-arg arg)
-                 doc t t 1)))))
+                 doc t t 1)))
+    doc))
 
 (defun help-highlight-arguments (usage doc &rest args)
   (when (and usage (string-match "^(" usage))
@@ -258,7 +256,7 @@ if the variable `help-downcase-arguments' is non-nil."
               ;; so let's skip over it
               (search-backward "(")
               (goto-char (scan-sexps (point) 1)))))
-        ;; Highlight aguments in the USAGE string
+        ;; Highlight arguments in the USAGE string
         (setq usage (help-do-arg-highlight (buffer-string) args))
         ;; Highlight arguments in the DOC string
         (setq doc (and doc (help-do-arg-highlight doc args))))))
@@ -557,6 +555,21 @@ suitable file is found, return nil."
 		(insert (car high) "\n")
 		(fill-region fill-begin (point)))
 	      (setq doc (cdr high))))
+
+	  ;; If this is a derived mode, link to the parent.
+	  (let ((parent-mode (and (symbolp real-function)
+				  (get real-function
+				       'derived-mode-parent))))
+	    (when parent-mode
+	      (with-current-buffer standard-output
+		(insert "\nParent mode: `")
+		(let ((beg (point)))
+		  (insert (format "%s" parent-mode))
+		  (make-text-button beg (point)
+				    'type 'help-function
+				    'help-args (list parent-mode))))
+	      (princ "'.\n")))
+
 	  (let* ((obsolete (and
 			    ;; function might be a lambda construct.
 			    (symbolp function)
@@ -715,12 +728,18 @@ it is displayed along with the global value."
 			  (delete-region (1- from) from)))))))
 	    (terpri)
 	    (when locus
-	      (if (bufferp locus)
-		  (princ (format "%socal in buffer %s; "
-				 (if (get variable 'permanent-local)
-				     "Permanently l" "L")
-				 (buffer-name)))
-		(princ (format "It is a frame-local variable; ")))
+	      (cond
+               ((bufferp locus)
+                (princ (format "%socal in buffer %s; "
+                               (if (get variable 'permanent-local)
+                                   "Permanently l" "L")
+                               (buffer-name))))
+               ((framep locus)
+                (princ (format "It is a frame-local variable; ")))
+               ((terminal-live-p locus)
+                (princ (format "It is a terminal-local variable; ")))
+               (t
+                (princ (format "It is local to %S" locus))))
 	      (if (not (default-boundp variable))
 		  (princ "globally void")
 		(let ((val (default-value variable)))
@@ -789,7 +808,8 @@ it is displayed along with the global value."
               (when obsolete
                 (setq extra-line t)
                 (princ "  This variable is obsolete")
-                (if (cdr obsolete) (princ (format " since %s" (cdr obsolete))))
+                (if (nth 2 obsolete)
+                    (princ (format " since %s" (nth 2 obsolete))))
 		(princ (cond ((stringp use) (concat ";\n  " use))
 			     (use (format ";\n  use `%s' instead." (car obsolete)))
 			     (t ".")))