* 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.
* Output Functions:: Functions to print Lisp objects as text.
* Output Variables:: Variables that control what the printing
functions do.
+* Output Overrides:: Overriding output variables.
Minibuffers
* Output Streams:: Various data types that can be used as output streams.
* Output Functions:: Functions to print Lisp objects as text.
* Output Variables:: Variables that control what the printing functions do.
+* Output Overrides:: Overriding output variables.
@end menu
@node Streams Intro
@end example
@end defun
-@defun prin1 object &optional stream
+@defun prin1 object &optional stream overrides
This function outputs the printed representation of @var{object} to
@var{stream}. It does not print newlines to separate output as
@code{print} does, but it does use quoting characters just like
@result{} " came back"
@end group
@end example
+
+If @var{overrides} is non-@code{nil}, it should either be @code{t}
+(which tells @code{prin1} to use the defaults for all printer related
+variables), or a list of settings. @xref{Output Overrides} for details.
@end defun
@defun princ object &optional stream
lines.
@end defun
-@defun prin1-to-string object &optional noescape
+@defun prin1-to-string object &optional noescape overrides
@cindex object to string
This function returns a string containing the text that @code{prin1}
would have printed for the same argument.
(prin1-to-string (mark-marker))
@result{} "#<marker at 2773 in strings.texi>"
@end group
+
+If @var{overrides} is non-@code{nil}, it should either be @code{t}
+(which tells @code{prin1} to use the defaults for all printer related
+variables), or a list of settings. @xref{Output Overrides} for details.
@end example
If @var{noescape} is non-@code{nil}, that inhibits use of quoting
(@pxref{Character Properties}), as well as the control characters
having their own escape syntax such as newline.
@end defvar
+
+@node Output Overrides
+@section Overriding Output Variables
+
+@xref{Output Functions} lists the numerous variables that controls how
+the Emacs Lisp printer outputs data. These are generally available
+for users to change, but sometimes you want to output data in the
+default format. For instance, if you're storing Emacs Lisp data in a
+file, you don't want that data to be shortened by a
+@code{print-length} setting.
+
+The @code{prin1} and @code{prin1-to-string} functions therefore have
+an optional @var{overrides} argument. This variable can either be
+@code{t} (which means that all printing variables should be the
+default values), or a list of settings. Each element in the list can
+either be @code{t} (which means ``reset to defaults'') or a pair where
+the @code{car} is a symbol, and the @code{cdr} is the value.
+
+For instance, this prints using nothing but defaults:
+
+@lisp
+(prin1 object nil t)
+@end lisp
+
+This prints @var{object} using the current printing settings, but
+overrides @code{print-length} to 5:
+
+@lisp
+(prin1 object nil '((length . 5)))
+@end lisp
+
+And finally, this prints @var{object} using only default settings, but
+overrides @code{print-length} to 5:
+
+@lisp
+(prin1 object nil '(t (length . 5)))
+@end lisp
+
+Below is a list of symbols that can be used, and which variables they
+map to:
+
+@table @code
+@item length
+This overrides @code{print-length}.
+
+@item level
+This overrides @code{print-level}.
+
+@item circle
+This overrides @code{print-circle}.
+
+@item quoted
+This overrides @code{print-quoted}.
+
+@item escape-newlines
+This overrides @code{print-escape-newlines}.
+
+@item escape-control-characters
+This overrides @code{print-escape-control-characters}.
+
+@item escape-nonascii
+This overrides @code{print-escape-nonascii}.
+
+@item escape-multibyte
+This overrides @code{print-escape-multibyte}.
+
+@item charset-text-property
+This overrides @code{print-charset-text-property}.
+
+@item unreadeable-function
+This overrides @code{print-unreadable-function}.
+
+@item gensym
+This overrides @code{print-gensym}.
+
+@item continuous-numbering
+This overrides @code{print-continuous-numbering}.
+
+@item number-table
+This overrides @code{print-number-table}.
+
+@item float-format
+This overrides @code{float-output-format}.
+
+@item integers-as-characters
+This overrides @code{print-integers-as-characters}.
+@end table
+
+In the future, more overrides may be offered that do not map directly
+to a variable, but can only be used via this parameter.
\f
* Lisp Changes in Emacs 29.1
++++
+** 'prin1' and 'prin1-to-string' now takes an OVERRIDES parameter.
+This parameter can be used to override printer settings.
+
+++
** New minor mode 'header-line-indent-mode'.
This is meant to be used in modes that have a header line that should
if (EQ (arg, args[n]))
{
Lisp_Object noescape = conversion == 'S' ? Qnil : Qt;
- spec->argument = arg = Fprin1_to_string (arg, noescape);
+ spec->argument = arg = Fprin1_to_string (arg, noescape, Qnil);
if (STRING_MULTIBYTE (arg) && ! multibyte)
{
multibyte = true;
&& (SYMBOLP (XCAR (tem))
|| CONSP (XCAR (tem))))))
error ("Invalid condition handler: %s",
- SDATA (Fprin1_to_string (tem, Qt)));
+ SDATA (Fprin1_to_string (tem, Qt, Qnil)));
if (CONSP (tem) && EQ (XCAR (tem), QCsuccess))
success_handler = XCDR (tem);
else
{
Vvalues = Fcons (val, Vvalues);
if (EQ (Vstandard_output, Qt))
- Fprin1 (val, Qnil);
+ Fprin1 (val, Qnil, Qnil);
else
Fprint (val, Qnil);
}
{
Lisp_Object referrer = XCAR (referrers);
referrers = XCDR (referrers);
- Lisp_Object repr = Fprin1_to_string (referrer, Qnil);
+ Lisp_Object repr = Fprin1_to_string (referrer, Qnil, Qnil);
for (int i = 0; i < level; ++i)
putc (' ', stderr);
fwrite (SDATA (repr), 1, SBYTES (repr), stderr);
reloc.u.dump_offset = dump_recall_object (ctx, target_value);
if (reloc.u.dump_offset <= 0)
{
- Lisp_Object repr = Fprin1_to_string (target_value, Qnil);
+ Lisp_Object repr = Fprin1_to_string (target_value, Qnil, Qnil);
error ("relocation target was not dumped: %s", SDATA (repr));
}
dump_check_dump_off (ctx, reloc.u.dump_offset);
return val;
}
-DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,
+static void
+print_bind_all_defaults (void)
+{
+ for (Lisp_Object vars = Vprint__variable_mapping; !NILP (vars);
+ vars = XCDR (vars))
+ {
+ Lisp_Object elem = XCDR (XCAR (vars));
+ specbind (XCAR (elem), XCAR (XCDR (elem)));
+ }
+}
+
+static void
+print_bind_overrides (Lisp_Object overrides)
+{
+ if (EQ (overrides, Qt))
+ print_bind_all_defaults ();
+ else if (!CONSP (overrides))
+ xsignal (Qwrong_type_argument, Qconsp);
+ else
+ {
+ while (!NILP (overrides))
+ {
+ Lisp_Object setting = XCAR (overrides);
+ if (EQ (setting, Qt))
+ print_bind_all_defaults ();
+ else if (!CONSP (setting))
+ xsignal (Qwrong_type_argument, Qconsp);
+ else
+ {
+ Lisp_Object key = XCAR (setting),
+ value = XCDR (setting);
+ Lisp_Object map = Fassq (key, Vprint__variable_mapping);
+ if (NILP (map))
+ xsignal2 (Qwrong_type_argument, Qsymbolp, map);
+ specbind (XCAR (XCDR (map)), value);
+ }
+
+ if (!NILP (XCDR (overrides)) && !CONSP (XCDR (overrides)))
+ xsignal (Qwrong_type_argument, Qconsp);
+ overrides = XCDR (overrides);
+ }
+ }
+}
+
+DEFUN ("prin1", Fprin1, Sprin1, 1, 3, 0,
doc: /* Output the printed representation of OBJECT, any Lisp object.
Quoting characters are printed when needed to make output that `read'
can handle, whenever this is possible. For complex objects, the behavior
- t, in which case the output is displayed in the echo area.
If PRINTCHARFUN is omitted, the value of `standard-output' (which see)
-is used instead. */)
- (Lisp_Object object, Lisp_Object printcharfun)
+is used instead.
+
+OVERRIDES should be a list of settings. An element in this list be
+the symbol t, which means "use all the defaults". If not, an element
+should be a pair, where the `car' or the pair is the setting, and the
+`cdr' of the pair is the value of printer-related settings to use for
+this `prin1' call.
+
+For instance:
+
+ (prin1 object nil \\='((length . 100) (circle . t))).
+
+See the manual entry `(elisp)Output Overrides' for a list of possible
+values.
+
+As a special case, OVERRIDES can also simply be the symbol t, which
+means "use all the defaults". */)
+ (Lisp_Object object, Lisp_Object printcharfun, Lisp_Object overrides)
{
+ specpdl_ref count = SPECPDL_INDEX ();
+
if (NILP (printcharfun))
printcharfun = Vstandard_output;
+ if (!NILP (overrides))
+ print_bind_overrides (overrides);
+
PRINTPREPARE;
print (object, printcharfun, 1);
PRINTFINISH;
- return object;
+
+ return unbind_to (count, object);
}
/* A buffer which is used to hold output being built by prin1-to-string. */
Lisp_Object Vprin1_to_string_buffer;
-DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 2, 0,
+DEFUN ("prin1-to-string", Fprin1_to_string, Sprin1_to_string, 1, 3, 0,
doc: /* Return a string containing the printed representation of OBJECT.
OBJECT can be any Lisp object. This function outputs quoting characters
when necessary to make output that `read' can handle, whenever possible,
OBJECT is any of the Lisp data types: a number, a string, a symbol,
a list, a buffer, a window, a frame, etc.
+See `prin1' for the meaning of OVERRIDES.
+
A printed representation of an object is text which describes that object. */)
- (Lisp_Object object, Lisp_Object noescape)
+ (Lisp_Object object, Lisp_Object noescape, Lisp_Object overrides)
{
specpdl_ref count = SPECPDL_INDEX ();
specbind (Qinhibit_modification_hooks, Qt);
+ if (!NILP (overrides))
+ print_bind_overrides (overrides);
+
/* Save and restore this: we are altering a buffer
but we don't want to deactivate the mark just for that.
No need for specbind, since errors deactivate the mark. */
void
debug_print (Lisp_Object arg)
{
- Fprin1 (arg, Qexternal_debugging_output);
+ Fprin1 (arg, Qexternal_debugging_output, Qnil);
fputs ("\r\n", stderr);
}
|| EQ (errname, Qend_of_file) || EQ (errname, Quser_error))
Fprinc (obj, stream);
else
- Fprin1 (obj, stream);
+ Fprin1 (obj, stream, Qnil);
}
}
}
DEFSYM (Qprint_unreadable_function, "print-unreadable-function");
defsubr (&Sflush_standard_output);
+
+ DEFVAR_LISP ("print--variable-mapping", Vprint__variable_mapping,
+ doc: /* Mapping for print variables in `prin1'.
+Do not modify this list. */);
+ Vprint__variable_mapping = Qnil;
+ Lisp_Object total[] = {
+ list3 (intern ("length"), intern ("print-length"), Qnil),
+ list3 (intern ("level"), intern ("print-level"), Qnil),
+ list3 (intern ("circle"), intern ("print-circle"), Qnil),
+ list3 (intern ("quoted"), intern ("print-quoted"), Qt),
+ list3 (intern ("escape-newlines"), intern ("print-escape-newlines"), Qnil),
+ list3 (intern ("escape-control-characters"),
+ intern ("print-escape-control-characters"), Qnil),
+ list3 (intern ("escape-nonascii"), intern ("print-escape-nonascii"), Qnil),
+ list3 (intern ("escape-multibyte"),
+ intern ("print-escape-multibyte"), Qnil),
+ list3 (intern ("charset-text-property"),
+ intern ("print-charset-text-property"), Qnil),
+ list3 (intern ("unreadeable-function"),
+ intern ("print-unreadable-function"), Qnil),
+ list3 (intern ("gensym"), intern ("print-gensym"), Qnil),
+ list3 (intern ("continuous-numbering"),
+ intern ("print-continuous-numbering"), Qnil),
+ list3 (intern ("number-table"), intern ("print-number-table"), Qnil),
+ list3 (intern ("float-format"), intern ("float-output-format"), Qnil),
+ list3 (intern ("integers-as-characters"),
+ intern ("print-integers-as-characters"), Qnil),
+ };
+
+ Vprint__variable_mapping = CALLMANY (Flist, total);
+ make_symbol_constant (intern_c_string ("print--variable-mapping"));
}
SDATA (proc->name),
STRINGP (proc_thread_name)
? SDATA (proc_thread_name)
- : SDATA (Fprin1_to_string (proc->thread, Qt)));
+ : SDATA (Fprin1_to_string (proc->thread, Qt, Qnil)));
}
}
else
(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
projects / emacs.git / commitdiff