From 71ea13cb9877bf8470500bec15e082007c2987d5 Mon Sep 17 00:00:00 2001 From: Kenichi Handa Date: Sun, 18 Jan 2004 23:27:07 +0000 Subject: [PATCH] Include charset.h. (Vprint_charset_text_property): New variable. (Qdefault): Extern it. (PRINT_STRING_NON_CHARSET_FOUND) (PRINT_STRING_UNSAFE_CHARSET_FOUND): New macros. (print_check_string_result): New variable. (print_check_string_charset_prop): New function. (print_prune_charset_plist): New variable. (print_prune_string_charset): New function. (print_object): Call print_prune_string_charset if Vprint_charset_text_property is not t. (print_interval): Print nothing if itnerval->plist is nil. (syms_of_print): Declare Vprint_charset_text_property as a lisp variable. Init and staticpro print_prune_charset_plist. --- src/print.c | 106 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 106 insertions(+) diff --git a/src/print.c b/src/print.c index 1ded6c56674..229004f7a57 100644 --- a/src/print.c +++ b/src/print.c @@ -25,6 +25,7 @@ Boston, MA 02111-1307, USA. */ #include "lisp.h" #include "buffer.h" #include "character.h" +#include "charset.h" #include "keyboard.h" #include "frame.h" #include "window.h" @@ -1306,6 +1307,90 @@ print_preprocess_string (interval, arg) print_preprocess (interval->plist); } +/* A flag to control printing of `charset' text property. + The default value is Qdefault. */ +Lisp_Object Vprint_charset_text_property; +extern Lisp_Object Qdefault; + +static void print_check_string_charset_prop (); + +#define PRINT_STRING_NON_CHARSET_FOUND 1 +#define PRINT_STRING_UNSAFE_CHARSET_FOUND 2 + +/* Bitwize or of the abobe macros. */ +static int print_check_string_result; + +static void +print_check_string_charset_prop (interval, string) + INTERVAL interval; + Lisp_Object string; +{ + Lisp_Object val; + + if (NILP (interval->plist) + || (print_check_string_result == (PRINT_STRING_NON_CHARSET_FOUND + | PRINT_STRING_UNSAFE_CHARSET_FOUND))) + return; + for (val = interval->plist; CONSP (val) && ! EQ (XCAR (val), Qcharset); + val = XCDR (XCDR (val))); + if (! CONSP (val)) + { + print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND; + return; + } + if (! (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND)) + { + if (! EQ (val, interval->plist) + || CONSP (XCDR (XCDR (val)))) + print_check_string_result |= PRINT_STRING_NON_CHARSET_FOUND; + } + if (NILP (Vprint_charset_text_property) + || ! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) + { + int i, c; + int charpos = interval->position; + int bytepos = string_char_to_byte (string, charpos); + Lisp_Object charset; + + charset = XCAR (XCDR (val)); + for (i = 0; i < LENGTH (interval); i++) + { + FETCH_STRING_CHAR_ADVANCE (c, string, charpos, bytepos); + if (! EQ (CHARSET_NAME (CHAR_CHARSET (c)), charset)) + { + print_check_string_result |= PRINT_STRING_UNSAFE_CHARSET_FOUND; + break; + } + } + } +} + +/* The value is (charset . nil). */ +static Lisp_Object print_prune_charset_plist; + +static Lisp_Object +print_prune_string_charset (string) + Lisp_Object string; +{ + print_check_string_result = 0; + traverse_intervals (STRING_INTERVALS (string), 0, + print_check_string_charset_prop, string); + if (! (print_check_string_result & PRINT_STRING_UNSAFE_CHARSET_FOUND)) + { + string = Fcopy_sequence (string); + if (print_check_string_result & PRINT_STRING_NON_CHARSET_FOUND) + { + if (NILP (print_prune_charset_plist)) + print_prune_charset_plist = Fcons (Qcharset, Qnil); + Fremove_text_properties (0, SCHARS (string), + print_prune_charset_plist, string); + } + else + Fset_text_properties (0, SCHARS (string), Qnil, string); + } + return string; +} + static void print_object (obj, printcharfun, escapeflag) Lisp_Object obj; @@ -1413,6 +1498,9 @@ print_object (obj, printcharfun, escapeflag) GCPRO1 (obj); + if (! EQ (Vprint_charset_text_property, Qt)) + obj = print_prune_string_charset (obj); + if (!NULL_INTERVAL_P (STRING_INTERVALS (obj))) { PRINTCHAR ('#'); @@ -2034,6 +2122,8 @@ print_interval (interval, printcharfun) INTERVAL interval; Lisp_Object printcharfun; { + if (NILP (interval->plist)) + return; PRINTCHAR (' '); print_object (make_number (interval->position), printcharfun, 1); PRINTCHAR (' '); @@ -2156,6 +2246,19 @@ the printing done so far has not found any shared structure or objects that need to be recorded in the table. */); Vprint_number_table = Qnil; + DEFVAR_LISP ("print-charset-text-property", &Vprint_charset_text_property, + doc: /* A flag to control printing of `charset' text property on printing a string. +The value must be nil, t, or `default'. + +If the value is nil, don't print the text property `charset'. + +If the value is t, always print the text property `charset'. + +If the value is `default', print the text property `charset' only when +the value is different from what is guessed in the current charset + priorities. */); + Vprint_charset_text_property = Qdefault; + /* prin1_to_string_buffer initialized in init_buffer_once in buffer.c */ staticpro (&Vprin1_to_string_buffer); @@ -2180,5 +2283,8 @@ that need to be recorded in the table. */); Qprint_escape_nonascii = intern ("print-escape-nonascii"); staticpro (&Qprint_escape_nonascii); + print_prune_charset_plist = Qnil; + staticpro (&print_prune_charset_plist); + defsubr (&Swith_output_to_temp_buffer); } -- 2.39.2