* lisp/emacs-lisp/cl-print.el: New file

* lisp/emacs-lisp/nadvice.el (advice--where): New function.
(advice--make-docstring): Use it.

* src/print.c (print_number_index): Don't declare here any more.
(Fprint_preprocess): New function.

* test/lisp/emacs-lisp/cl-print-tests.el: New file.

1 files changed, 13 insertions, 5 deletions

diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el
index 5a100b790f1..fd1cd2c7aaf 100644
--- a/lisp/emacs-lisp/nadvice.el
+++ b/lisp/emacs-lisp/nadvice.el
@@ -72,6 +72,13 @@ Each element has the form (WHERE BYTECODE STACK) where:
     (setq f (advice--cdr f)))
   f)
 
+(defun advice--where (f)
+  (let ((bytecode (aref f 1))
+        (where nil))
+    (dolist (elem advice--where-alist)
+      (if (eq bytecode (cadr elem)) (setq where (car elem))))
+    where))
+
 (defun advice--make-docstring (function)
   "Build the raw docstring for FUNCTION, presumably advised."
   (let* ((flist (indirect-function function))
@@ -79,16 +86,13 @@ Each element has the form (WHERE BYTECODE STACK) where:
          (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))
+      (let ((doc (aref flist 4))
+            (where (advice--where flist)))
         ;; 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
               (concat
                docstring
@@ -502,6 +506,10 @@ of the piece of advice."
             (setq frame2 (backtrace-frame i #'called-interactively-p))
             ;; (message "Advice Frame %d = %S" i frame2)
             (setq i (1+ i)))))
+    ;; FIXME: Adjust this for the new :filter advices, since they use `funcall'
+    ;; rather than `apply'.
+    ;; FIXME: Somehow this doesn't work on (advice-add :before
+    ;; 'call-interactively #'ignore), see bug#3984.
     (when (and (eq (nth 1 frame2) 'apply)
                (progn
                  (funcall get-next-frame)