XEmacs 21.4.17 "Jumbo Shrimp".
[chise/xemacs-chise.git.1] / src / objects.c
index 9e9e8b1..c57270f 100644 (file)
@@ -43,7 +43,7 @@ void
 finalose (void *ptr)
 {
   Lisp_Object obj;
-  XSETOBJ (obj, Lisp_Type_Record, ptr);
+  XSETOBJ (obj, ptr);
 
   signal_simple_error
     ("Can't dump an emacs containing window system objects", obj);
@@ -59,7 +59,7 @@ Lisp_Object Qcolor_instancep;
 static Lisp_Object
 mark_color_instance (Lisp_Object obj)
 {
-  struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
+  Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
   mark_object (c->name);
   if (!NILP (c->device)) /* Vthe_null_color_instance */
     MAYBE_DEVMETH (XDEVICE (c->device), mark_color_instance, (c));
@@ -72,7 +72,7 @@ print_color_instance (Lisp_Object obj, Lisp_Object printcharfun,
                      int escapeflag)
 {
   char buf[100];
-  struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
+  Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
   if (print_readably)
     error ("printing unreadable object #<color-instance 0x%x>",
            c->header.uid);
@@ -90,7 +90,7 @@ print_color_instance (Lisp_Object obj, Lisp_Object printcharfun,
 static void
 finalize_color_instance (void *header, int for_disksave)
 {
-  struct Lisp_Color_Instance *c = (struct Lisp_Color_Instance *) header;
+  Lisp_Color_Instance *c = (Lisp_Color_Instance *) header;
 
   if (!NILP (c->device))
     {
@@ -102,8 +102,8 @@ finalize_color_instance (void *header, int for_disksave)
 static int
 color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 {
-  struct Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
-  struct Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
+  Lisp_Color_Instance *c1 = XCOLOR_INSTANCE (obj1);
+  Lisp_Color_Instance *c2 = XCOLOR_INSTANCE (obj2);
 
   return (c1 == c2) ||
     (EQ (c1->device, c2->device) &&
@@ -115,7 +115,7 @@ color_instance_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
 static unsigned long
 color_instance_hash (Lisp_Object obj, int depth)
 {
-  struct Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
+  Lisp_Color_Instance *c = XCOLOR_INSTANCE (obj);
   struct device *d = DEVICEP (c->device) ? XDEVICE (c->device) : 0;
 
   return HASH2 ((unsigned long) d,
@@ -128,7 +128,7 @@ DEFINE_LRECORD_IMPLEMENTATION ("color-instance", color_instance,
                               mark_color_instance, print_color_instance,
                               finalize_color_instance, color_instance_equal,
                               color_instance_hash, 0,
-                              struct Lisp_Color_Instance);
+                              Lisp_Color_Instance);
 \f
 DEFUN ("make-color-instance", Fmake_color_instance, 1, 3, 0, /*
 Return a new `color-instance' object named NAME (a string).
@@ -137,8 +137,8 @@ Optional argument DEVICE specifies the device this object applies to
 and defaults to the selected device.
 
 An error is signaled if the color is unknown or cannot be allocated;
-however, if optional argument NO-ERROR is non-nil, nil is simply
-returned in this case. (And if NO-ERROR is other than t, a warning may
+however, if optional argument NOERROR is non-nil, nil is simply
+returned in this case. (And if NOERROR is other than t, a warning may
 be issued.)
 
 The returned object is a normal, first-class lisp object.  The way you
@@ -147,23 +147,23 @@ you drop all pointers to it and allow it to be garbage collected.  When
 these objects are GCed, the underlying window-system data (e.g. X object)
 is deallocated as well.
 */
-       (name, device, no_error))
+       (name, device, noerror))
 {
-  struct Lisp_Color_Instance *c;
+  Lisp_Color_Instance *c;
   Lisp_Object val;
   int retval;
 
   CHECK_STRING (name);
   XSETDEVICE (device, decode_device (device));
 
-  c = alloc_lcrecord_type (struct Lisp_Color_Instance, &lrecord_color_instance);
+  c = alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
   c->name = name;
   c->device = device;
   c->data = 0;
 
   retval = MAYBE_INT_DEVMETH (XDEVICE (device), initialize_color_instance,
                              (c, name, device,
-                              decode_error_behavior_flag (no_error)));
+                              decode_error_behavior_flag (noerror)));
   if (!retval)
     return Qnil;
 
@@ -195,7 +195,7 @@ Component values range from 0 to 65535.
 */
        (color_instance))
 {
-  struct Lisp_Color_Instance *c;
+  Lisp_Color_Instance *c;
 
   CHECK_COLOR_INSTANCE (color_instance);
   c = XCOLOR_INSTANCE (color_instance);
@@ -239,7 +239,7 @@ static Lisp_Object font_instance_truename_internal (Lisp_Object xfont,
 static Lisp_Object
 mark_font_instance (Lisp_Object obj)
 {
-  struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
+  Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
 
   mark_object (f->name);
   if (!NILP (f->device)) /* Vthe_null_font_instance */
@@ -252,7 +252,7 @@ static void
 print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
   char buf[200];
-  struct Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
+  Lisp_Font_Instance *f = XFONT_INSTANCE (obj);
   if (print_readably)
     error ("printing unreadable object #<font-instance 0x%x>", f->header.uid);
   write_c_string ("#<font-instance ", printcharfun);
@@ -269,7 +269,7 @@ print_font_instance (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 static void
 finalize_font_instance (void *header, int for_disksave)
 {
-  struct Lisp_Font_Instance *f = (struct Lisp_Font_Instance *) header;
+  Lisp_Font_Instance *f = (Lisp_Font_Instance *) header;
 
   if (!NILP (f->device))
     {
@@ -301,7 +301,7 @@ font_instance_hash (Lisp_Object obj, int depth)
 DEFINE_LRECORD_IMPLEMENTATION ("font-instance", font_instance,
                               mark_font_instance, print_font_instance,
                               finalize_font_instance, font_instance_equal,
-                              font_instance_hash, 0, struct Lisp_Font_Instance);
+                              font_instance_hash, 0, Lisp_Font_Instance);
 \f
 DEFUN ("make-font-instance", Fmake_font_instance, 1, 3, 0, /*
 Return a new `font-instance' object named NAME.
@@ -315,12 +315,12 @@ The returned object is a normal, first-class lisp object.  The way you
 you drop all pointers to it and allow it to be garbage collected.  When
 these objects are GCed, the underlying X data is deallocated as well.
 */
-       (name, device, no_error))
+       (name, device, noerror))
 {
-  struct Lisp_Font_Instance *f;
+  Lisp_Font_Instance *f;
   Lisp_Object val;
   int retval = 0;
-  Error_behavior errb = decode_error_behavior_flag (no_error);
+  Error_behavior errb = decode_error_behavior_flag (noerror);
 
   if (ERRB_EQ (errb, ERROR_ME))
     CHECK_STRING (name);
@@ -329,7 +329,7 @@ these objects are GCed, the underlying X data is deallocated as well.
 
   XSETDEVICE (device, decode_device (device));
 
-  f = alloc_lcrecord_type (struct Lisp_Font_Instance, &lrecord_font_instance);
+  f = alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
   f->name = name;
   f->device = device;
 
@@ -417,15 +417,15 @@ static Lisp_Object
 font_instance_truename_internal (Lisp_Object font_instance,
                                 Error_behavior errb)
 {
-  struct Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance);
-  
+  Lisp_Font_Instance *f = XFONT_INSTANCE (font_instance);
+
   if (NILP (f->device))
     {
       maybe_signal_simple_error ("Couldn't determine font truename",
                                 font_instance, Qfont, errb);
       return Qnil;
     }
-  
+
   return DEVMETH_OR_GIVEN (XDEVICE (f->device),
                           font_instance_truename, (f, errb), f->name);
 }
@@ -447,7 +447,7 @@ Return the properties (an alist or nil) of FONT-INSTANCE.
 */
        (font_instance))
 {
-  struct Lisp_Font_Instance *f;
+  Lisp_Font_Instance *f;
 
   CHECK_FONT_INSTANCE (font_instance);
   f = XFONT_INSTANCE (font_instance);
@@ -482,7 +482,7 @@ DEFINE_SPECIFIER_TYPE (color);
 static void
 color_create (Lisp_Object obj)
 {
-  struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
+  Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
 
   COLOR_SPECIFIER_FACE (color) = Qnil;
   COLOR_SPECIFIER_FACE_PROPERTY (color) = Qnil;
@@ -491,7 +491,7 @@ color_create (Lisp_Object obj)
 static void
 color_mark (Lisp_Object obj)
 {
-  struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
+  Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
 
   mark_object (COLOR_SPECIFIER_FACE (color));
   mark_object (COLOR_SPECIFIER_FACE_PROPERTY (color));
@@ -507,7 +507,7 @@ color_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
 {
   /* When called, we're inside of call_with_suspended_errors(),
      so we can freely error. */
-  Lisp_Object device = DFW_DEVICE (domain);
+  Lisp_Object device = DOMAIN_DEVICE (domain);
   struct device *d = XDEVICE (device);
 
   if (COLOR_INSTANCEP (instantiator))
@@ -563,7 +563,7 @@ color_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
                   XVECTOR_DATA (instantiator)[1], domain, ERROR_ME, 0, depth));
 
        default:
-         abort ();
+         ABORT ();
        }
     }
   else if (NILP (instantiator))
@@ -575,7 +575,7 @@ color_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
                             device);
     }
   else
-    abort ();  /* The spec validation routines are screwed up. */
+    ABORT ();  /* The spec validation routines are screwed up. */
 
   return Qunbound;
 }
@@ -616,13 +616,17 @@ color_after_change (Lisp_Object specifier, Lisp_Object locale)
   Lisp_Object property =
     COLOR_SPECIFIER_FACE_PROPERTY (XCOLOR_SPECIFIER (specifier));
   if (!NILP (face))
-    face_property_was_changed (face, property, locale);
+    {
+      face_property_was_changed (face, property, locale);
+      if (BUFFERP (locale))
+       XBUFFER (locale)->buffer_local_face_property = 1;
+    }
 }
 
 void
 set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
 {
-  struct Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
+  Lisp_Specifier *color = XCOLOR_SPECIFIER (obj);
 
   COLOR_SPECIFIER_FACE (color) = face;
   COLOR_SPECIFIER_FACE_PROPERTY (color) = property;
@@ -631,19 +635,7 @@ set_color_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
 DEFUN ("color-specifier-p", Fcolor_specifier_p, 1, 1, 0, /*
 Return t if OBJECT is a color specifier.
 
-Valid instantiators for color specifiers are:
-
--- a string naming a color (e.g. under X this might be "lightseagreen2"
-   or "#F534B2")
--- a color instance (use that instance directly if the device matches,
-   or use the string that generated it)
--- a vector of no elements (only on TTY's; this means to set no color
-   at all, thus using the "natural" color of the terminal's text)
--- a vector of one or two elements: a face to inherit from, and
-   optionally a symbol naming which property of that face to inherit,
-   either `foreground' or `background' (if omitted, defaults to the same
-   property that this color specifier is used for; if this specifier is
-   not part of a face, the instantiator would not be valid)
+See `make-color-specifier' for a description of possible color instantiators.
 */
        (object))
 {
@@ -660,7 +652,7 @@ DEFINE_SPECIFIER_TYPE (font);
 static void
 font_create (Lisp_Object obj)
 {
-  struct Lisp_Specifier *font = XFONT_SPECIFIER (obj);
+  Lisp_Specifier *font = XFONT_SPECIFIER (obj);
 
   FONT_SPECIFIER_FACE (font) = Qnil;
   FONT_SPECIFIER_FACE_PROPERTY (font) = Qnil;
@@ -669,7 +661,7 @@ font_create (Lisp_Object obj)
 static void
 font_mark (Lisp_Object obj)
 {
-  struct Lisp_Specifier *font = XFONT_SPECIFIER (obj);
+  Lisp_Specifier *font = XFONT_SPECIFIER (obj);
 
   mark_object (FONT_SPECIFIER_FACE (font));
   mark_object (FONT_SPECIFIER_FACE_PROPERTY (font));
@@ -682,7 +674,7 @@ font_mark (Lisp_Object obj)
 
 int
 font_spec_matches_charset (struct device *d, Lisp_Object charset,
-                          CONST Bufbyte *nonreloc, Lisp_Object reloc,
+                          const Bufbyte *nonreloc, Lisp_Object reloc,
                           Bytecount offset, Bytecount length)
 {
   return DEVMETH_OR_GIVEN (d, font_spec_matches_charset,
@@ -706,7 +698,7 @@ font_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
 {
   /* When called, we're inside of call_with_suspended_errors(),
      so we can freely error. */
-  Lisp_Object device = DFW_DEVICE (domain);
+  Lisp_Object device = DOMAIN_DEVICE (domain);
   struct device *d = XDEVICE (device);
   Lisp_Object instance;
 
@@ -795,7 +787,7 @@ font_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
   else if (NILP (instantiator))
     return Qunbound;
   else
-    abort ();  /* Eh? */
+    ABORT ();  /* Eh? */
 
   return Qunbound;
 }
@@ -826,13 +818,17 @@ font_after_change (Lisp_Object specifier, Lisp_Object locale)
   Lisp_Object property =
     FONT_SPECIFIER_FACE_PROPERTY (XFONT_SPECIFIER (specifier));
   if (!NILP (face))
-    face_property_was_changed (face, property, locale);
+    {
+      face_property_was_changed (face, property, locale);
+      if (BUFFERP (locale))
+       XBUFFER (locale)->buffer_local_face_property = 1;
+    }
 }
 
 void
 set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
 {
-  struct Lisp_Specifier *font = XFONT_SPECIFIER (obj);
+  Lisp_Specifier *font = XFONT_SPECIFIER (obj);
 
   FONT_SPECIFIER_FACE (font) = face;
   FONT_SPECIFIER_FACE_PROPERTY (font) = property;
@@ -841,16 +837,7 @@ set_font_attached_to (Lisp_Object obj, Lisp_Object face, Lisp_Object property)
 DEFUN ("font-specifier-p", Ffont_specifier_p, 1, 1, 0, /*
 Return non-nil if OBJECT is a font specifier.
 
-Valid instantiators for font specifiers are:
-
--- a string naming a font (e.g. under X this might be
-   "-*-courier-medium-r-*-*-*-140-*-*-*-*-iso8859-*" for a 14-point
-   upright medium-weight Courier font)
--- a font instance (use that instance directly if the device matches,
-   or use the string that generated it)
--- a vector of no elements (only on TTY's; this means to set no font
-   at all, thus using the "natural" font of the terminal's text)
--- a vector of one element (a face to inherit from)
+See `make-font-specifier' for a description of possible font instantiators.
 */
        (object))
 {
@@ -867,7 +854,7 @@ Lisp_Object Qface_boolean;
 static void
 face_boolean_create (Lisp_Object obj)
 {
-  struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
+  Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
 
   FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = Qnil;
   FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = Qnil;
@@ -876,7 +863,7 @@ face_boolean_create (Lisp_Object obj)
 static void
 face_boolean_mark (Lisp_Object obj)
 {
-  struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
+  Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
 
   mark_object (FACE_BOOLEAN_SPECIFIER_FACE (face_boolean));
   mark_object (FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean));
@@ -923,7 +910,7 @@ face_boolean_instantiate (Lisp_Object specifier, Lisp_Object matchspec,
       return retval;
     }
   else
-    abort ();  /* Eh? */
+    ABORT ();  /* Eh? */
 
   return Qunbound;
 }
@@ -970,14 +957,18 @@ face_boolean_after_change (Lisp_Object specifier, Lisp_Object locale)
   Lisp_Object property =
     FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (XFACE_BOOLEAN_SPECIFIER (specifier));
   if (!NILP (face))
-    face_property_was_changed (face, property, locale);
+    {
+      face_property_was_changed (face, property, locale);
+      if (BUFFERP (locale))
+       XBUFFER (locale)->buffer_local_face_property = 1;
+    }
 }
 
 void
 set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face,
                              Lisp_Object property)
 {
-  struct Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
+  Lisp_Specifier *face_boolean = XFACE_BOOLEAN_SPECIFIER (obj);
 
   FACE_BOOLEAN_SPECIFIER_FACE (face_boolean) = face;
   FACE_BOOLEAN_SPECIFIER_FACE_PROPERTY (face_boolean) = property;
@@ -986,15 +977,8 @@ set_face_boolean_attached_to (Lisp_Object obj, Lisp_Object face,
 DEFUN ("face-boolean-specifier-p", Fface_boolean_specifier_p, 1, 1, 0, /*
 Return non-nil if OBJECT is a face-boolean specifier.
 
-Valid instantiators for face-boolean specifiers are
-
--- t or nil
--- a vector of two or three elements: a face to inherit from,
-   optionally a symbol naming the property of that face to inherit from
-   (if omitted, defaults to the same property that this face-boolean
-   specifier is used for; if this specifier is not part of a face,
-   the instantiator would not be valid), and optionally a value which,
-   if non-nil, means to invert the sense of the inherited property.
+See `make-face-boolean-specifier' for a description of possible
+face-boolean instantiators.
 */
        (object))
 {
@@ -1009,6 +993,9 @@ Valid instantiators for face-boolean specifiers are
 void
 syms_of_objects (void)
 {
+  INIT_LRECORD_IMPLEMENTATION (color_instance);
+  INIT_LRECORD_IMPLEMENTATION (font_instance);
+
   DEFSUBR (Fcolor_specifier_p);
   DEFSUBR (Ffont_specifier_p);
   DEFSUBR (Fface_boolean_specifier_p);
@@ -1037,17 +1024,20 @@ syms_of_objects (void)
 }
 
 static const struct lrecord_description color_specifier_description[] = {
-  { XD_LISP_OBJECT, specifier_data_offset + offsetof(struct color_specifier, face), 2 },
+  { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face) },
+  { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct color_specifier, face_property) },
   { XD_END }
 };
 
 static const struct lrecord_description font_specifier_description[] = {
-  { XD_LISP_OBJECT, specifier_data_offset + offsetof(struct font_specifier, face), 2 },
+  { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face) },
+  { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct font_specifier, face_property) },
   { XD_END }
 };
 
 static const struct lrecord_description face_boolean_specifier_description[] = {
-  { XD_LISP_OBJECT, specifier_data_offset + offsetof(struct face_boolean_specifier, face), 2 },
+  { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face) },
+  { XD_LISP_OBJECT, specifier_data_offset + offsetof (struct face_boolean_specifier, face_property) },
   { XD_END }
 };
 
@@ -1097,8 +1087,8 @@ reinit_vars_of_objects (void)
 {
   staticpro_nodump (&Vthe_null_color_instance);
   {
-    struct Lisp_Color_Instance *c =
-      alloc_lcrecord_type (struct Lisp_Color_Instance, &lrecord_color_instance);
+    Lisp_Color_Instance *c =
+      alloc_lcrecord_type (Lisp_Color_Instance, &lrecord_color_instance);
     c->name = Qnil;
     c->device = Qnil;
     c->data = 0;
@@ -1108,8 +1098,8 @@ reinit_vars_of_objects (void)
 
   staticpro_nodump (&Vthe_null_font_instance);
   {
-    struct Lisp_Font_Instance *f =
-      alloc_lcrecord_type (struct Lisp_Font_Instance, &lrecord_font_instance);
+    Lisp_Font_Instance *f =
+      alloc_lcrecord_type (Lisp_Font_Instance, &lrecord_font_instance);
     f->name = Qnil;
     f->device = Qnil;
     f->data = 0;