diff options
| -rw-r--r-- | src/print.c | 19 | ||||
| -rw-r--r-- | test/lisp/subr-tests.el | 10 | ||||
| -rw-r--r-- | test/src/print-tests.el | 1 |
3 files changed, 29 insertions, 1 deletions
diff --git a/src/print.c b/src/print.c index 384a639b317..48c945d08a0 100644 --- a/src/print.c +++ b/src/print.c @@ -105,6 +105,7 @@ bool print_output_debug_flag EXTERNALLY_VISIBLE = 1; = !NILP (BVAR (current_buffer, enable_multibyte_characters)); \ Lisp_Object original = printcharfun; \ record_unwind_current_buffer (); \ + specbind(Qprint__unreadable_callback_buffer, Fcurrent_buffer ()); \ if (NILP (printcharfun)) printcharfun = Qt; \ if (BUFFERP (printcharfun)) \ { \ @@ -1655,6 +1656,17 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, infinite recursion in the function called. */ Lisp_Object func = Vprint_unreadable_function; specbind (Qprint_unreadable_function, Qnil); + + /* If we're being called from `prin1-to-string' or the like, + we're now in the secret " prin1" buffer. This can lead to + problems if, for instance, the callback function switches a + window to this buffer -- this will make Emacs segfault. */ + if (!NILP (Vprint__unreadable_callback_buffer) + && Fbuffer_live_p (Vprint__unreadable_callback_buffer)) + { + record_unwind_current_buffer (); + set_buffer_internal (XBUFFER (Vprint__unreadable_callback_buffer)); + } Lisp_Object result = CALLN (Ffuncall, func, obj, escapeflag? Qt: Qnil); unbind_to (count, Qnil); @@ -2913,6 +2925,13 @@ be printed. */); Vprint_unreadable_function = Qnil; DEFSYM (Qprint_unreadable_function, "print-unreadable-function"); + DEFVAR_LISP ("print--unreadable-callback-buffer", + Vprint__unreadable_callback_buffer, + doc: /* Dynamically bound to indicate current buffer. */); + Vprint__unreadable_callback_buffer = Qnil; + DEFSYM (Qprint__unreadable_callback_buffer, + "print--unreadable-callback-buffer"); + defsubr (&Sflush_standard_output); /* Initialized in print_create_variable_mapping. */ diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index 20f81d1ddc5..1d85631a4b8 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1122,5 +1122,15 @@ final or penultimate step during initialization.")) (should (equal (butlast l n) (subr-tests--butlast-ref l n)))))) +(ert-deftest test-print-unreadable-function-buffer () + (with-temp-buffer + (let ((current (current-buffer)) + callback-buffer) + (let ((print-unreadable-function + (lambda (_object _escape) + (setq callback-buffer (current-buffer))))) + (prin1-to-string (make-marker))) + (should (eq current callback-buffer))))) + (provide 'subr-tests) ;;; subr-tests.el ends here diff --git a/test/src/print-tests.el b/test/src/print-tests.el index f818b4d4715..91187d9f45c 100644 --- a/test/src/print-tests.el +++ b/test/src/print-tests.el @@ -529,6 +529,5 @@ otherwise, use a different charset." (should (equal (% (- (length numbers) loopback-index) loop) 0))))))))))) - (provide 'print-tests) ;;; print-tests.el ends here |