aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorChong Yidong2014-01-03 13:37:58 +0800
committerChong Yidong2014-01-03 13:37:58 +0800
commit0d53f628be877abf2da4693df620d91d474ec058 (patch)
tree338b0147ef2192cb087849636437d287ea032012
parent6ef9aed822746c3daf05313bbc0df7dfa9f08171 (diff)
downloademacs-0d53f628be877abf2da4693df620d91d474ec058.tar.gz
emacs-0d53f628be877abf2da4693df620d91d474ec058.zip
Remove the dynamic-docstring-function feature.
* emacs-lisp/advice.el (ad--make-advised-docstring): Change args. Ignore function-documentation property when getting documentation. (ad-activate-advised-definition): Use function-documentation generate the docstring. (ad-make-advised-definition): Don't call ad-make-advised-definition-docstring. (ad-make-advised-definition-docstring, ad-advised-definition-p): Delete functions. * emacs-lisp/nadvice.el (advice--make-docstring): Change args. (advice--docstring): Delete variable. (advice--make-1): Leave the docstring empty. (advice-add): Use function-documentation for advised docstring. * progmodes/sql.el (sql-help): Use function-documentation instead of dynamic-docstring-function property. No need to autoload now. (sql--help-docstring): New variable. (sql--make-help-docstring): Use it. * doc.c (Fdocumentation): Remove dynamic-docstring-function.
-rw-r--r--etc/NEWS3
-rw-r--r--lisp/ChangeLog21
-rw-r--r--lisp/emacs-lisp/advice.el85
-rw-r--r--lisp/emacs-lisp/nadvice.el15
-rw-r--r--lisp/progmodes/sql.el46
-rw-r--r--src/ChangeLog4
-rw-r--r--src/doc.c15
7 files changed, 85 insertions, 104 deletions
diff --git a/etc/NEWS b/etc/NEWS
index 5762ebf0fcd..44764f3cde0 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -995,9 +995,6 @@ selected among several alternatives, as a matter of user preference.
995** The `defalias-fset-function' property lets you catch `defalias' 995** The `defalias-fset-function' property lets you catch `defalias'
996calls, and redirect them to your own function, instead of `fset'. 996calls, and redirect them to your own function, instead of `fset'.
997 997
998** Docstrings can be made dynamic by adding a `dynamic-docstring-function'
999text-property on the first char.
1000
1001+++ 998+++
1002** New variable `enable-dir-local-variables'. 999** New variable `enable-dir-local-variables'.
1003Directory-local variables are ignored if this is nil. This may be 1000Directory-local variables are ignored if this is nil. This may be
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 1ef042ede2a..6d5cadb7d78 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,24 @@
12014-01-03 Chong Yidong <cyd@gnu.org>
2
3 * emacs-lisp/nadvice.el (advice--make-docstring): Change args.
4 (advice--docstring): Delete variable.
5 (advice--make-1): Leave the docstring empty.
6 (advice-add): Use function-documentation for advised docstring.
7
8 * emacs-lisp/advice.el (ad--make-advised-docstring): Change args.
9 Ignore function-documentation property when getting documentation.
10 (ad-activate-advised-definition): Use function-documentation
11 generate the docstring.
12 (ad-make-advised-definition): Don't call
13 ad-make-advised-definition-docstring.
14 (ad-make-advised-definition-docstring, ad-advised-definition-p):
15 Delete functions.
16
17 * progmodes/sql.el (sql-help): Use function-documentation instead
18 of dynamic-docstring-function property. No need to autoload now.
19 (sql--help-docstring): New variable.
20 (sql--make-help-docstring): Use it.
21
12014-01-03 Stefan Monnier <monnier@iro.umontreal.ca> 222014-01-03 Stefan Monnier <monnier@iro.umontreal.ca>
2 23
3 * ielm.el (ielm-tab): Retarget. 24 * ielm.el (ielm-tab): Retarget.
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
index a368d0f1ff3..7f0f1506f49 100644
--- a/lisp/emacs-lisp/advice.el
+++ b/lisp/emacs-lisp/advice.el
@@ -2185,26 +2185,6 @@ Like `interactive-form', but also works on pieces of advice."
2185 (if (ad-interactive-form definition) 1 0)) 2185 (if (ad-interactive-form definition) 1 0))
2186 (cdr (cdr (ad-lambda-expression definition))))))) 2186 (cdr (cdr (ad-lambda-expression definition)))))))
2187 2187
2188(defun ad-make-advised-definition-docstring (_function)
2189 "Make an identifying docstring for the advised definition of FUNCTION.
2190Put function name into the documentation string so we can infer
2191the name of the advised function from the docstring. This is needed
2192to generate a proper advised docstring even if we are just given a
2193definition (see the code for `documentation')."
2194 (eval-when-compile
2195 (propertize "Advice function assembled by advice.el."
2196 'dynamic-docstring-function
2197 #'ad--make-advised-docstring)))
2198
2199(defun ad-advised-definition-p (definition)
2200 "Return non-nil if DEFINITION was generated from advice information."
2201 (if (or (ad-lambda-p definition)
2202 (macrop definition)
2203 (ad-compiled-p definition))
2204 (let ((docstring (ad-docstring definition)))
2205 (and (stringp docstring)
2206 (get-text-property 0 'dynamic-docstring-function docstring)))))
2207
2208(defun ad-definition-type (definition) 2188(defun ad-definition-type (definition)
2209 "Return symbol that describes the type of DEFINITION." 2189 "Return symbol that describes the type of DEFINITION."
2210 ;; These symbols are only ever used to check a cache entry's validity. 2190 ;; These symbols are only ever used to check a cache entry's validity.
@@ -2498,36 +2478,39 @@ Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
2498 2478
2499(require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage. 2479(require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage.
2500 2480
2501(defun ad--make-advised-docstring (origdoc function &optional style) 2481(defun ad--make-advised-docstring (function &optional style)
2502 "Construct a documentation string for the advised FUNCTION. 2482 "Construct a documentation string for the advised FUNCTION.
2503It concatenates the original documentation with the documentation 2483Concatenate the original documentation with the documentation
2504strings of the individual pieces of advice which will be formatted 2484strings of the individual pieces of advice. Optional argument
2505according to STYLE. STYLE can be `plain', everything else 2485STYLE specifies how to format the pieces of advice; it can be
2506will be interpreted as `default'. The order of the advice documentation 2486`plain', or any other value which means the default formatting.
2507strings corresponds to before/around/after and the individual ordering 2487
2508in any of these classes." 2488The advice documentation is shown in order of before/around/after
2509 (if (and (symbolp function) 2489advice type, obeying the priority in each of these types."
2510 (string-match "\\`ad-+Advice-" (symbol-name function))) 2490 ;; Retrieve the original function documentation
2511 (setq function 2491 (let* ((fun (get function 'function-documentation))
2512 (intern (substring (symbol-name function) (match-end 0))))) 2492 (origdoc (unwind-protect
2513 (let* ((usage (help-split-fundoc origdoc function)) 2493 (progn (put function 'function-documentation nil)
2514 paragraphs advice-docstring) 2494 (documentation function t))
2515 (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage))) 2495 (put function 'function-documentation fun))))
2516 (if origdoc (setq paragraphs (list origdoc))) 2496 (if (and (symbolp function)
2517 (dolist (class ad-advice-classes) 2497 (string-match "\\`ad-+Advice-" (symbol-name function)))
2518 (dolist (advice (ad-get-enabled-advices function class)) 2498 (setq function
2519 (setq advice-docstring 2499 (intern (substring (symbol-name function) (match-end 0)))))
2520 (ad-make-single-advice-docstring advice class style)) 2500 (let* ((usage (help-split-fundoc origdoc function))
2521 (if advice-docstring 2501 paragraphs advice-docstring)
2522 (push advice-docstring paragraphs)))) 2502 (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
2523 (setq origdoc (if paragraphs 2503 (if origdoc (setq paragraphs (list origdoc)))
2524 (propertize 2504 (dolist (class ad-advice-classes)
2525 ;; separate paragraphs with blank lines: 2505 (dolist (advice (ad-get-enabled-advices function class))
2526 (mapconcat 'identity (nreverse paragraphs) "\n\n") 2506 (setq advice-docstring
2527 ;; FIXME: what is this for? 2507 (ad-make-single-advice-docstring advice class style))
2528 'dynamic-docstring-function 2508 (if advice-docstring
2529 #'ad--make-advised-docstring))) 2509 (push advice-docstring paragraphs))))
2530 (help-add-fundoc-usage origdoc usage))) 2510 (setq origdoc (if paragraphs
2511 (mapconcat 'identity (nreverse paragraphs)
2512 "\n\n")))
2513 (help-add-fundoc-usage origdoc usage))))
2531 2514
2532 2515
2533;; @@@ Accessing overriding arglists and interactive forms: 2516;; @@@ Accessing overriding arglists and interactive forms:
@@ -2575,7 +2558,7 @@ in any of these classes."
2575 ;; Finally, build the sucker: 2558 ;; Finally, build the sucker:
2576 (ad-assemble-advised-definition 2559 (ad-assemble-advised-definition
2577 advised-arglist 2560 advised-arglist
2578 (ad-make-advised-definition-docstring function) 2561 nil
2579 interactive-form 2562 interactive-form
2580 orig-form 2563 orig-form
2581 (ad-get-enabled-advices function 'before) 2564 (ad-get-enabled-advices function 'before)
@@ -2889,6 +2872,8 @@ The current definition and its cache-id will be put into the cache."
2889 (fset advicefunname 2872 (fset advicefunname
2890 (or verified-cached-definition 2873 (or verified-cached-definition
2891 (ad-make-advised-definition function))) 2874 (ad-make-advised-definition function)))
2875 (put advicefunname 'function-documentation
2876 `(ad--make-advised-docstring ',advicefunname))
2892 (unless (equal (interactive-form advicefunname) old-ispec) 2877 (unless (equal (interactive-form advicefunname) old-ispec)
2893 ;; If the interactive-spec of advicefunname has changed, force nadvice to 2878 ;; If the interactive-spec of advicefunname has changed, force nadvice to
2894 ;; refresh its copy. 2879 ;; refresh its copy.
diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 97b7eec686a..3dfeb04a9b3 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -67,8 +67,8 @@ Each element has the form (WHERE BYTECODE STACK) where:
67(defsubst advice--cdr (f) (aref (aref f 2) 2)) 67(defsubst advice--cdr (f) (aref (aref f 2) 2))
68(defsubst advice--props (f) (aref (aref f 2) 3)) 68(defsubst advice--props (f) (aref (aref f 2) 3))
69 69
70(defun advice--make-docstring (_string function) 70(defun advice--make-docstring (function)
71 "Build the raw doc-string of SYMBOL, presumably advised." 71 "Build the raw docstring for FUNCTION, presumably advised."
72 (let ((flist (indirect-function function)) 72 (let ((flist (indirect-function function))
73 (docstring nil)) 73 (docstring nil))
74 (if (eq 'macro (car-safe flist)) (setq flist (cdr flist))) 74 (if (eq 'macro (car-safe flist)) (setq flist (cdr flist)))
@@ -105,13 +105,6 @@ Each element has the form (WHERE BYTECODE STACK) where:
105 (setq origdoc (cdr usage)) (car usage))) 105 (setq origdoc (cdr usage)) (car usage)))
106 (help-add-fundoc-usage (concat docstring origdoc) usage)))) 106 (help-add-fundoc-usage (concat docstring origdoc) usage))))
107 107
108(defvar advice--docstring
109 ;; Can't eval-when-compile nor use defconst because it then gets pure-copied,
110 ;; which drops the text-properties.
111 ;;(eval-when-compile
112 (propertize "Advised function"
113 'dynamic-docstring-function #'advice--make-docstring)) ;; )
114
115(defun advice-eval-interactive-spec (spec) 108(defun advice-eval-interactive-spec (spec)
116 "Evaluate the interactive spec SPEC." 109 "Evaluate the interactive spec SPEC."
117 (cond 110 (cond
@@ -144,7 +137,7 @@ Each element has the form (WHERE BYTECODE STACK) where:
144 (advice 137 (advice
145 (apply #'make-byte-code 128 byte-code 138 (apply #'make-byte-code 128 byte-code
146 (vector #'apply function main props) stack-depth 139 (vector #'apply function main props) stack-depth
147 advice--docstring 140 nil
148 (and (or (commandp function) (commandp main)) 141 (and (or (commandp function) (commandp main))
149 (not (and (symbolp main) ;; Don't autoload too eagerly! 142 (not (and (symbolp main) ;; Don't autoload too eagerly!
150 (autoloadp (symbol-function main)))) 143 (autoloadp (symbol-function main))))
@@ -370,7 +363,6 @@ of the piece of advice."
370 (unless (eq oldadv (get symbol 'advice--pending)) 363 (unless (eq oldadv (get symbol 'advice--pending))
371 (put symbol 'advice--pending (advice--subst-main oldadv nil))) 364 (put symbol 'advice--pending (advice--subst-main oldadv nil)))
372 (funcall fsetfun symbol newdef)))) 365 (funcall fsetfun symbol newdef))))
373
374 366
375;;;###autoload 367;;;###autoload
376(defun advice-add (symbol where function &optional props) 368(defun advice-add (symbol where function &optional props)
@@ -398,6 +390,7 @@ is defined as a macro, alias, command, ..."
398 (get symbol 'advice--pending)) 390 (get symbol 'advice--pending))
399 (t (symbol-function symbol))) 391 (t (symbol-function symbol)))
400 function props) 392 function props)
393 (put symbol 'function-documentation `(advice--make-docstring ',symbol))
401 (add-function :around (get symbol 'defalias-fset-function) 394 (add-function :around (get symbol 'defalias-fset-function)
402 #'advice--defalias-fset)) 395 #'advice--defalias-fset))
403 nil) 396 nil)
diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index d92d6a66ed2..eb8e0760e25 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -2826,14 +2826,14 @@ each line with INDENT."
2826 "]\n")))) 2826 "]\n"))))
2827 doc)) 2827 doc))
2828 2828
2829;;;###autoload 2829(defun sql-help ()
2830(eval 2830 "Show short help for the SQL modes."
2831 ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled 2831 (interactive)
2832 ;; functions, because of the lazy-loading of docstrings, which strips away 2832 (describe-function 'sql-help))
2833 ;; text properties. 2833(put 'sql-help 'function-documentation '(sql--make-help-docstring))
2834 '(defun sql-help ()
2835 #("Show short help for the SQL modes.
2836 2834
2835(defvar sql--help-docstring
2836 "Show short help for the SQL modes.
2837Use an entry function to open an interactive SQL buffer. This buffer is 2837Use an entry function to open an interactive SQL buffer. This buffer is
2838usually named `*SQL*'. The name of the major mode is SQLi. 2838usually named `*SQL*'. The name of the major mode is SQLi.
2839 2839
@@ -2862,24 +2862,20 @@ anything. The name of the major mode is SQL.
2862 2862
2863In this SQL buffer (SQL mode), you can send the region or the entire 2863In this SQL buffer (SQL mode), you can send the region or the entire
2864buffer to the interactive SQL buffer (SQLi mode). The results are 2864buffer to the interactive SQL buffer (SQLi mode). The results are
2865appended to the SQLi buffer without disturbing your SQL buffer." 2865appended to the SQLi buffer without disturbing your SQL buffer.")
2866 0 1 (dynamic-docstring-function sql--make-help-docstring)) 2866
2867 (interactive) 2867(defun sql--make-help-docstring ()
2868 (describe-function 'sql-help))) 2868 "Return a docstring for `sql-help' listing loaded SQL products."
2869 2869 (let ((doc sql--help-docstring))
2870(defun sql--make-help-docstring (doc _fun) 2870 ;; Insert FREE software list
2871 "Insert references to loaded products into the help buffer string." 2871 (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*$" doc 0)
2872 2872 (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
2873 ;; Insert FREE software list 2873 t t doc 0)))
2874 (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0) 2874 ;; Insert non-FREE software list
2875 (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t) 2875 (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*$" doc 0)
2876 t t doc 0))) 2876 (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
2877 2877 t t doc 0)))
2878 ;; Insert non-FREE software list 2878 doc))
2879 (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
2880 (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
2881 t t doc 0)))
2882 doc)
2883 2879
2884(defun sql-default-value (var) 2880(defun sql-default-value (var)
2885 "Fetch the value of a variable. 2881 "Fetch the value of a variable.
diff --git a/src/ChangeLog b/src/ChangeLog
index 325e428bfeb..1f68372f31a 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,7 @@
12014-01-03 Chong Yidong <cyd@gnu.org>
2
3 * doc.c (Fdocumentation): Remove dynamic-docstring-function.
4
12014-01-02 Martin Rudalics <rudalics@gmx.at> 52014-01-02 Martin Rudalics <rudalics@gmx.at>
2 6
3 Further adjust frame/window scrollbar width calculations. 7 Further adjust frame/window scrollbar width calculations.
diff --git a/src/doc.c b/src/doc.c
index 0d9c8021cdf..ecefd776b85 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -416,21 +416,6 @@ string is passed through `substitute-command-keys'. */)
416 xsignal1 (Qinvalid_function, fun); 416 xsignal1 (Qinvalid_function, fun);
417 } 417 }
418 418
419 /* Check for a dynamic docstring. These come with
420 a dynamic-docstring-function text property. */
421 if (STRINGP (doc))
422 {
423 Lisp_Object func
424 = Fget_text_property (make_number (0),
425 intern ("dynamic-docstring-function"),
426 doc);
427 if (!NILP (func))
428 /* Pass both `doc' and `function' since `function' can be needed, and
429 finding `doc' can be annoying: calling `documentation' is not an
430 option because it would infloop. */
431 doc = call2 (func, doc, function);
432 }
433
434 /* If DOC is 0, it's typically because of a dumped file missing 419 /* If DOC is 0, it's typically because of a dumped file missing
435 from the DOC file (bug in src/Makefile.in). */ 420 from the DOC file (bug in src/Makefile.in). */
436 if (EQ (doc, make_number (0))) 421 if (EQ (doc, make_number (0)))