aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--lisp/emacs-lisp/nadvice.el2
-rw-r--r--lisp/emacs-lisp/pcase.el6
-rw-r--r--lisp/help-fns.el53
-rw-r--r--lisp/help.el31
-rw-r--r--lisp/progmodes/elisp-mode.el2
-rw-r--r--test/automated/help-fns.el23
6 files changed, 79 insertions, 38 deletions
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index faebe269044..a6db5e9e696 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -114,7 +114,7 @@ Each element has the form (WHERE BYTECODE STACK) where:
114 (usage (help-split-fundoc origdoc function))) 114 (usage (help-split-fundoc origdoc function)))
115 (setq usage (if (null usage) 115 (setq usage (if (null usage)
116 (let ((arglist (help-function-arglist flist))) 116 (let ((arglist (help-function-arglist flist)))
117 (format "%S" (help-make-usage function arglist))) 117 (help--make-usage-docstring function arglist))
118 (setq origdoc (cdr usage)) (car usage))) 118 (setq origdoc (cdr usage)) (car usage)))
119 (help-add-fundoc-usage (concat docstring origdoc) usage)))) 119 (help-add-fundoc-usage (concat docstring origdoc) usage))))
120 120
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index ab82b7eaef3..0d3b21b8330 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -163,7 +163,7 @@ Currently, the following patterns are provided this way:"
163 expansion)))) 163 expansion))))
164 164
165(declare-function help-fns--signature "help-fns" 165(declare-function help-fns--signature "help-fns"
166 (function doc real-def real-function)) 166 (function doc real-def real-function raw))
167 167
168;; FIXME: Obviously, this will collide with nadvice's use of 168;; FIXME: Obviously, this will collide with nadvice's use of
169;; function-documentation if we happen to advise `pcase'. 169;; function-documentation if we happen to advise `pcase'.
@@ -183,7 +183,7 @@ Currently, the following patterns are provided this way:"
183 (insert "\n\n-- ") 183 (insert "\n\n-- ")
184 (let* ((doc (documentation me 'raw))) 184 (let* ((doc (documentation me 'raw)))
185 (setq doc (help-fns--signature symbol doc me 185 (setq doc (help-fns--signature symbol doc me
186 (indirect-function me))) 186 (indirect-function me) t))
187 (insert "\n" (or doc "Not documented."))))))) 187 (insert "\n" (or doc "Not documented.")))))))
188 (let ((combined-doc (buffer-string))) 188 (let ((combined-doc (buffer-string)))
189 (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))))) 189 (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc)))))
@@ -870,7 +870,7 @@ QPAT can take the following forms:
870 (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr. 870 (QPAT1 . QPAT2) matches if QPAT1 matches the car and QPAT2 the cdr.
871 [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match 871 [QPAT1 QPAT2..QPATn] matches a vector of length n and QPAT1..QPATn match
872 its 0..(n-1)th elements, respectively. 872 its 0..(n-1)th elements, respectively.
873 ,PAT matches if the pattern PAT matches. 873 ,PAT matches if the pattern PAT matches.
874 STRING matches if the object is `equal' to STRING. 874 STRING matches if the object is `equal' to STRING.
875 ATOM matches if the object is `eq' to ATOM." 875 ATOM matches if the object is `eq' to ATOM."
876 (declare (debug (pcase-QPAT))) 876 (declare (debug (pcase-QPAT)))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index d59eeab83e3..931e8af4df0 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -353,7 +353,7 @@ suitable file is found, return nil."
353 (help-xref-button 1 'help-function-cmacro function lib))))) 353 (help-xref-button 1 'help-function-cmacro function lib)))))
354 (insert ".\n")))) 354 (insert ".\n"))))
355 355
356(defun help-fns--signature (function doc real-def real-function) 356(defun help-fns--signature (function doc real-def real-function raw)
357 "Insert usage at point and return docstring. With highlighting." 357 "Insert usage at point and return docstring. With highlighting."
358 (if (keymapp function) 358 (if (keymapp function)
359 doc ; If definition is a keymap, skip arglist note. 359 doc ; If definition is a keymap, skip arglist note.
@@ -365,7 +365,7 @@ suitable file is found, return nil."
365 (let* ((use (cond 365 (let* ((use (cond
366 ((and usage (not (listp advertised))) (car usage)) 366 ((and usage (not (listp advertised))) (car usage))
367 ((listp arglist) 367 ((listp arglist)
368 (format "%S" (help-make-usage function arglist))) 368 (help--make-usage-docstring function arglist))
369 ((stringp arglist) arglist) 369 ((stringp arglist) arglist)
370 ;; Maybe the arglist is in the docstring of a symbol 370 ;; Maybe the arglist is in the docstring of a symbol
371 ;; this one is aliased to. 371 ;; this one is aliased to.
@@ -379,16 +379,20 @@ suitable file is found, return nil."
379 (car usage)) 379 (car usage))
380 ((or (stringp real-def) 380 ((or (stringp real-def)
381 (vectorp real-def)) 381 (vectorp real-def))
382 (format "\nMacro: %s" (format-kbd-macro real-def))) 382 (format "\nMacro: %s"
383 (help--docstring-quote
384 (format-kbd-macro real-def))))
383 (t "[Missing arglist. Please make a bug report.]"))) 385 (t "[Missing arglist. Please make a bug report.]")))
384 (high (help-highlight-arguments 386 (high (if raw
385 ;; Quote any quotes in the function name (bug#20759). 387 (cons use doc)
386 (replace-regexp-in-string "\\(\\)[`']" "\\=" use t t 1) 388 (help-highlight-arguments (substitute-command-keys use)
387 doc))) 389 (substitute-command-keys doc)))))
388 (let ((fill-begin (point))) 390 (let ((fill-begin (point))
389 (insert (car high) "\n") 391 (high-usage (car high))
390 (fill-region fill-begin (point))) 392 (high-doc (cdr high)))
391 (cdr high))))) 393 (insert high-usage "\n")
394 (fill-region fill-begin (point))
395 high-doc)))))
392 396
393(defun help-fns--parent-mode (function) 397(defun help-fns--parent-mode (function)
394 ;; If this is a derived mode, link to the parent. 398 ;; If this is a derived mode, link to the parent.
@@ -579,23 +583,22 @@ FILE is the file where FUNCTION was probably defined."
579 (point))) 583 (point)))
580 (terpri)(terpri) 584 (terpri)(terpri)
581 585
582 (let* ((doc-raw (documentation function t)) 586 (let ((doc-raw (documentation function t)))
583 ;; If the function is autoloaded, and its docstring has 587
584 ;; key substitution constructs, load the library. 588 ;; If the function is autoloaded, and its docstring has
585 (doc (progn 589 ;; key substitution constructs, load the library.
586 (and (autoloadp real-def) doc-raw 590 (and (autoloadp real-def) doc-raw
587 help-enable-auto-load 591 help-enable-auto-load
588 (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" 592 (string-match "\\([^\\]=\\|[^=]\\|\\`\\)\\\\[[{<]" doc-raw)
589 doc-raw) 593 (autoload-do-load real-def))
590 (autoload-do-load real-def))
591 (substitute-command-keys doc-raw))))
592 594
593 (help-fns--key-bindings function) 595 (help-fns--key-bindings function)
594 (with-current-buffer standard-output 596 (with-current-buffer standard-output
595 (setq doc (help-fns--signature function doc sig-key real-function)) 597 (let ((doc (help-fns--signature function doc-raw sig-key
596 (run-hook-with-args 'help-fns-describe-function-functions function) 598 real-function nil)))
597 (insert "\n" 599 (run-hook-with-args 'help-fns-describe-function-functions function)
598 (or doc "Not documented."))))))) 600 (insert "\n"
601 (or doc "Not documented."))))))))
599 602
600;; Add defaults to `help-fns-describe-function-functions'. 603;; Add defaults to `help-fns-describe-function-functions'.
601(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete) 604(add-hook 'help-fns-describe-function-functions #'help-fns--obsolete)
diff --git a/lisp/help.el b/lisp/help.el
index fd5cbc66ab2..b766cd0e983 100644
--- a/lisp/help.el
+++ b/lisp/help.el
@@ -1349,6 +1349,11 @@ the help window if the current value of the user option
1349 (princ msg))))) 1349 (princ msg)))))
1350 1350
1351 1351
1352(defun help--docstring-quote (string)
1353 "Return a doc string that represents STRING.
1354The result, when formatted by ‘substitute-command-keys’, should equal STRING."
1355 (replace-regexp-in-string "['\\`]" "\\\\=\\&" string))
1356
1352;; The following functions used to be in help-fns.el, which is not preloaded. 1357;; The following functions used to be in help-fns.el, which is not preloaded.
1353;; But for various reasons, they are more widely needed, so they were 1358;; But for various reasons, they are more widely needed, so they were
1354;; moved to this file, which is preloaded. http://debbugs.gnu.org/17001 1359;; moved to this file, which is preloaded. http://debbugs.gnu.org/17001
@@ -1364,12 +1369,17 @@ DEF is the function whose usage we're looking for in DOCSTRING."
1364 ;; function's name in the doc string so we use `fn' as the anonymous 1369 ;; function's name in the doc string so we use `fn' as the anonymous
1365 ;; function name instead. 1370 ;; function name instead.
1366 (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)) 1371 (when (and docstring (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring))
1367 (cons (format "(%s%s" 1372 (let ((doc (unless (zerop (match-beginning 0))
1368 ;; Replace `fn' with the actual function name. 1373 (substring docstring 0 (match-beginning 0))))
1369 (if (symbolp def) def "anonymous") 1374 (usage-tail (match-string 1 docstring)))
1370 (match-string 1 docstring)) 1375 (cons (format "(%s%s"
1371 (unless (zerop (match-beginning 0)) 1376 ;; Replace `fn' with the actual function name.
1372 (substring docstring 0 (match-beginning 0)))))) 1377 (if (symbolp def)
1378 (help--docstring-quote
1379 (substring (format "%S" (list def)) 1 -1))
1380 'anonymous)
1381 usage-tail)
1382 doc))))
1373 1383
1374(defun help-add-fundoc-usage (docstring arglist) 1384(defun help-add-fundoc-usage (docstring arglist)
1375 "Add the usage info to DOCSTRING. 1385 "Add the usage info to DOCSTRING.
@@ -1387,7 +1397,7 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
1387 (if (and (stringp arglist) 1397 (if (and (stringp arglist)
1388 (string-match "\\`([^ ]+\\(.*\\))\\'" arglist)) 1398 (string-match "\\`([^ ]+\\(.*\\))\\'" arglist))
1389 (concat "(fn" (match-string 1 arglist) ")") 1399 (concat "(fn" (match-string 1 arglist) ")")
1390 (format "%S" (help-make-usage 'fn arglist)))))) 1400 (help--make-usage-docstring 'fn arglist)))))
1391 1401
1392(defun help-function-arglist (def &optional preserve-names) 1402(defun help-function-arglist (def &optional preserve-names)
1393 "Return a formal argument list for the function DEF. 1403 "Return a formal argument list for the function DEF.
@@ -1442,7 +1452,7 @@ the same names as used in the original source code, when possible."
1442 "[Arg list not available until function definition is loaded.]") 1452 "[Arg list not available until function definition is loaded.]")
1443 (t t))) 1453 (t t)))
1444 1454
1445(defun help-make-usage (function arglist) 1455(defun help--make-usage (function arglist)
1446 (cons (if (symbolp function) function 'anonymous) 1456 (cons (if (symbolp function) function 'anonymous)
1447 (mapcar (lambda (arg) 1457 (mapcar (lambda (arg)
1448 (if (not (symbolp arg)) arg 1458 (if (not (symbolp arg)) arg
@@ -1454,6 +1464,11 @@ the same names as used in the original source code, when possible."
1454 (t (intern (upcase name))))))) 1464 (t (intern (upcase name)))))))
1455 arglist))) 1465 arglist)))
1456 1466
1467(define-obsolete-function-alias 'help-make-usage 'help--make-usage "25.1")
1468
1469(defun help--make-usage-docstring (fn arglist)
1470 (help--docstring-quote (format "%S" (help--make-usage fn arglist))))
1471
1457 1472
1458(provide 'help) 1473(provide 'help)
1459 1474
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 5d5f258ce77..11c9b16a3c9 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1436,7 +1436,7 @@ In the absence of INDEX, just call `eldoc-docstring-format-sym-doc'."
1436ARGLIST is either a string, or a list of strings or symbols." 1436ARGLIST is either a string, or a list of strings or symbols."
1437 (let ((str (cond ((stringp arglist) arglist) 1437 (let ((str (cond ((stringp arglist) arglist)
1438 ((not (listp arglist)) nil) 1438 ((not (listp arglist)) nil)
1439 (t (format "%S" (help-make-usage 'toto arglist)))))) 1439 (t (help--make-usage-docstring 'toto arglist)))))
1440 (if (and str (string-match "\\`([^ )]+ ?" str)) 1440 (if (and str (string-match "\\`([^ )]+ ?" str))
1441 (replace-match "(" t t str) 1441 (replace-match "(" t t str)
1442 str))) 1442 str)))
diff --git a/test/automated/help-fns.el b/test/automated/help-fns.el
index ba87593f420..4815ac68257 100644
--- a/test/automated/help-fns.el
+++ b/test/automated/help-fns.el
@@ -34,4 +34,27 @@
34 (goto-char (point-min)) 34 (goto-char (point-min))
35 (should (search-forward "autoloaded Lisp macro" (line-end-position))))) 35 (should (search-forward "autoloaded Lisp macro" (line-end-position)))))
36 36
37(defun abc\\\[universal-argument\]b\`c\'d\\e\"f (x)
38 "A function with a funny name.
39
40\(fn XYYZZY)"
41 x)
42
43(defun defgh\\\[universal-argument\]b\`c\'d\\e\"f (x)
44 "Another function with a funny name."
45 x)
46
47(ert-deftest help-fns-test-funny-names ()
48 "Test for help with functions with funny names."
49 (describe-function 'abc\\\[universal-argument\]b\`c\'d\\e\"f)
50 (with-current-buffer "*Help*"
51 (goto-char (point-min))
52 (should (search-forward
53 "(abc\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f XYYZZY)")))
54 (describe-function 'defgh\\\[universal-argument\]b\`c\'d\\e\"f)
55 (with-current-buffer "*Help*"
56 (goto-char (point-min))
57 (should (search-forward
58 "(defgh\\\\\\[universal-argument\\]b\\`c\\'d\\\\e\\\"f X)"))))
59
37;;; help-fns.el ends here 60;;; help-fns.el ends here