* 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.
** The `defalias-fset-function' property lets you catch `defalias'
calls, and redirect them to your own function, instead of `fset'.
-** Docstrings can be made dynamic by adding a `dynamic-docstring-function'
-text-property on the first char.
-
+++
** New variable `enable-dir-local-variables'.
Directory-local variables are ignored if this is nil. This may be
+2014-01-03 Chong Yidong <cyd@gnu.org>
+
+ * 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.
+
+ * 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.
+
+ * 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.
+
2014-01-03 Stefan Monnier <monnier@iro.umontreal.ca>
* ielm.el (ielm-tab): Retarget.
(if (ad-interactive-form definition) 1 0))
(cdr (cdr (ad-lambda-expression definition)))))))
-(defun ad-make-advised-definition-docstring (_function)
- "Make an identifying docstring for the advised definition of FUNCTION.
-Put function name into the documentation string so we can infer
-the name of the advised function from the docstring. This is needed
-to generate a proper advised docstring even if we are just given a
-definition (see the code for `documentation')."
- (eval-when-compile
- (propertize "Advice function assembled by advice.el."
- 'dynamic-docstring-function
- #'ad--make-advised-docstring)))
-
-(defun ad-advised-definition-p (definition)
- "Return non-nil if DEFINITION was generated from advice information."
- (if (or (ad-lambda-p definition)
- (macrop definition)
- (ad-compiled-p definition))
- (let ((docstring (ad-docstring definition)))
- (and (stringp docstring)
- (get-text-property 0 'dynamic-docstring-function docstring)))))
-
(defun ad-definition-type (definition)
"Return symbol that describes the type of DEFINITION."
;; These symbols are only ever used to check a cache entry's validity.
(require 'help-fns) ;For help-split-fundoc and help-add-fundoc-usage.
-(defun ad--make-advised-docstring (origdoc function &optional style)
+(defun ad--make-advised-docstring (function &optional style)
"Construct a documentation string for the advised FUNCTION.
-It concatenates the original documentation with the documentation
-strings of the individual pieces of advice which will be formatted
-according to STYLE. STYLE can be `plain', everything else
-will be interpreted as `default'. The order of the advice documentation
-strings corresponds to before/around/after and the individual ordering
-in any of these classes."
- (if (and (symbolp function)
- (string-match "\\`ad-+Advice-" (symbol-name function)))
- (setq function
- (intern (substring (symbol-name function) (match-end 0)))))
- (let* ((usage (help-split-fundoc origdoc function))
- paragraphs advice-docstring)
- (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
- (if origdoc (setq paragraphs (list origdoc)))
- (dolist (class ad-advice-classes)
- (dolist (advice (ad-get-enabled-advices function class))
- (setq advice-docstring
- (ad-make-single-advice-docstring advice class style))
- (if advice-docstring
- (push advice-docstring paragraphs))))
- (setq origdoc (if paragraphs
- (propertize
- ;; separate paragraphs with blank lines:
- (mapconcat 'identity (nreverse paragraphs) "\n\n")
- ;; FIXME: what is this for?
- 'dynamic-docstring-function
- #'ad--make-advised-docstring)))
- (help-add-fundoc-usage origdoc usage)))
+Concatenate the original documentation with the documentation
+strings of the individual pieces of advice. Optional argument
+STYLE specifies how to format the pieces of advice; it can be
+`plain', or any other value which means the default formatting.
+
+The advice documentation is shown in order of before/around/after
+advice type, obeying the priority in each of these types."
+ ;; Retrieve the original function documentation
+ (let* ((fun (get function 'function-documentation))
+ (origdoc (unwind-protect
+ (progn (put function 'function-documentation nil)
+ (documentation function t))
+ (put function 'function-documentation fun))))
+ (if (and (symbolp function)
+ (string-match "\\`ad-+Advice-" (symbol-name function)))
+ (setq function
+ (intern (substring (symbol-name function) (match-end 0)))))
+ (let* ((usage (help-split-fundoc origdoc function))
+ paragraphs advice-docstring)
+ (setq usage (if (null usage) t (setq origdoc (cdr usage)) (car usage)))
+ (if origdoc (setq paragraphs (list origdoc)))
+ (dolist (class ad-advice-classes)
+ (dolist (advice (ad-get-enabled-advices function class))
+ (setq advice-docstring
+ (ad-make-single-advice-docstring advice class style))
+ (if advice-docstring
+ (push advice-docstring paragraphs))))
+ (setq origdoc (if paragraphs
+ (mapconcat 'identity (nreverse paragraphs)
+ "\n\n")))
+ (help-add-fundoc-usage origdoc usage))))
;; @@@ Accessing overriding arglists and interactive forms:
;; Finally, build the sucker:
(ad-assemble-advised-definition
advised-arglist
- (ad-make-advised-definition-docstring function)
+ nil
interactive-form
orig-form
(ad-get-enabled-advices function 'before)
(fset advicefunname
(or verified-cached-definition
(ad-make-advised-definition function)))
+ (put advicefunname 'function-documentation
+ `(ad--make-advised-docstring ',advicefunname))
(unless (equal (interactive-form advicefunname) old-ispec)
;; If the interactive-spec of advicefunname has changed, force nadvice to
;; refresh its copy.
(defsubst advice--cdr (f) (aref (aref f 2) 2))
(defsubst advice--props (f) (aref (aref f 2) 3))
-(defun advice--make-docstring (_string function)
- "Build the raw doc-string of SYMBOL, presumably advised."
+(defun advice--make-docstring (function)
+ "Build the raw docstring for FUNCTION, presumably advised."
(let ((flist (indirect-function function))
(docstring nil))
(if (eq 'macro (car-safe flist)) (setq flist (cdr flist)))
(setq origdoc (cdr usage)) (car usage)))
(help-add-fundoc-usage (concat docstring origdoc) usage))))
-(defvar advice--docstring
- ;; Can't eval-when-compile nor use defconst because it then gets pure-copied,
- ;; which drops the text-properties.
- ;;(eval-when-compile
- (propertize "Advised function"
- 'dynamic-docstring-function #'advice--make-docstring)) ;; )
-
(defun advice-eval-interactive-spec (spec)
"Evaluate the interactive spec SPEC."
(cond
(advice
(apply #'make-byte-code 128 byte-code
(vector #'apply function main props) stack-depth
- advice--docstring
+ nil
(and (or (commandp function) (commandp main))
(not (and (symbolp main) ;; Don't autoload too eagerly!
(autoloadp (symbol-function main))))
(unless (eq oldadv (get symbol 'advice--pending))
(put symbol 'advice--pending (advice--subst-main oldadv nil)))
(funcall fsetfun symbol newdef))))
-
;;;###autoload
(defun advice-add (symbol where function &optional props)
(get symbol 'advice--pending))
(t (symbol-function symbol)))
function props)
+ (put symbol 'function-documentation `(advice--make-docstring ',symbol))
(add-function :around (get symbol 'defalias-fset-function)
#'advice--defalias-fset))
nil)
"]\n"))))
doc))
-;;;###autoload
-(eval
- ;; FIXME: This dynamic-docstring-function trick doesn't work for byte-compiled
- ;; functions, because of the lazy-loading of docstrings, which strips away
- ;; text properties.
- '(defun sql-help ()
- #("Show short help for the SQL modes.
+(defun sql-help ()
+ "Show short help for the SQL modes."
+ (interactive)
+ (describe-function 'sql-help))
+(put 'sql-help 'function-documentation '(sql--make-help-docstring))
+(defvar sql--help-docstring
+ "Show short help for the SQL modes.
Use an entry function to open an interactive SQL buffer. This buffer is
usually named `*SQL*'. The name of the major mode is SQLi.
In this SQL buffer (SQL mode), you can send the region or the entire
buffer to the interactive SQL buffer (SQLi mode). The results are
-appended to the SQLi buffer without disturbing your SQL buffer."
- 0 1 (dynamic-docstring-function sql--make-help-docstring))
- (interactive)
- (describe-function 'sql-help)))
-
-(defun sql--make-help-docstring (doc _fun)
- "Insert references to loaded products into the help buffer string."
-
- ;; Insert FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
- t t doc 0)))
-
- ;; Insert non-FREE software list
- (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*\n" doc 0)
- (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
- t t doc 0)))
- doc)
+appended to the SQLi buffer without disturbing your SQL buffer.")
+
+(defun sql--make-help-docstring ()
+ "Return a docstring for `sql-help' listing loaded SQL products."
+ (let ((doc sql--help-docstring))
+ ;; Insert FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]FREE\\s-*$" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) t)
+ t t doc 0)))
+ ;; Insert non-FREE software list
+ (when (string-match "^\\(\\s-*\\)[\\\\][\\\\]NONFREE\\s-*$" doc 0)
+ (setq doc (replace-match (sql-help-list-products (match-string 1 doc) nil)
+ t t doc 0)))
+ doc))
(defun sql-default-value (var)
"Fetch the value of a variable.
+2014-01-03 Chong Yidong <cyd@gnu.org>
+
+ * doc.c (Fdocumentation): Remove dynamic-docstring-function.
+
2014-01-02 Martin Rudalics <rudalics@gmx.at>
Further adjust frame/window scrollbar width calculations.
xsignal1 (Qinvalid_function, fun);
}
- /* Check for a dynamic docstring. These come with
- a dynamic-docstring-function text property. */
- if (STRINGP (doc))
- {
- Lisp_Object func
- = Fget_text_property (make_number (0),
- intern ("dynamic-docstring-function"),
- doc);
- if (!NILP (func))
- /* Pass both `doc' and `function' since `function' can be needed, and
- finding `doc' can be annoying: calling `documentation' is not an
- option because it would infloop. */
- doc = call2 (func, doc, function);
- }
-
/* If DOC is 0, it's typically because of a dumped file missing
from the DOC file (bug in src/Makefile.in). */
if (EQ (doc, make_number (0)))
projects / emacs.git / commitdiff