From 049fac7c941e4b7afad0471c209dc15193460282 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 20 Mar 2014 12:00:17 -0400 Subject: [PATCH] * lisp/emacs-lisp/nadvice.el (advice--make-docstring): Try harder to find 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 --- lisp/ChangeLog | 5 +++++ lisp/emacs-lisp/nadvice.el | 16 ++++++++++++---- src/ChangeLog | 6 ++++++ src/doc.c | 5 ++++- 4 files changed, 27 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 72dc441d1f9..8b93411269f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2014-03-20 Stefan Monnier + + * emacs-lisp/nadvice.el (advice--make-docstring): Try harder to find + the docstring of functions advised before dumping (bug#16993). + 2014-03-19 Stefan-W. Hahn (tiny change) * ps-print.el (ps-generate-postscript-with-faces): diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index f480d17557c..0e2536f8179 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -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))) diff --git a/src/ChangeLog b/src/ChangeLog index 93d1ba247b1..f67923bf417 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,11 @@ 2014-03-20 Stefan Monnier + * 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. + * frame.h (SET_FRAME_VISIBLE): Keep frame_garbaged up to date. * xterm.c (handle_one_xevent) : Don't garbage the frame. * frame.c (frame_garbaged): Make "docstring" more precise. diff --git a/src/doc.c b/src/doc.c index a42874f4503..7e693165c6f 100644 --- a/src/doc.c +++ b/src/doc.c @@ -535,6 +535,9 @@ store_function_docstring (Lisp_Object obj, ptrdiff_t offset) docstring, since we've found a docstring for it. */ if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING) ASET (fun, COMPILED_DOC_STRING, make_number (offset)); + else + message ("No docstring slot for %s", + SYMBOLP (obj) ? SDATA (SYMBOL_NAME (obj)) : ""); } } @@ -707,7 +710,7 @@ as the keymap for future \\=\\[COMMAND] substrings. thus, \\=\\=\\=\\= puts \\=\\= into the output, and \\=\\=\\=\\[ puts \\=\\[ into the output. Return the original STRING if no substitutions are made. -Otherwise, return a new string, without any text properties. */) +Otherwise, return a new string. */) (Lisp_Object string) { char *buf; -- 2.39.2