Add OVERRIDES argument to prin1/prin1-to-string

* doc/lispref/streams.texi (Output Functions): Document it.
(Output Overrides): New node.

* src/process.c (Faccept_process_output):
* src/print.c (debug_print, print_error_message):
* src/pdumper.c (print_paths_to_root_1, decode_emacs_reloc):
* src/lread.c (readevalloop):
* src/eval.c (internal_lisp_condition_case):
* src/editfns.c (styled_format): Adjust prin1/prin1-to-string
callers.

* src/print.c (Fprin1): Take an OVERRIDES parameter.
(print_bind_overrides, print_bind_all_defaults): New functions.
(Fprin1_to_string): Take an OVERRIDES parameter.

1 files changed, 43 insertions, 0 deletions

diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 0bae1959d1b..b9b282e5809 100644
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -425,5 +425,48 @@ otherwise, use a different charset."
   (should (equal (prin1-to-string '\?bar) "\\?bar"))
   (should (equal (prin1-to-string '\?bar?) "\\?bar?")))
 
+(ert-deftest test-prin1-overrides ()
+  (with-temp-buffer
+    (let ((print-length 10))
+      (prin1 (make-list 20 t) (current-buffer) t)
+      (should (= print-length 10)))
+    (goto-char (point-min))
+    (should (= (length (read (current-buffer))) 20)))
+
+  (with-temp-buffer
+    (let ((print-length 10))
+      (prin1 (make-list 20 t) (current-buffer) '((length . 5)))
+      (should (= print-length 10)))
+    (goto-char (point-min))
+    (should (= (length (read (current-buffer))) 6)))
+
+  (with-temp-buffer
+    (let ((print-length 10))
+      (prin1 (make-list 20 t) (current-buffer) '(t (length . 5)))
+      (should (= print-length 10)))
+    (goto-char (point-min))
+    (should (= (length (read (current-buffer))) 6))))
+
+(ert-deftest test-prin1-to-string-overrides ()
+  (let ((print-length 10))
+    (should
+     (= (length (car (read-from-string
+                      (prin1-to-string (make-list 20 t) nil t))))
+        20)))
+
+  (let ((print-length 10))
+    (should
+     (= (length (car (read-from-string
+                      (prin1-to-string (make-list 20 t) nil
+                                       '((length . 5))))))
+        6)))
+
+  (should-error (prin1-to-string 'foo nil 'a))
+  (should-error (prin1-to-string 'foo nil '(a)))
+  (should-error (prin1-to-string 'foo nil '(t . b)))
+  (should-error (prin1-to-string 'foo nil '(t b)))
+  (should-error (prin1-to-string 'foo nil '((a . b) b)))
+  (should-error (prin1-to-string 'foo nil '((length . 10) . b))))
+
 (provide 'print-tests)
 ;;; print-tests.el ends here