diff src/faces.c @ 5125:b5df3737028a ben-lisp-object

merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents 623d57b7fbe8 d95c102a96d3
children 2a462149bd6a
line wrap: on
line diff
--- a/src/faces.c	Wed Jan 20 07:05:57 2010 -0600
+++ b/src/faces.c	Wed Feb 24 01:58:04 2010 -0600
@@ -1,7 +1,7 @@
 /* "Face" primitives
    Copyright (C) 1994 Free Software Foundation, Inc.
    Copyright (C) 1995 Board of Trustees, University of Illinois.
-   Copyright (C) 1995, 1996, 2001, 2002 Ben Wing.
+   Copyright (C) 1995, 1996, 2001, 2002, 2005, 2010 Ben Wing.
    Copyright (C) 1995 Sun Microsystems, Inc.
 
 This file is part of XEmacs.
@@ -137,7 +137,7 @@
       write_fmt_string_lisp (printcharfun, "#<face %S", 1, face->name);
       if (!NILP (face->doc_string))
 	write_fmt_string_lisp (printcharfun, " %S", 1, face->doc_string);
-      write_c_string (printcharfun, ">");
+      write_ascstring (printcharfun, ">");
     }
 }
 
@@ -148,7 +148,8 @@
    This isn't concerned with "unspecified" attributes, that's what
    #'face-differs-from-default-p is for. */
 static int
-face_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+face_equal (Lisp_Object obj1, Lisp_Object obj2, int depth,
+	    int UNUSED (foldcase))
 {
   Lisp_Face *f1 = XFACE (obj1);
   Lisp_Face *f2 = XFACE (obj2);
@@ -168,7 +169,7 @@
      internal_equal (f1->blinking,	     f2->blinking,	    depth) &&
      internal_equal (f1->reverse,	     f2->reverse,	    depth) &&
 
-     ! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1));
+     ! plists_differ (f1->plist, f2->plist, 0, 0, depth + 1, 0));
 }
 
 static Hashcode
@@ -527,8 +528,8 @@
   struct face_inheritance_closure *fcl =
     (struct face_inheritance_closure *) face_inheritance_closure;
 
-  key = VOID_TO_LISP (hash_key);
-  contents = VOID_TO_LISP (hash_contents);
+  key = GET_LISP_FROM_VOID (hash_key);
+  contents = GET_LISP_FROM_VOID (hash_contents);
 
   if (EQ (fcl->property, Qfont))
     {
@@ -589,16 +590,20 @@
 
   if (!NILP (charset))
     matchspec = noseeum_cons (charset,
-			      stage == initial ? Qinitial : Qfinal);
+			      stage == STAGE_INITIAL ? Qinitial : Qfinal);
 
   GCPRO1 (matchspec);
+  /* This call to specifier_instance_no_quit(), will end up calling
+     font_instantiate() if the property in a question is a font (currently,
+     this means EQ (property, Qfont), because only the face property named
+     `font' contains a font object).  See the comments there. */
   retval = specifier_instance_no_quit (Fget (face, property, Qnil), matchspec,
 				       domain, errb, no_fallback, depth);
   UNGCPRO;
   if (CONSP (matchspec))
     free_cons (matchspec);
 
-  if (UNBOUNDP (retval) && !no_fallback && final == stage)
+  if (UNBOUNDP (retval) && !no_fallback && STAGE_FINAL == stage)
     {
       if (EQ (property, Qfont))
 	{
@@ -1159,7 +1164,7 @@
 					       /* ERROR_ME_DEBUG_WARN is
 						  fine here.  */
 					       ERROR_ME_DEBUG_WARN, 1, Qzero,
-					       initial);
+					       STAGE_INITIAL);
     DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, "
 		"result was something %s\n",
 		XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
@@ -1181,15 +1186,15 @@
 					       charset, domain,
 					       ERROR_ME_DEBUG_WARN, 0,
 					       Qzero,
-					       initial);
+					       STAGE_INITIAL);
 
-    DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, "
-		"allow fallback, result was something %s\n",
-		XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
-		XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
-		UNBOUNDP(new_val) ? "not bound" : "bound");
+    DEBUG_FACES ("just called f_p_m_i on face %s, charset %s, initial, "
+		 "allow fallback, result was something %s\n",
+		 XSTRING_DATA (XSYMBOL_NAME (XFACE (cachel->face)->name)),
+		 XSTRING_DATA (XSYMBOL_NAME (XCHARSET_NAME (charset))),
+		 UNBOUNDP (new_val) ? "not bound" : "bound");
 
