xemacs-beta: src/specifier.c comparison

comparison src/specifier.c @ 4426:515b91f904c1

Fix specifier inheritance behavior This patch ensures that no fallback is used if so requested, when the specifier instantiation process involves inheritance (for instance, a face [property] inheriting from another face [property]).

author	Didier Verna <didier@xemacs.org>
date	Tue, 26 Feb 2008 18:02:34 +0100
parents	edaaf9a96d40
children	11357f7846bf

comparison

equal deleted inserted replaced

-:bfb8a26de3cb
+:515b91f904c1
 {
 if (! marked_p (rest))
 	{
 	  Lisp_Specifier* sp = XSPECIFIER (rest);
 	  /* A bit of assertion that we're removing both parts of the
-magic one altogether */
+	     magic one altogether */
 	  assert (!MAGIC_SPECIFIER_P(sp)
 		  || (BODILY_SPECIFIER_P(sp) && marked_p (sp->fallback))
 		  || (GHOST_SPECIFIER_P(sp) && marked_p (sp->magic_parent)));
 	  /* This specifier is garbage.  Remove it from the list. */
 	  if (NILP (prev))
 static const struct memory_description specifier_caching_description_1[] = {
 { XD_END }
 };
 #ifdef NEW_GC
 DEFINE_LRECORD_IMPLEMENTATION ("specifier-caching",
 			       specifier_caching,
 			       1, /*dumpable-flag*/
-0, 0, 0, 0, 0,
+			       0, 0, 0, 0, 0,
 			       specifier_caching_description_1,
 			       struct specifier_caching);
 #else /* not NEW_GC */
 static const struct sized_memory_description specifier_caching_description = {
 sizeof (struct specifier_caching),
 	  /* #### get image instances out of domains! */
 	  IMAGE_INSTANCEP (domain))
 ? Qt : Qnil;
 }
 DEFUN ("valid-specifier-locale-type-p", Fvalid_specifier_locale_type_p, 1,
 1, 0, /*
 Given a specifier LOCALE-TYPE, return non-nil if it is valid.
 Valid locale types are `global', `device', `frame', `window', and `buffer'.
 \(Note, however, that in functions that accept either a locale or a locale
 type, `global' is considered an individual locale.)
 return 1;
 }
 static int
 charset_matches_specifier_tag_set_p (Lisp_Object charset,
 				     Lisp_Object tag_set,
 				     enum font_specifier_matchspec_stages
 				     stage)
 {
 Lisp_Object rest;
 int res = 0;
 {
 Lisp_Object tag = XCAR (rest);
 Lisp_Object assoc;
 /* In the event that, during the creation of a charset, no specifier
-tags exist for which CHARSET-PREDICATE has been specified, then
+	 tags exist for which CHARSET-PREDICATE has been specified, then
-that charset's entry in Vcharset_tag_lists will be nil, and this
+	 that charset's entry in Vcharset_tag_lists will be nil, and this
-charset shouldn't match. */
+	 charset shouldn't match. */
 if (NILP (XVECTOR_DATA(Vcharset_tag_lists)[XCHARSET_LEADING_BYTE(charset)
-- MIN_LEADING_BYTE]))
+						 - MIN_LEADING_BYTE]))
-{
+	{
-return 0;
+	  return 0;
-}
+	}
 /* Now, find out what the pre-calculated value is. */
 assoc = assq_no_quit(tag,
 			   XVECTOR_DATA(Vcharset_tag_lists)
 			   [XCHARSET_LEADING_BYTE(charset)
 			    - MIN_LEADING_BYTE]);
 if (!(NILP(assoc)) && !(NILP(XCDR(assoc))))
 	{
 	  assert(VECTORP(XCDR(assoc)));
 return device_matches_specifier_tag_set_p (device, tag_set) ? Qt : Qnil;
 }
 Lisp_Object
 define_specifier_tag(Lisp_Object tag, Lisp_Object device_predicate,
 		     Lisp_Object charset_predicate)
 {
 Lisp_Object assoc = assq_no_quit (tag, Vuser_defined_tags),
 concons, devcons, charpres = Qnil;
 int recompute_devices = 0, recompute_charsets = 0, i, max_args = -1;
 if (NILP (assoc))
 {
 recompute_devices = recompute_charsets = 1;
 Vuser_defined_tags = Fcons (list3 (tag, device_predicate,
 					 charset_predicate),
 				  Vuser_defined_tags);
 DEVICE_LOOP_NO_BREAK (devcons, concons)
 	{
 	  struct device *d = XDEVICE (XCAR (devcons));
 	  /* Initially set the value to t in case of error
 if (max_args < 1)
 	{
 	  invalid_argument
 	    ("Charset predicate must be able to take an argument", tag);
 	}
 /* If there exists a charset_predicate for the tag currently (even if
 	 the new charset_predicate is nil), or if we're adding one, we need
 	 to recompute.  This contrasts with the device predicates, where we
 	 don't need to recompute if the old and new device predicates are
 	 both nil.  */
 	    XCDR (assoc) = !NILP (call1 (device_predicate, device)) ? Qt
 	      : Qnil;
 	}
 }
 if (recompute_charsets)
 {
 if (NILP(charset_predicate))
 	{
 	  charpres = Qnil;
 	}
 	  assoc = assq_no_quit (tag,
 				XVECTOR_DATA(Vcharset_tag_lists)[i]);
 	  if (!NILP(charset_predicate))
 	    {
 	      struct gcpro gcpro1;
 	      charpres = make_vector(impossible, Qnil);
 	      GCPRO1 (charpres);
 	      /* If you want to extend the number of stages available, here
 		 in setup_charset_initial_specifier_tags, and in specifier.h
 		 is where you want to go. */
 	      assert(CONSP(assoc));
 	      XCDR (assoc) = charpres;
 	    }
 	  else
 	    {
 	      XVECTOR_DATA(Vcharset_tag_lists)[i]
 		= Fcons(Fcons(tag, charpres),
 			XVECTOR_DATA (Vcharset_tag_lists)[i]);
 	    }
 	}
 }
 return Qt;
 GET_LIST_LENGTH(XCAR(rest), list_len);
 assert(3 == list_len);
 device_predicate = XCADR(XCAR (rest));
 if (NILP (device_predicate))
 	{
 	  XCDR (XCAR (rest2)) = Qt;
 	}
 else
 	{
 	  device_predicate = !NILP (call_critical_lisp_code
 				    (d, device_predicate, device))
 	    ? Qt : Qnil;
 	  XCDR (XCAR (rest2)) = device_predicate;
 	}
 }
 }
 void
 setup_charset_initial_specifier_tags (Lisp_Object charset)
 {
 Lisp_Object rest, charset_predicate, tag, new_value;
 Lisp_Object charset_tag_list = Qnil;
 LIST_LOOP (rest, Vuser_defined_tags)
 {
 tag = XCAR(XCAR(rest));
 charset_predicate = XCADDR(XCAR (rest));
 	    XVECTOR_DATA(new_value)[stage] = Qt;			\
 	  }								\
 									\
 } while (0)
 SETUP_CHARSET_TAGS_FROB (initial);
 SETUP_CHARSET_TAGS_FROB (final);
 /* More later?  */
 #undef SETUP_CHARSET_TAGS_FROB
 ((LOCALE (TAG-SET . INSTANTIATOR) ...) ...)
 where
 LOCALE := a window, a buffer, a frame, a device, or `global'
 TAG-SET := an unordered list of zero or more TAGS, each of which
-is a symbol
+	     is a symbol
 TAG := a device class (see `valid-device-class-p'), a device type
-(see `valid-console-type-p'), or a tag defined with
+	 (see `valid-console-type-p'), or a tag defined with
-`define-specifier-tag'
+	 `define-specifier-tag'
 INSTANTIATOR := format determined by the type of specifier
 The pair (TAG-SET . INSTANTIATOR) is called an `inst-pair'.
 A list of inst-pairs is called an `inst-list'.
 The pair (LOCALE . INST-LIST) is called a `specification' or `spec'.
 				   Lisp_Object matchspec,
 				   Lisp_Object domain,
 				   Lisp_Object inst_list,
 				   Error_Behavior errb, int no_quit,
 				   Lisp_Object depth,
-				   Lisp_Object *instantiator)
+				   Lisp_Object *instantiator,
+				   int no_fallback)
 {
 /* This function can GC */
 Lisp_Specifier *sp;
 Lisp_Object device, charset = Qnil, rest;
 int count = specpdl_depth (), respected_charsets = 0;
 Lisp_Object tag_set = XCAR (tagged_inst);
 Lisp_Object val, the_instantiator;
 if (!device_matches_specifier_tag_set_p (device, tag_set))
 	{
 	  continue;
 	}
 val = XCDR (tagged_inst);
 the_instantiator = val;
 if (HAS_SPECMETH_P (sp, instantiate))
 	val = call_with_suspended_errors
 	  ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
 	   Qunbound, Qspecifier, errb, 5, specifier,
-	   matchspec, domain, val, depth);
+	   matchspec, domain, val, depth, no_fallback);
 if (!UNBOUNDP (val))
 	{
 	  unbind_to (count);
 	  UNGCPRO;
 Lisp_Object tag_set = XCAR (tagged_inst);
 Lisp_Object val, the_instantiator;
 if (!device_matches_specifier_tag_set_p (device, tag_set))
 	{
 	  continue;
 	}
 val = XCDR (tagged_inst);
 the_instantiator = val;
 if (HAS_SPECMETH_P (sp, instantiate))
 	val = call_with_suspended_errors
 	  ((lisp_fn_t) RAW_SPECMETH (sp, instantiate),
 	   Qunbound, Qspecifier, errb, 5, specifier,
-	   matchspec, domain, val, depth);
+	   matchspec, domain, val, depth, no_fallback);
 if (!UNBOUNDP (val))
 	{
 	  unbind_to (count);
 	  UNGCPRO;
 {									\
 	Lisp_Object CIE_val =						\
 	  specifier_instance_from_inst_list (specifier, matchspec,	\
 					     domain, *CIE_inst_list,	\
 					     errb, no_quit, depth,	\
-					     instantiator);		\
+					     instantiator, no_fallback); \
 	if (!UNBOUNDP (CIE_val))					\
 	  return CIE_val;						\
 }									\
 } while (0)
 }
 assert (CONSP (sp->fallback));
 return specifier_instance_from_inst_list (specifier, matchspec, domain,
 					    sp->fallback, errb, no_quit,
-					    depth, instantiator);
+					    depth, instantiator,
+					    no_fallback);
 }
 #undef CHECK_INSTANCE_ENTRY
 Lisp_Object
 specifier_instance (Lisp_Object specifier, Lisp_Object matchspec,
 e.g., a buffer-local display table that only gives values for particular
 characters.  All other characters are handled as if the buffer-local
 display table is not there. (Chartable specifiers are not yet
 implemented.)
 -- For font specifiers, MATCHSPEC should be a cons (CHARSET . STAGE).
 The defined stages are currently `initial' and `final'.  On X11, 'initial
 is used when the font matching process is looking for fonts that match
 the desired registries of the charset--see the `charset-registries'
 function.  If that match process fails, then the 'final stage comes into
 play; this means that a more general lookup is desired, and that a font
 GCPRO1 (built_up_list);
 built_up_list = build_up_processed_list (specifier, domain, inst_list);
 if (!NILP (built_up_list))
 val = specifier_instance_from_inst_list (specifier, matchspec, domain,
 					     built_up_list, ERROR_ME,
-					     0, Qzero, &instantiator);
+					     0, Qzero, &instantiator, 0);
 UNGCPRO;
 return UNBOUNDP (val) ? default_ : want_instantiator ? instantiator : val;
 }
 return specifier_matching_foo_from_inst_list (specifier, Qunbound,
 						domain, inst_list, default_,
 						0);
 }
 DEFUN ("specifier-instantiator-from-inst-list",
 Fspecifier_instantiator_from_inst_list, 3, 4, 0, /*
 Attempt to convert an inst-list into an instance; return instantiator.
 This is identical to `specifier-instance-from-inst-list' but returns
 the instantiator used to generate the instance, rather than the instance
 itself.
 Vunlock_ghost_specifiers = Qnil;
 staticpro (&Vunlock_ghost_specifiers);
 Vcharset_tag_lists = make_vector(NUM_LEADING_BYTES, Qnil);
 staticpro (&Vcharset_tag_lists);
 }

Mercurial > hg > xemacs-beta

comparison src/specifier.c @ 4426:515b91f904c1