mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

* lisp/emacs-lisp/nadvice.el (advice--make-docstring): Try harder to find

Browse source 
the docstring of functions advised before dumping.
* src/doc.c (store_function_docstring): Warn when we don't know where to
put a docstring.
(Fsubstitute_command_keys): Don't advertise the fact that
text-properties are dropped, since we think it's a bug that we'll fix
in 24.5.

Fixes: debbugs:16993
This commit is contained in:
Stefan Monnier 2014-03-20 12:00:17 -04:00
parent caecb91c58
commit 049fac7c94
4 changed files with 27 additions and 5 deletions
Download patch file Download diff file Expand all files Collapse all files

16
lisp/emacs-lisp/nadvice.el
View file

@ -74,12 +74,19 @@ Each element has the form (WHERE BYTECODE STACK) where:
(defun advice--make-docstring (function)
"Build the raw docstring for FUNCTION, presumably advised."
(let ((flist (indirect-function function))
(docstring nil))
(let* ((flist (indirect-function function))
(docfun nil)
(docstring nil))
(if (eq 'macro (car-safe flist)) (setq flist (cdr flist)))
(while (advice--p flist)
(let ((bytecode (aref flist 1))
(doc (aref flist 4))
(where nil))
;; Hack attack! For advices installed before calling
;; Snarf-documentation, the integer offset into the DOC file will not
;; be installed in the "core unadvised function" but in the advice
;; object instead! So here we try to undo the damage.
(if (integerp doc) (setq docfun flist))
(dolist (elem advice--where-alist)
(if (eq bytecode (cadr elem)) (setq where (car elem))))
(setq docstring
@ -101,8 +108,9 @@ Each element has the form (WHERE BYTECODE STACK) where:
"\n")))
(setq flist (advice--cdr flist)))
(if docstring (setq docstring (concat docstring "\n")))
(let* ((origdoc (unless (eq function flist) ;Avoid inf-loops.
(documentation flist t)))
(unless docfun (setq docfun flist))
(let* ((origdoc (unless (eq function docfun) ;Avoid inf-loops.
(documentation docfun t)))
(usage (help-split-fundoc origdoc function)))
(setq usage (if (null usage)
(let ((arglist (help-function-arglist flist)))