changeset 43269:f4b001827b85

(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.

--- a/src/xdisp.c	Wed Feb 13 15:59:53 2002 +0000
+++ b/src/xdisp.c	Wed Feb 13 16:15:52 2002 +0000
@@ -220,7 +220,7 @@
 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 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 @@
       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 @@
      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 @@
   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 @@
    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 @@
 	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 @@
 		
 		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 @@
 	    /* 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 @@
       {
 	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 @@
 	   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 @@
 		   && (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 @@
   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 @@
 
   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.