-    if (!UNBOUNDP(new_val))
+    if (!UNBOUNDP (new_val))
       {
 	break;
       }
@@ -1200,7 +1205,7 @@
 					       charset, domain,
 					       ERROR_ME_DEBUG_WARN, 1,
 					       Qzero,
-					       final);
+					       STAGE_FINAL);
 
     DEBUG_FACES("just called f_p_m_i on face %s, charset %s, final, "
 		"result was something %s\n",
@@ -1208,7 +1213,7 @@
 		XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
 		UNBOUNDP(new_val) ? "not bound" : "bound");
     /* Tell X11 redisplay that it should translate to iso10646-1. */
-    if (!UNBOUNDP(new_val))
+    if (!UNBOUNDP (new_val))
       {
 	final_stage = 1;
 	break;
@@ -1222,13 +1227,13 @@
 					       charset, domain,
 					       ERROR_ME_DEBUG_WARN, 0,
 					       Qzero,
-					       final);
+					       STAGE_FINAL);
 
-    DEBUG_FACES("just called f_p_m_i on face %s, charset %s, initial, "
-		"allow fallback, result was something %s\n",
-		XSTRING_DATA(XSYMBOL_NAME(XFACE(cachel->face)->name)),
-		XSTRING_DATA(XSYMBOL_NAME(XCHARSET_NAME(charset))),
-		UNBOUNDP(new_val) ? "not bound" : "bound");
+    DEBUG_FACES ("just called f_p_m_i on face %s, charset %s, initial, "
+		 "allow fallback, result was something %s\n",
+		 XSTRING_DATA (XSYMBOL_NAME (XFACE (cachel->face)->name)),
+		 XSTRING_DATA (XSYMBOL_NAME (XCHARSET_NAME (charset))),
+		 UNBOUNDP (new_val) ? "not bound" : "bound");
     if (!UNBOUNDP(new_val))
       {
 	/* Tell X11 redisplay that it should translate to iso10646-1. */
@@ -1362,8 +1367,7 @@
   if (must_finish_frobbing)
     {
       int default_face = EQ (face, Vdefault_face);
-      struct face_cachel *cachel
-	= Dynarr_atp (w->face_cachels, Dynarr_length (w->face_cachels) - 1);
+      struct face_cachel *cachel = Dynarr_lastp (w->face_cachels);
 
       FROB (background_pixmap);
       MAYBE_UNFROB_BACKGROUND_PIXMAP;
@@ -2030,30 +2034,30 @@
 
 DEFUN ("specifier-tag-one-dimensional-p",
        Fspecifier_tag_one_dimensional_p,
-       2, 2, 0, /*
+       1, 1, 0, /*
 Return non-nil if (charset-dimension CHARSET) is 1.
 
 Used by the X11 platform font code; see `define-specifier-tag'.  You
 shouldn't ever need to call this yourself.
 */
-       (charset, UNUSED(stage)))
+       (charset))
 {
-  CHECK_CHARSET(charset);
-  return (1 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil;
+  CHECK_CHARSET (charset);
+  return (1 == XCHARSET_DIMENSION (charset)) ? Qt : Qnil;
 }
 
 DEFUN ("specifier-tag-two-dimensional-p",
        Fspecifier_tag_two_dimensional_p,
-       2, 2, 0, /*
+       1, 1, 0, /*
 Return non-nil if (charset-dimension CHARSET) is 2.
 
 Used by the X11 platform font code; see `define-specifier-tag'.  You
 shouldn't ever need to call this yourself.
 */
-       (charset, UNUSED(stage)))
+       (charset))
 {
-  CHECK_CHARSET(charset);
-  return (2 == XCHARSET_DIMENSION(charset)) ? Qt : Qnil;
+  CHECK_CHARSET (charset);
+  return (2 == XCHARSET_DIMENSION (charset)) ? Qt : Qnil;
 }
 
 DEFUN ("specifier-tag-final-stage-p",
@@ -2064,9 +2068,9 @@
 Used by the X11 platform font code for giving fallbacks; see
 `define-specifier-tag'.  You shouldn't ever need to call this.
 */
-       (UNUSED(charset), stage))
+       (UNUSED (charset), stage))
 {
-  return EQ(stage, Qfinal) ? Qt : Qnil;
+  return EQ (stage, Qfinal) ? Qt : Qnil;
 }
 
 DEFUN ("specifier-tag-initial-stage-p",
@@ -2231,7 +2235,7 @@
 
   Vdefault_face = Qnil; /* so that Fmake_face() doesn't set up a bogus
 			   default value */
-  Vdefault_face = Fmake_face (Qdefault, build_msg_string ("default face"),
+  Vdefault_face = Fmake_face (Qdefault, build_defer_string ("default face"),
 			      Qnil);
 
   /* Provide some last-resort fallbacks to avoid utter fuckage if
@@ -2241,22 +2245,22 @@
     Lisp_Object fg_fb = Qnil, bg_fb = Qnil;
 
 #ifdef HAVE_GTK
-    fg_fb = acons (list1 (Qgtk), build_string ("black"), fg_fb);
-    bg_fb = acons (list1 (Qgtk), build_string ("white"), bg_fb);
+    fg_fb = acons (list1 (Qgtk), build_ascstring ("black"), fg_fb);
+    bg_fb = acons (list1 (Qgtk), build_ascstring ("white"), bg_fb);
 #endif
 #ifdef HAVE_X_WINDOWS
-    fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
-    bg_fb = acons (list1 (Qx), build_string ("white"), bg_fb);
+    fg_fb = acons (list1 (Qx), build_ascstring ("black"), fg_fb);
+    bg_fb = acons (list1 (Qx), build_ascstring ("gray80"), bg_fb);
 #endif
 #ifdef HAVE_TTY
     fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
     bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
 #endif
 #ifdef HAVE_MS_WINDOWS
-    fg_fb = acons (list1 (Qmsprinter), build_string ("black"), fg_fb);
-    bg_fb = acons (list1 (Qmsprinter), build_string ("white"), bg_fb);
-    fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
-    bg_fb = acons (list1 (Qmswindows), build_string ("white"), bg_fb);
+    fg_fb = acons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb);
+    bg_fb = acons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb);
+    fg_fb = acons (list1 (Qmswindows), build_ascstring ("black"), fg_fb);
+    bg_fb = acons (list1 (Qmswindows), build_ascstring ("white"), bg_fb);
 #endif
     set_specifier_fallback (Fget (Vdefault_face, Qforeground, Qnil), fg_fb);
     set_specifier_fallback (Fget (Vdefault_face, Qbackground, Qnil), bg_fb);
@@ -2273,12 +2277,12 @@
     Lisp_Object device_symbol = Qx;
 #endif
 
-#if defined (USE_XFT) || defined (MULE)
+#if defined (HAVE_XFT) || defined (MULE)
     const Ascbyte **fontptr;
 
     const Ascbyte *fonts[] =
     {
-#ifdef USE_XFT
+#ifdef HAVE_XFT
       /************** Xft fonts *************/
 
       /* Note that fontconfig can search for several font families in one
@@ -2303,7 +2307,7 @@
       "-*-*-medium-r-*-*-*-170-*-*-c-*-*-*",
 #endif
     };
-#endif /* defined (USE_XFT) || defined (MULE) */
+#endif /* defined (HAVE_XFT) || defined (MULE) */
 
 #ifdef MULE
 
@@ -2334,20 +2338,20 @@
 
 #endif /* MULE */
 
-#ifdef USE_XFT
+#ifdef HAVE_XFT
     for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--)
       inst_list = Fcons (Fcons (list1 (device_symbol),
-				build_string (*fontptr)),
+				build_cistring (*fontptr)),
 			 inst_list);
 
-#else /* !USE_XFT */
+#else /* !HAVE_XFT */
     inst_list =
       Fcons
       (Fcons
        (list1 (device_symbol),
 	/* grrr.  This really does need to be "*", not an XLFD.
 	   An unspecified XLFD won't pick up stuff like 10x20. */
-	build_string ("*")),
+	build_ascstring ("*")),
        inst_list);
 #ifdef MULE
 
@@ -2361,7 +2365,7 @@
       Fcons
       (Fcons
        (list4(device_symbol, Qtwo_dimensional, Qfinal, Qx_coverage_instantiator),
-	build_string
+	build_ascstring
 	("-misc-fixed-medium-r-normal--15-140-75-75-c-90-iso10646-1")),
        inst_list);
 
@@ -2373,14 +2377,14 @@
       Fcons
       (Fcons
        (list4(device_symbol, Qone_dimensional, Qfinal, Qx_coverage_instantiator),
-	build_string
+	build_ascstring
 	("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")),
        inst_list);
 
     for (fontptr = fonts + countof(fonts) - 1; fontptr >= fonts; fontptr--)
       inst_list = Fcons (Fcons (list3 (device_symbol,
 				       Qtwo_dimensional, Qinitial),
-				build_string (*fontptr)),
+				build_cistring (*fontptr)),
 			 inst_list);
 
     /* We need to set the font for the JIT-ucs-charsets separately from the
@@ -2393,7 +2397,7 @@
       Fcons
       (Fcons
        (list4(device_symbol, Qencode_as_utf_8, Qinitial, Qx_coverage_instantiator),
-	build_string
+	build_ascstring
 	("-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-iso10646-1")),
        inst_list);
 
@@ -2405,7 +2409,7 @@
       Fcons
       (Fcons
        (list1 (device_symbol),
-	build_string ("-*-*-medium-r-*-*-*-120-*-*-c-*-*-*")),
+	build_ascstring ("-*-*-medium-r-*-*-*-120-*-*-c-*-*-*")),
        inst_list);
 
     /* With a Cygwin XFree86 install, this returns the best (clearest,
@@ -2418,15 +2422,15 @@
       Fcons
       (Fcons
        (list1 (device_symbol),
-	build_string ("-*-lucidatypewriter-medium-r-*-*-*-120-*-*-*-*-*-*")),
+	build_ascstring ("-*-lucidatypewriter-medium-r-*-*-*-120-*-*-*-*-*-*")),
        inst_list);
 
-#endif /* !USE_XFT */
+#endif /* !HAVE_XFT */
 
 #endif /* HAVE_X_WINDOWS || HAVE_GTK */
 
 #ifdef HAVE_TTY
-    inst_list = Fcons (Fcons (list1 (Qtty), build_string ("normal")),
+    inst_list = Fcons (Fcons (list1 (Qtty), build_ascstring ("normal")),
 		       inst_list);
 #endif /* HAVE_TTY */
 
@@ -2445,18 +2449,18 @@
 	{
 	  /* display device */
 	  inst_list = Fcons (Fcons (list1 (Qmswindows),
-				    build_string (*mswfontptr)),
+				    build_ascstring (*mswfontptr)),
 			     inst_list);
 	  /* printer device */
 	  inst_list = Fcons (Fcons (list1 (Qmsprinter),
-				    build_string (*mswfontptr)),
+				    build_ascstring (*mswfontptr)),
 			     inst_list);
 	}
        /* Use Lucida Console rather than Courier New if it exists -- the
 	  line spacing is much less, so many more lines fit with the same
 	  size font. (And it's specifically designed for screens.) */
        inst_list = Fcons (Fcons (list1 (Qmswindows),
-				 build_string ("Lucida Console:Regular:10::")),
+				 build_ascstring ("Lucida Console:Regular:10::")),
 			  inst_list);
     }
 #endif /* HAVE_MS_WINDOWS */
@@ -2480,7 +2484,7 @@
   /* gui-element is the parent face of all gui elements such as
      modeline, vertical divider and toolbar. */
   Vgui_element_face = Fmake_face (Qgui_element,
-				  build_msg_string ("gui element face"),
+				  build_defer_string ("gui element face"),
 				  Qnil);
 
   /* Provide some last-resort fallbacks for gui-element face which
@@ -2494,22 +2498,22 @@
     /* We need to put something in there, or error checking gets
        #%!@#ed up before the styles are set, which override the
        fallbacks. */
-    fg_fb = acons (list1 (Qgtk), build_string ("black"), fg_fb);
-    bg_fb = acons (list1 (Qgtk), build_string ("Gray80"), bg_fb);
+    fg_fb = acons (list1 (Qgtk), build_ascstring ("black"), fg_fb);
+    bg_fb = acons (list1 (Qgtk), build_ascstring ("Gray80"), bg_fb);
 #endif
 #ifdef HAVE_X_WINDOWS
-    fg_fb = acons (list1 (Qx), build_string ("black"), fg_fb);
-    bg_fb = acons (list1 (Qx), build_string ("Gray80"), bg_fb);
+    fg_fb = acons (list1 (Qx), build_ascstring ("black"), fg_fb);
+    bg_fb = acons (list1 (Qx), build_ascstring ("Gray80"), bg_fb);
 #endif
 #ifdef HAVE_TTY
     fg_fb = acons (list1 (Qtty), Fvector (0, 0), fg_fb);
     bg_fb = acons (list1 (Qtty), Fvector (0, 0), bg_fb);
 #endif
 #ifdef HAVE_MS_WINDOWS
-    fg_fb = acons (list1 (Qmsprinter), build_string ("black"), fg_fb);
-    bg_fb = acons (list1 (Qmsprinter), build_string ("white"), bg_fb);
-    fg_fb = acons (list1 (Qmswindows), build_string ("black"), fg_fb);
-    bg_fb = acons (list1 (Qmswindows), build_string ("Gray75"), bg_fb);
+    fg_fb = acons (list1 (Qmsprinter), build_ascstring ("black"), fg_fb);
+    bg_fb = acons (list1 (Qmsprinter), build_ascstring ("white"), bg_fb);
+    fg_fb = acons (list1 (Qmswindows), build_ascstring ("black"), fg_fb);
+    bg_fb = acons (list1 (Qmswindows), build_ascstring ("Gray75"), bg_fb);
 #endif
     set_specifier_fallback (Fget (Vgui_element_face, Qforeground, Qnil), fg_fb);
     set_specifier_fallback (Fget (Vgui_element_face, Qbackground, Qnil), bg_fb);
@@ -2520,7 +2524,7 @@
      way since we need to get them anyway. */
 
   /* modeline is gui element. */
-  Vmodeline_face = Fmake_face (Qmodeline, build_msg_string ("modeline face"),
+  Vmodeline_face = Fmake_face (Qmodeline, build_defer_string ("modeline face"),
 			       Qnil);
 
   set_specifier_fallback (Fget (Vmodeline_face, Qforeground, Qunbound),
@@ -2533,7 +2537,7 @@
 
   /* toolbar is another gui element */
   Vtoolbar_face = Fmake_face (Qtoolbar,
-			      build_msg_string ("toolbar face"),
+			      build_defer_string ("toolbar face"),
 			      Qnil);
   set_specifier_fallback (Fget (Vtoolbar_face, Qforeground, Qunbound),
 			  Fget (Vgui_element_face, Qforeground, Qunbound));
@@ -2545,7 +2549,7 @@
 
   /* vertical divider is another gui element */
   Vvertical_divider_face = Fmake_face (Qvertical_divider,
-				       build_msg_string ("vertical divider face"),
+				       build_defer_string ("vertical divider face"),
 				       Qnil);
 
   set_specifier_fallback (Fget (Vvertical_divider_face, Qforeground, Qunbound),
@@ -2559,7 +2563,7 @@
 
   /* widget is another gui element */
   Vwidget_face = Fmake_face (Qwidget,
-			     build_msg_string ("widget face"),
+			     build_defer_string ("widget face"),
 			     Qnil);
   /* #### weird ... the gui-element face doesn't have its own font yet */
   set_specifier_fallback (Fget (Vwidget_face, Qfont, Qunbound),
@@ -2571,17 +2575,17 @@
   /* We don't want widgets to have a default background pixmap. */
 
   Vleft_margin_face = Fmake_face (Qleft_margin,
-				  build_msg_string ("left margin face"),
+				  build_defer_string ("left margin face"),
 				  Qnil);
   Vright_margin_face = Fmake_face (Qright_margin,
-				   build_msg_string ("right margin face"),
+				   build_defer_string ("right margin face"),
 				   Qnil);
   Vtext_cursor_face = Fmake_face (Qtext_cursor,
-				  build_msg_string ("face for text cursor"),
+				  build_defer_string ("face for text cursor"),
 				  Qnil);
   Vpointer_face =
     Fmake_face (Qpointer,
-		build_msg_string
+		build_defer_string
 		("face for foreground/background colors of mouse pointer"),
 		Qnil);
 }