Commit 6f037f42 authored by Noam Postavsky's avatar Noam Postavsky
Browse files

Honor print-charset-text-property value of nil (Bug#31376)

* src/print.c (print_check_string_charset_prop): Move check
for nil Vprint_charset_text_property from here...
(print_prune_string_charset): ... to here.
(syms_of_print) <print-charset-text-property>: Clarify that any
non-boolean values are treated the same as `default'.
* doc/lispref/streams.texi (Output Variables): Add
print-prune-string-charset.
* test/src/print-tests.el (print-charset-text-property-nil)
(print-charset-text-property-default)
(print-charset-text-property-t): New tests.
(print-tests--prints-with-charset-p): New helper function.
parent 0d224e82
...@@ -809,6 +809,21 @@ when the output stream is a unibyte buffer or a marker pointing into ...@@ -809,6 +809,21 @@ when the output stream is a unibyte buffer or a marker pointing into
one. one.
@end defvar @end defvar
@defvar print-charset-text-property
This variable controls printing of `charset' text property on printing
a string. The value should be @code{nil}, @code{t}, or
@code{default}.
If the value is @code{nil}, @code{charset} text properties are never
printed. If @code{t}, they are always printed.
If the value is @code{default}, only print @code{charset} text
properties if there is an ``unexpected'' @code{charset} property. For
ascii characters, all charsets are considered ``expected''.
Otherwise, the expected @code{charset} property of a character is
given by @code{char-charset}.
@end defvar
@defvar print-length @defvar print-length
@cindex printing limits @cindex printing limits
The value of this variable is the maximum number of elements to print in The value of this variable is the maximum number of elements to print in
......
...@@ -1317,8 +1317,7 @@ print_check_string_charset_prop (INTERVAL interval, Lisp_Object string) ...@@ -1317,8 +1317,7 @@ print_check_string_charset_prop (INTERVAL interval, Lisp_Object string)
|| CONSP (XCDR (XCDR (val)))) || CONSP (XCDR (XCDR (val))))
print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND; print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND;
} }
if (NILP (Vprint_charset_text_property) if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
|| ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{ {
int i, c; int i, c;
ptrdiff_t charpos = interval->position; ptrdiff_t charpos = interval->position;
...@@ -1348,7 +1347,8 @@ print_prune_string_charset (Lisp_Object string) ...@@ -1348,7 +1347,8 @@ print_prune_string_charset (Lisp_Object string)
print_check_string_result = 0; print_check_string_result = 0;
traverse_intervals (string_intervals (string), 0, traverse_intervals (string_intervals (string), 0,
print_check_string_charset_prop, string); print_check_string_charset_prop, string);
if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) if (NILP (Vprint_charset_text_property)
|| ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND))
{ {
string = Fcopy_sequence (string); string = Fcopy_sequence (string);
if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND) if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)
...@@ -2423,7 +2423,7 @@ that need to be recorded in the table. */); ...@@ -2423,7 +2423,7 @@ that need to be recorded in the table. */);
DEFVAR_LISP ("print-charset-text-property", Vprint_charset_text_property, DEFVAR_LISP ("print-charset-text-property", Vprint_charset_text_property,
doc: /* A flag to control printing of `charset' text property on printing a string. doc: /* A flag to control printing of `charset' text property on printing a string.
The value must be nil, t, or `default'. The value should be nil, t, or `default'.
If the value is nil, don't print the text property `charset'. If the value is nil, don't print the text property `charset'.
...@@ -2431,7 +2431,8 @@ If the value is t, always print the text property `charset'. ...@@ -2431,7 +2431,8 @@ If the value is t, always print the text property `charset'.
If the value is `default', print the text property `charset' only when If the value is `default', print the text property `charset' only when
the value is different from what is guessed in the current charset the value is different from what is guessed in the current charset
priorities. */); priorities. Values other than nil or t are also treated as
`default'. */);
Vprint_charset_text_property = Qdefault; Vprint_charset_text_property = Qdefault;
/* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */
......
...@@ -27,6 +27,42 @@ ...@@ -27,6 +27,42 @@
(prin1-to-string "\u00A2\ff")) (prin1-to-string "\u00A2\ff"))
"\"\\x00a2\\ff\""))) "\"\\x00a2\\ff\"")))
(defun print-tests--prints-with-charset-p (ch odd-charset)
"Return t if `prin1-to-string' prints CH with the `charset' property.
CH is propertized with a `charset' value according to
ODD-CHARSET: if nil, then use the one returned by `char-charset',
otherwise, use a different charset."
(integerp
(string-match
"charset"
(prin1-to-string
(propertize (string ch)
'charset
(if odd-charset
(cl-find (char-charset ch) charset-list :test-not #'eq)
(char-charset ch)))))))
(ert-deftest print-charset-text-property-nil ()
(let ((print-charset-text-property nil))
(should-not (print-tests--prints-with-charset-p ?\xf6 t)) ; Bug#31376.
(should-not (print-tests--prints-with-charset-p ?a t))
(should-not (print-tests--prints-with-charset-p ?\xf6 nil))
(should-not (print-tests--prints-with-charset-p ?a nil))))
(ert-deftest print-charset-text-property-default ()
(let ((print-charset-text-property 'default))
(should (print-tests--prints-with-charset-p ?\xf6 t))
(should-not (print-tests--prints-with-charset-p ?a t))
(should-not (print-tests--prints-with-charset-p ?\xf6 nil))
(should-not (print-tests--prints-with-charset-p ?a nil))))
(ert-deftest print-charset-text-property-t ()
(let ((print-charset-text-property t))
(should (print-tests--prints-with-charset-p ?\xf6 t))
(should (print-tests--prints-with-charset-p ?a t))
(should (print-tests--prints-with-charset-p ?\xf6 nil))
(should (print-tests--prints-with-charset-p ?a nil))))
(ert-deftest terpri () (ert-deftest terpri ()
(should (string= (with-output-to-string (should (string= (with-output-to-string
(princ 'abc) (princ 'abc)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment