diff src/objects.c @ 5080:5502045ec510

The background-placement face property. -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-02-25 Didier Verna <didier@xemacs.org> The background-placement face property. * cl-macs.el (face-background-placement): New defsetf. * cus-face.el (custom-face-attributes): * faces.el (face-interactive): * faces.el (set-face-property): * faces.el (face-equal): * faces.el (init-other-random-faces): Update. * faces.el (face-background-placement): * faces.el (set-face-background-placement): * faces.el (face-background-placement-instance): * faces.el (face-background-placement-instance-p): * frame.el (set-frame-background-placement): * frame.el (frame-background-placement): * frame.el (frame-background-placement-instance): * objects.el (make-face-background-placement-specifier): New. man/ChangeLog addition: 2010-02-25 Didier Verna <didier@xemacs.org> The background-placement face property. * xemacs/custom.texi (Faces): Document it. src/ChangeLog addition: 2010-02-25 Didier Verna <didier@xemacs.org> The background-placement face property. * console-x-impl.h (struct x_frame): Add new slots x and y. * console-x-impl.h (FRAME_X_X, FRAME_X_Y): New slot accessors. * console-gtk-impl.h: Fake something similar for potential port. * frame-x.c (x_get_frame_text_position): New function. * frame-x.c (x_init_frame_3): Use it. * event-Xt.c (emacs_Xt_handle_magic_event): Eat spurious ConfigureNotify events, get the frame position and mark frame faces changed. * objects-impl.h: The face_background_placement_specifier structure and its accessors. * objects.c: New symbols Qabsolute and Qrelative. * objects.c (face_background_placement_create): * objects.c (face_background_placement_mark): * objects.c (face_background_placement_instantiate): * objects.c (face_background_placement_validate): * objects.c (face_background_placement_after_change): * objects.c (set_face_background_placement_attached_to): New. * objects.h (set_face_background_palcement_attached_to): Declare the one above. * objects.c (syms_of_objects): * objects.c (specifier_type_create_objects): * objects.c (reinit_specifier_type_create_objects): * objects.c (reinit_vars_of_objects): Update for the modifications above. * console-xlike-inc.h (XLIKE_GC_TS_X_ORIGIN, XLIKE_GC_TS_X_ORIGIN): New X11/Gtk compatibility macros. * redisplay-xlike-inc.c (XLIKE_get_gc): Add a background placement argument and handle it. * gtk-glue.c (face_to_gc): * redisplay-xlike-inc.c (XLIKE_output_string): * redisplay-xlike-inc.c (XLIKE_output_pixmap): * redisplay-xlike-inc.c (XLIKE_output_blank): * redisplay-xlike-inc.c (XLIKE_output_horizontal_line): * redisplay-xlike-inc.c (XLIKE_output_eol_cursor): Update accordingly. * console-impl.h (struct console_methods): Add a background placement (Lisp_Object) argument to the clear_region method. * console-stream.c (stream_clear_region): * redisplay-tty.c (tty_clear_region): * redisplay-msw.c (mswindows_clear_region): * redisplay-xlike-inc.c (XLIKE_clear_region): Update accordingly. * redisplay-output.c (redisplay_clear_region): Handle the background placement property and update the call to the clear_region method. * faces.h (struct Lisp_Face): * faces.h (struct face_cachel): Add a background placement slot. * faces.h (WINDOW_FACE_CACHEL_BACKGROUND_PLACEMENT): New accessor. * faces.c (mark_face): * faces.c (face_equal): * faces.c (face_getprop): * faces.c (face_putprop): * faces.c (face_remprop): * faces.c (face_plist): * faces.c (reset_face): * faces.c (mark_face_cachels): * faces.c (update_face_cachel_data): * faces.c (merge_face_cachel_data): * faces.c (reset_face_cachel): * faces.c (Fmake_face): * faces.c (Fcopy_face): Handle the background placement property. * faces.c (syms_of_faces): * faces.c (vars_of_faces): * faces.c (complex_vars_of_faces): Update accordingly.
author Didier Verna <didier@lrde.epita.fr>
date Thu, 25 Feb 2010 16:19:01 +0100
parents d95c102a96d3
children 7be849cb8828
line wrap: on
line diff
--- a/src/objects.c	Thu Feb 25 06:14:50 2010 -0600
+++ b/src/objects.c	Thu Feb 25 16:19:01 2010 +0100
@@ -2,6 +2,7 @@
    Copyright (C) 1995 Free Software Foundation, Inc.
    Copyright (C) 1995 Board of Trustees, University of Illinois.
    Copyright (C) 1995, 1996, 2002, 2004, 2005, 2010 Ben Wing.
+   Copyright (C) 2010 Didier Verna
 
 This file is part of XEmacs.
 
@@ -1212,6 +1213,130 @@
 }
 
 
+/*****************************************************************************
+ Face Background Placement Object
+ ****************************************************************************/
+Lisp_Object Qabsolute, Qrelative;
+
+static const struct memory_description
+face_background_placement_specifier_description[] = {
+  { XD_LISP_OBJECT, offsetof (struct face_background_placement_specifier,
+			      face) },
+  { XD_END }
+};
+
+DEFINE_SPECIFIER_TYPE_WITH_DATA (face_background_placement);
+Lisp_Object Qface_background_placement;
+
+static void
+face_background_placement_create (Lisp_Object obj)
+{
+  Lisp_Specifier *face_background_placement
+    = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
+
+  FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement) = Qnil;
+}
+
+static void
+face_background_placement_mark (Lisp_Object obj)
+{
+  Lisp_Specifier *face_background_placement
+    = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
+
+  mark_object
+    (FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement));
+}
+
+/* No equal or hash methods; ignore the face the background-placement is based
+   off of for `equal' */
+
+extern Lisp_Object Qbackground_placement;
+
+static Lisp_Object
+face_background_placement_instantiate (Lisp_Object UNUSED (specifier),
+				       Lisp_Object UNUSED (matchspec),
+				       Lisp_Object domain,
+				       Lisp_Object instantiator,
+				       Lisp_Object depth,
+				       int no_fallback)
+{
+  /* When called, we're inside of call_with_suspended_errors(),
+     so we can freely error. */
+  if (EQ (instantiator, Qabsolute) || EQ (instantiator, Qrelative))
+    return instantiator;
+  else if (VECTORP (instantiator))
+    {
+      assert (XVECTOR_LENGTH (instantiator) == 1);
+
+      return FACE_PROPERTY_INSTANCE_1
+	(Fget_face (XVECTOR_DATA (instantiator)[0]),
+	 Qbackground_placement, domain, ERROR_ME, no_fallback, depth);
+    }
+  else
+    ABORT ();	/* Eh? */
+
+  return Qunbound;
+}
+
+static void
+face_background_placement_validate (Lisp_Object instantiator)
+{
+  if (EQ (instantiator, Qabsolute) || EQ (instantiator, Qrelative))
+    return;
+  else if (VECTORP (instantiator) &&
+	   (XVECTOR_LENGTH (instantiator) == 1))
+    {
+      Lisp_Object face = XVECTOR_DATA (instantiator)[0];
+
+      Fget_face (face); /* just to check that the face exists -- dvl */
+    }
+  else if (VECTORP (instantiator))
+    sferror ("Wrong length for background-placement inheritance spec",
+	     instantiator);
+  else
+    invalid_argument
+      ("\
+Background-placement instantiator must be absolute, relative or vector",
+       instantiator);
+}
+
+static void
+face_background_placement_after_change (Lisp_Object specifier,
+					Lisp_Object locale)
+{
+  Lisp_Object face
+    = FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE
+    (XFACE_BACKGROUND_PLACEMENT_SPECIFIER (specifier));
+
+  if (!NILP (face))
+    {
+      face_property_was_changed (face, Qbackground_placement, locale);
+      if (BUFFERP (locale))
+	XBUFFER (locale)->buffer_local_face_property = 1;
+    }
+}
+
+void
+set_face_background_placement_attached_to (Lisp_Object obj, Lisp_Object face)
+{
+  Lisp_Specifier *face_background_placement
+    = XFACE_BACKGROUND_PLACEMENT_SPECIFIER (obj);
+
+  FACE_BACKGROUND_PLACEMENT_SPECIFIER_FACE (face_background_placement) = face;
+}
+
+DEFUN ("face-background-placement-specifier-p", Fface_background_placement_specifier_p, 1, 1, 0, /*
+Return non-nil if OBJECT is a face-background-placement specifier.
+
+See `make-face-background-placement-specifier' for a description of possible
+face-background-placement instantiators.
+*/
+       (object))
+{
+  return FACE_BACKGROUND_PLACEMENT_SPECIFIERP (object) ? Qt : Qnil;
+}
+
+
 /************************************************************************/
 /*                            initialization                            */
 /************************************************************************/
@@ -1225,6 +1350,7 @@
   DEFSUBR (Fcolor_specifier_p);
   DEFSUBR (Ffont_specifier_p);
   DEFSUBR (Fface_boolean_specifier_p);
+  DEFSUBR (Fface_background_placement_specifier_p);
 
   DEFSYMBOL_MULTIWORD_PREDICATE (Qcolor_instancep);
   DEFSUBR (Fmake_color_instance);
@@ -1249,6 +1375,10 @@
 
   /* Qcolor, Qfont defined in general.c */
   DEFSYMBOL (Qface_boolean);
+
+  DEFSYMBOL (Qface_background_placement);
+  DEFSYMBOL (Qabsolute);
+  DEFSYMBOL (Qrelative);
 }
 
 void
@@ -1258,26 +1388,35 @@
   INITIALIZE_SPECIFIER_TYPE_WITH_DATA (font, "font", "font-specifier-p");
   INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_boolean, "face-boolean",
 					 "face-boolean-specifier-p");
+  INITIALIZE_SPECIFIER_TYPE_WITH_DATA (face_background_placement,
+				       "face-background-placement",
+				       "\
+face-background-placement-specifier-p");
 
   SPECIFIER_HAS_METHOD (color, instantiate);
   SPECIFIER_HAS_METHOD (font, instantiate);
   SPECIFIER_HAS_METHOD (face_boolean, instantiate);
+  SPECIFIER_HAS_METHOD (face_background_placement, instantiate);
 
   SPECIFIER_HAS_METHOD (color, validate);
   SPECIFIER_HAS_METHOD (font, validate);
   SPECIFIER_HAS_METHOD (face_boolean, validate);
+  SPECIFIER_HAS_METHOD (face_background_placement, validate);
 
   SPECIFIER_HAS_METHOD (color, create);
   SPECIFIER_HAS_METHOD (font, create);
   SPECIFIER_HAS_METHOD (face_boolean, create);
+  SPECIFIER_HAS_METHOD (face_background_placement, create);
 
   SPECIFIER_HAS_METHOD (color, mark);
   SPECIFIER_HAS_METHOD (font, mark);
   SPECIFIER_HAS_METHOD (face_boolean, mark);
+  SPECIFIER_HAS_METHOD (face_background_placement, mark);
 
   SPECIFIER_HAS_METHOD (color, after_change);
   SPECIFIER_HAS_METHOD (font, after_change);
   SPECIFIER_HAS_METHOD (face_boolean, after_change);
+  SPECIFIER_HAS_METHOD (face_background_placement, after_change);
 
 #ifdef MULE
   SPECIFIER_HAS_METHOD (font, validate_matchspec);
@@ -1290,6 +1429,7 @@
   REINITIALIZE_SPECIFIER_TYPE (color);
   REINITIALIZE_SPECIFIER_TYPE (font);
   REINITIALIZE_SPECIFIER_TYPE (face_boolean);
+  REINITIALIZE_SPECIFIER_TYPE (face_background_placement);
 }
 
 void