(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 3eed31a84d9f8cde12c51e48b903ee8783637456..aec0e9e0f0663815d9a499e501bca8710ee7cfbc 100644 (file)
--- 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.