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.
This commit is contained in:
Lars Ingebrigtsen
parent
22873b5415
commit
aa95b2a47d
10 changed files with 265 additions and 16 deletions
|
|
@ -739,6 +739,7 @@ Reading and Printing Lisp Objects
|
|||
* 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
|
||||
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ reading) or where to put it (if printing).
|
|||
* 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
|
||||
|
|
@ -634,7 +635,7 @@ characters are used. @code{print} returns @var{object}. For example:
|
|||
@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
|
||||
|
|
@ -649,6 +650,10 @@ This function outputs the printed representation of @var{object} to
|
|||
@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
|
||||
|
|
@ -694,7 +699,7 @@ newline character first, which enables you to display incomplete
|
|||
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.
|
||||
|
|
@ -708,6 +713,10 @@ 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
|
||||
|
|
@ -971,3 +980,93 @@ Letter, Number, Punctuation, Symbol and Private-use
|
|||
(@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.
|
||||
|
|
|
|||
4
etc/NEWS
4
etc/NEWS
|
|
@ -1817,6 +1817,10 @@ functions.
|
|||
|
||||
* 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
|
||||
|
|
|
|||
|
|
@ -3327,7 +3327,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
|
|||
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;
|
||||
|
|
|
|||
|
|
@ -1341,7 +1341,7 @@ internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
|
|||
&& (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
|
||||
|
|
|
|||
|
|
@ -2349,7 +2349,7 @@ readevalloop (Lisp_Object readcharfun,
|
|||
{
|
||||
Vvalues = Fcons (val, Vvalues);
|
||||
if (EQ (Vstandard_output, Qt))
|
||||
Fprin1 (val, Qnil);
|
||||
Fprin1 (val, Qnil, Qnil);
|
||||
else
|
||||
Fprint (val, Qnil);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1383,7 +1383,7 @@ print_paths_to_root_1 (struct dump_context *ctx,
|
|||
{
|
||||
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);
|
||||
|
|
@ -3758,7 +3758,7 @@ decode_emacs_reloc (struct dump_context *ctx, Lisp_Object lreloc)
|
|||
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);
|
||||
|
|
|
|||
118
src/print.c
118
src/print.c
|
|
@ -620,7 +620,51 @@ If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used. */)
|
|||
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
|
||||
|
|
@ -642,21 +686,43 @@ of these:
|
|||
- 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,
|
||||
|
|
@ -666,13 +732,18 @@ the behavior is controlled by `print-level' and `print-length', which see.
|
|||
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. */
|
||||
|
|
@ -847,7 +918,7 @@ append to existing target file. */)
|
|||
void
|
||||
debug_print (Lisp_Object arg)
|
||||
{
|
||||
Fprin1 (arg, Qexternal_debugging_output);
|
||||
Fprin1 (arg, Qexternal_debugging_output, Qnil);
|
||||
fputs ("\r\n", stderr);
|
||||
}
|
||||
|
||||
|
|
@ -995,7 +1066,7 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context,
|
|||
|| EQ (errname, Qend_of_file) || EQ (errname, Quser_error))
|
||||
Fprinc (obj, stream);
|
||||
else
|
||||
Fprin1 (obj, stream);
|
||||
Fprin1 (obj, stream, Qnil);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -2571,4 +2642,35 @@ be printed. */);
|
|||
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"));
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4779,7 +4779,7 @@ corresponding connection was closed. */)
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue