From: Richard M. Stallman Date: Wed, 13 Feb 2002 16:15:52 +0000 (+0000) Subject: (QCpropertize): New variable. X-Git-Tag: ttn-vms-21-2-B4~16705 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0fcf414f926976619f3f520003574427cc686432;p=emacs.git (QCpropertize): New variable. (mode_line_proptrans_alist): New variable. (display_mode_element): New arg PROPS; all calls changed. Implement this, for strings. Handle literal output of strings by sharing the main-line code for strings, using local var `literal'. Handle :propertize feature. (syms_of_xdisp): Initialze and staticpro QCpropertize and mode_line_proptrans_alist. --- diff --git a/src/xdisp.c b/src/xdisp.c index 3eed31a84d9..aec0e9e0f06 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -220,7 +220,7 @@ Lisp_Object Qoverriding_local_map, Qoverriding_terminal_local_map; Lisp_Object Qwindow_scroll_functions, Vwindow_scroll_functions; Lisp_Object Qredisplay_end_trigger_functions; Lisp_Object Qinhibit_point_motion_hooks; -Lisp_Object QCeval, Qwhen, QCfile, QCdata; +Lisp_Object QCeval, Qwhen, QCfile, QCdata, QCpropertize; Lisp_Object Qfontified; Lisp_Object Qgrow_only; Lisp_Object Qinhibit_eval_during_redisplay; @@ -746,7 +746,7 @@ static int try_window_id P_ ((struct window *)); static int display_line P_ ((struct it *)); static int display_mode_lines P_ ((struct window *)); static int display_mode_line P_ ((struct window *, enum face_id, Lisp_Object)); -static int display_mode_element P_ ((struct it *, int, int, int, Lisp_Object)); +static int display_mode_element P_ ((struct it *, int, int, int, Lisp_Object, Lisp_Object)); static char *decode_mode_spec P_ ((struct window *, int, int, int, int *)); static void display_menu_bar P_ ((struct window *)); static int display_count_lines P_ ((int, int, int, int, int *)); @@ -7249,7 +7249,7 @@ x_consider_frame_title (frame) frame_title_ptr = frame_title_buf; init_iterator (&it, XWINDOW (f->selected_window), -1, -1, NULL, DEFAULT_FACE_ID); - display_mode_element (&it, 0, -1, -1, fmt); + display_mode_element (&it, 0, -1, -1, fmt, Qnil); len = frame_title_ptr - frame_title_buf; frame_title_ptr = NULL; set_buffer_internal_1 (obuf); @@ -13479,7 +13479,7 @@ display_mode_line (w, face_id, format) kboard-local variables in the mode_line_format will get the right values. */ push_frame_kboard (it.f); - display_mode_element (&it, 0, 0, 0, format); + display_mode_element (&it, 0, 0, 0, format, Qnil); pop_frame_kboard (); /* Fill up with spaces. */ @@ -13505,6 +13505,9 @@ display_mode_line (w, face_id, format) return it.glyph_row->height; } +/* Alist that caches the results of :propertize. + Each element is (PROPERTIZED-STRING . PROPERTY-LIST). */ +Lisp_Object mode_line_proptrans_alist; /* Contribute ELT to the mode line for window IT->w. How it translates into text depends on its data type. @@ -13522,13 +13525,14 @@ display_mode_line (w, face_id, format) Returns the hpos of the end of the text generated by ELT. */ static int -display_mode_element (it, depth, field_width, precision, elt) +display_mode_element (it, depth, field_width, precision, elt, props) struct it *it; int depth; int field_width, precision; - Lisp_Object elt; + Lisp_Object elt, props; { int n = 0, field, prec; + int literal = 0; tail_recurse: if (depth > 10) @@ -13545,6 +13549,38 @@ display_mode_element (it, depth, field_width, precision, elt) unsigned char *this = XSTRING (elt)->data; unsigned char *lisp_string = this; + if (!NILP (props)) + { + Lisp_Object oprops, aelt; + oprops = Ftext_properties_at (make_number (0), elt); + if (NILP (Fequal (props, oprops))) + { + aelt = Fassoc (elt, mode_line_proptrans_alist); + if (! NILP (aelt) && !NILP (Fequal (props, XCDR (aelt)))) + elt = XCAR (aelt); + else + { + elt = Fcopy_sequence (elt); + Fset_text_properties (0, Flength (elt), props, elt); + mode_line_proptrans_alist + = Fcons (Fcons (elt, props), + mode_line_proptrans_alist); + } + } + } + + if (literal) + { + prec = precision - n; + if (frame_title_ptr) + n += store_frame_title (XSTRING (elt)->data, -1, prec); + else + n += display_string (NULL, elt, Qnil, 0, 0, it, + 0, prec, 0, STRING_MULTIBYTE (elt)); + + break; + } + while ((precision <= 0 || n < precision) && *this && (frame_title_ptr @@ -13597,7 +13633,7 @@ display_mode_element (it, depth, field_width, precision, elt) if (c == 'M') n += display_mode_element (it, depth, field, prec, - Vglobal_mode_string); + Vglobal_mode_string, props); else if (c != 0) { int multibyte; @@ -13661,15 +13697,9 @@ display_mode_element (it, depth, field_width, precision, elt) /* If value is a string, output that string literally: don't check for % within it. */ if (STRINGP (tem)) - { - prec = precision - n; - if (frame_title_ptr) - n += store_frame_title (XSTRING (tem)->data, -1, prec); - else - n += display_string (NULL, tem, Qnil, 0, 0, it, - 0, prec, 0, STRING_MULTIBYTE (tem)); - } - else if (!EQ (tem, elt)) + literal = 1; + + if (!EQ (tem, elt)) { /* Give up right away for nil or t. */ elt = tem; @@ -13683,7 +13713,8 @@ display_mode_element (it, depth, field_width, precision, elt) { register Lisp_Object car, tem; - /* A cons cell: three distinct cases. + /* A cons cell: five distinct cases. + If first element is :eval or :propertize, do something special. If first element is a string or a cons, process all the elements and effectively concatenate them. If first element is a negative number, truncate displaying cdr to @@ -13692,18 +13723,29 @@ display_mode_element (it, depth, field_width, precision, elt) If first element is a symbol, process the cadr or caddr recursively according to whether the symbol's value is non-nil or nil. */ car = XCAR (elt); - if (EQ (car, QCeval) && CONSP (XCDR (elt))) + if (EQ (car, QCeval)) { /* An element of the form (:eval FORM) means evaluate FORM and use the result as mode line elements. */ - struct gcpro gcpro1; - Lisp_Object spec; - - spec = safe_eval (XCAR (XCDR (elt))); - GCPRO1 (spec); - n += display_mode_element (it, depth, field_width - n, - precision - n, spec); - UNGCPRO; + + if (CONSP (XCDR (elt))) + { + Lisp_Object spec; + spec = safe_eval (XCAR (XCDR (elt))); + n += display_mode_element (it, depth, field_width - n, + precision - n, spec, props); + } + } + else if (EQ (car, QCpropertize)) + { + if (CONSP (XCDR (elt))) + { + /* An element of the form (:propertize ELT PROPS...) + means display ELT but applying properties PROPS. */ + n += display_mode_element (it, depth, field_width - n, + precision - n, XCAR (XCDR (elt)), + XCDR (XCDR (elt))); + } } else if (SYMBOLP (car)) { @@ -13768,7 +13810,7 @@ display_mode_element (it, depth, field_width, precision, elt) && (precision <= 0 || n < precision)) { n += display_mode_element (it, depth, field_width - n, - precision - n, XCAR (elt)); + precision - n, XCAR (elt), props); elt = XCDR (elt); } } @@ -14727,6 +14769,8 @@ syms_of_xdisp () staticpro (&QCrelative_height); QCeval = intern (":eval"); staticpro (&QCeval); + QCpropertize = intern (":propertize"); + staticpro (&QCpropertize); Qwhen = intern ("when"); staticpro (&Qwhen); QCfile = intern (":file"); @@ -14771,6 +14815,9 @@ syms_of_xdisp () Vmessages_buffer_name = build_string ("*Messages*"); staticpro (&Vmessages_buffer_name); + + mode_line_proptrans_alist = Qnil; + staticpro (&mode_line_proptrans_alist); DEFVAR_LISP ("show-trailing-whitespace", &Vshow_trailing_whitespace, doc: /* Non-nil means highlight trailing whitespace.