xemacs-beta: src/specifier.c comparison

comparison src/specifier.c @ 173:8eaf7971accc r20-3b13

Import from CVS: tag r20-3b13

author	cvs
date	Mon, 13 Aug 2007 09:49:09 +0200
parents	15872534500d
children	2d532a89d707

comparison

equal deleted inserted replaced

-:a38aed19690b
+:8eaf7971accc
 for (rest = Vall_specifiers;
 !NILP (rest);
 rest = XSPECIFIER (rest)->next_specifier)
 {
 struct Lisp_Specifier *sp = XSPECIFIER (rest);
 /* This effectively changes the specifier specs.
 	 However, there's no need to call
 	 recompute_cached_specifier_everywhere() or the
 	 after-change methods because the only specs we
 	 are removing are for dead objects, and they can
 if (EQ (locale_type, Qglobal)) return LOCALE_GLOBAL;
 if (EQ (locale_type, Qdevice)) return LOCALE_DEVICE;
 if (EQ (locale_type, Qframe))  return LOCALE_FRAME;
 if (EQ (locale_type, Qwindow)) return LOCALE_WINDOW;
 if (EQ (locale_type, Qbuffer)) return LOCALE_BUFFER;
 signal_simple_error ("Invalid specifier locale type", locale_type);
 return LOCALE_GLOBAL; /* not reached */
 }
 Lisp_Object
 tags = (Lisp_Object *) alloca (len * sizeof (Lisp_Object));
 i = 0;
 LIST_LOOP (rest, tag_set)
 tags[i++] = XCAR (rest);
 /* Sort the list of tags.  We use a bubble sort here (copied from
 extent_fragment_update()) -- reduces the function call overhead,
 and is the fastest sort for small numbers of items. */
 for (i = 1; i < len; i++)
 {
 Lisp_Object rest, rest2;
 Lisp_Object device = Qnil;
 XSETDEVICE (device, d);
 DEVICE_USER_DEFINED_TAGS (d) = Fcopy_alist (Vuser_defined_tags);
 /* Now set up the initial values */
 LIST_LOOP (rest, DEVICE_USER_DEFINED_TAGS (d))
 XCDR (XCAR (rest)) = Qt;
 (device))
 {
 struct device *d = decode_device (device);
 Lisp_Object rest, list = Qnil;
 struct gcpro gcpro1;
 GCPRO1 (list);
 LIST_LOOP (rest, DEVICE_USER_DEFINED_TAGS (d))
 {
 if (!NILP (XCDR (XCAR (rest))))
 if (valid_console_type_p (tag))
 return list3 (Qlambda, list1 (Qdevice),
 		  list3 (Qeq, list2 (Qquote, tag),
 			 list2 (Qconsole_type, Qdevice)));
 if (valid_device_class_p (tag))
 return list3 (Qlambda, list1 (Qdevice),
 		  list3 (Qeq, list2 (Qquote, tag),
 			 list2 (Qdevice_class, Qdevice)));
 	{
 	  if (EQ (XCAR (a), XCAR (b)))
 	    a = XCDR (a);
 	  b = XCDR (b);
 	}
 return NILP (a);
 }
 else
 {
 while (!NILP (a) && !NILP (b))
 	  GCPRO1 (opaque);
 	  retval = call_with_suspended_errors
 	    ((lisp_fn_t) call_validate_method,
 	     Qnil, Qspecifier, errb, 2, opaque, instantiator);
 	  free_opaque_ptr (opaque);
 	  UNGCPRO;
 	}
 return retval;
 : (type == LOCALE_WINDOW			\
 	  ? &(XWEAK_LIST_LIST (XSPECIFIER (specifier)->window_specs)) \
 	  : (type == LOCALE_BUFFER		\
 	     ? &(XSPECIFIER (specifier)->buffer_specs) \
 	     : 0)))))
 static Lisp_Object *
 specifier_get_inst_list (Lisp_Object specifier, Lisp_Object locale,
 			 enum spec_locale_type type)
 {
 Lisp_Object *spec_list = SPECIFIER_GET_SPEC_LIST (specifier, type);
 							 &was_removed);
 if (NILP (XCDR (assoc)))
 	/* no inst-pairs left; remove this locale entirely. */
 	*spec_list = remassq_no_quit (locale, *spec_list);
 }
 if (was_removed)
 MAYBE_SPECMETH (XSPECIFIER (specifier), after_change, (specifier, locale));
 }
 static void
 LIST_LOOP (rest, *spec_list)
 {
 int was_removed;
 int remove_spec = 0;
 Lisp_Object spec = XCAR (rest);
 /* There may be dead objects floating around */
 /* remember, dead windows can become alive again. */
 if (!WINDOWP (XCAR (spec)) && object_dead_p (XCAR (spec)))
 	{
 	  remove_spec = 1;
 {
 *orig_inst_list = nconc2 (*orig_inst_list, list_to_build_up);
 }
 else
 abort ();
 UNGCPRO;
 /* call the after-change method */
 MAYBE_SPECMETH (sp, after_change, (specifier, locale));
 }
 Lisp_Object rest;
 /* This algorithm is O(n^2) in running time.
 It's certainly possible to implement an O(n log n) algorithm,
 but I doubt there's any need to. */
 LIST_LOOP (rest, *src_list)
 {
 Lisp_Object spec = XCAR (rest);
 /* There may be dead objects floating around */
 /* remember, dead windows can become alive again. */
 	specifier_add_spec
 	  (dest, XCAR (spec),
 	   specifier_process_inst_list (XCDR (spec), tag_set, exact_p, 0, 0),
 	   add_meth);
 }
 }
 /* map MAPFUN over the locales in SPECIFIER that are given in LOCALE.
 CLOSURE is passed unchanged to MAPFUN.  LOCALE can be one of
 -- nil (same as 'all)
 Lisp_Object crock1 = specifier;
 Lisp_Object crock2 = XCAR (XCAR (rest));
 Lisp_Object crock3 = XCDR (XCAR (rest));
 specifier_add_spec (crock1, crock2, crock3, add_meth);
 }
 recompute_cached_specifier_everywhere (specifier);
 return Qnil;
 }
 struct specifier_spec_list_closure
 };
 static int
 copy_specifier_mapfun (Lisp_Object specifier,
 		       Lisp_Object locale,
 		       enum spec_locale_type locale_type,
 		       Lisp_Object tag_set,
 		       int exact_p,
 		       void *closure)
 {
 struct copy_specifier_closure *cl =
 	  GCPRO1 (opaque);
 	  retval = call_with_suspended_errors
 	    ((lisp_fn_t) call_validate_matchspec_method,
 	     Qnil, Qspecifier, errb, 2, opaque, matchspec);
 	  free_opaque_ptr (opaque);
 	  UNGCPRO;
 	}
 return retval;
 }
 /* This function is purposely not callable from Lisp.  If a Lisp
 caller wants to set a fallback, they should just set the
 global value. */
 void
 set_specifier_fallback (Lisp_Object specifier, Lisp_Object fallback)
 {
 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
 assert (SPECIFIERP (fallback) ||
 value will be a font-instance object.  For glyphs, the returned value
 will be a string, pixmap, or subwindow.
 See also `specifier-matching-instance'.
 */
-(specifier, domain, defalt, no_fallback))
+(specifier, domain, default_, no_fallback))
 {
 Lisp_Object instance;
 CHECK_SPECIFIER (specifier);
 domain = decode_domain (domain);
 instance = specifier_instance (specifier, Qunbound, domain, ERROR_ME, 0,
 				 !NILP (no_fallback), Qzero);
-if (UNBOUNDP (instance))
+return UNBOUNDP (instance) ? default_ : instance;
-return defalt;
-return instance;
 }
 DEFUN ("specifier-matching-instance", Fspecifier_matching_instance, 2, 5, 0, /*
 Return an instance for SPECIFIER in DOMAIN that matches MATCHSPEC.
 If no instance can be generated for this domain, return DEFAULT.
 (a font string) must have a registry that matches the charset's registry.
 (This only makes sense with Mule support.) This makes it easy to choose a
 font that can display a particular character. (This is what redisplay
 does, in fact.)
 */
-(specifier, matchspec, domain, defalt, no_fallback))
+(specifier, matchspec, domain, default_, no_fallback))
 {
 Lisp_Object instance;
 CHECK_SPECIFIER (specifier);
 check_valid_specifier_matchspec (matchspec, XSPECIFIER (specifier)->methods,
 				   ERROR_ME);
 domain = decode_domain (domain);
 instance = specifier_instance (specifier, matchspec, domain, ERROR_ME, 0,
 				 !NILP (no_fallback), Qzero);
-if (UNBOUNDP (instance))
+return UNBOUNDP (instance) ? default_ : instance;
-return defalt;
-return instance;
 }
 DEFUN ("specifier-instance-from-inst-list",
 Fspecifier_instance_from_inst_list, 3, 4, 0, /*
 Attempt to convert a particular inst-list into an instance.
 This attempts to instantiate INST-LIST in the given DOMAIN,
 as if INST-LIST existed in a specification in SPECIFIER.  If
 the instantiation fails, DEFAULT is returned.  In most circumstances,
 you should not use this function; use `specifier-instance' instead.
 */
-(specifier, domain, inst_list, defalt))
+(specifier, domain, inst_list, default_))
 {
 Lisp_Object val = Qunbound;
 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
 struct gcpro gcpro1;
 Lisp_Object built_up_list = Qnil;
 if (!NILP (built_up_list))
 val = specifier_instance_from_inst_list (specifier, Qunbound, domain,
 					     built_up_list, ERROR_ME, 0,
 					     Qzero);
 UNGCPRO;
-if (UNBOUNDP (val))
+return UNBOUNDP (val) ? default_ : val;
-return defalt;
-return val;
 }
 DEFUN ("specifier-matching-instance-from-inst-list",
 Fspecifier_matching_instance_from_inst_list, 4, 5, 0, /*
 Attempt to convert a particular inst-list into an instance.
 This function is analogous to `specifier-instance-from-inst-list'
 but allows for specification-matching as in `specifier-matching-instance'.
 See that function for a description of exactly how the matching process
 works.
 */
-(specifier, matchspec, domain, inst_list, defalt))
+(specifier, matchspec, domain, inst_list, default_))
 {
 Lisp_Object val = Qunbound;
 struct Lisp_Specifier *sp = XSPECIFIER (specifier);
 struct gcpro gcpro1;
 Lisp_Object built_up_list = Qnil;
 if (!NILP (built_up_list))
 val = specifier_instance_from_inst_list (specifier, matchspec, domain,
 					     built_up_list, ERROR_ME, 0,
 					     Qzero);
 UNGCPRO;
-if (UNBOUNDP (val))
+return UNBOUNDP (val) ? default_ : val;
-return defalt;
-return val;
 }
 /************************************************************************/
 /*                 Caching in the struct window or frame                */
 A generic specifier allows any kind of Lisp object as an instantiator,
 and returns back the Lisp object unchanged when it is instantiated.
 */
 (object))
 {
-return (GENERIC_SPECIFIERP (object) ? Qt : Qnil);
+return GENERIC_SPECIFIERP (object) ? Qt : Qnil;
 }
 /************************************************************************/
 /*                        Integer specifier type                        */
 DEFUN ("integer-specifier-p", Finteger_specifier_p, 1, 1, 0, /*
 Return non-nil if OBJECT is an integer specifier.
 */
 (object))
 {
-return (INTEGER_SPECIFIERP (object) ? Qt : Qnil);
+return INTEGER_SPECIFIERP (object) ? Qt : Qnil;
 }
 /************************************************************************/
 /*                   Non-negative-integer specifier type                */
 /************************************************************************/
 DEFUN ("natnum-specifier-p", Fnatnum_specifier_p, 1, 1, 0, /*
 Return non-nil if OBJECT is a natnum (non-negative-integer) specifier.
 */
 (object))
 {
-return (NATNUM_SPECIFIERP (object) ? Qt : Qnil);
+return NATNUM_SPECIFIERP (object) ? Qt : Qnil;
 }
 /************************************************************************/
 /*                        Boolean specifier type                        */
 /************************************************************************/
 DEFUN ("boolean-specifier-p", Fboolean_specifier_p, 1, 1, 0, /*
 Return non-nil if OBJECT is a boolean specifier.
 */
 (object))
 {
-return (BOOLEAN_SPECIFIERP (object) ? Qt : Qnil);
+return BOOLEAN_SPECIFIERP (object) ? Qt : Qnil;
 }
 /************************************************************************/
 /*                        Display table specifier type                  */
 /************************************************************************/
 static void
 display_table_validate (Lisp_Object instantiator)
 {
 if (!NILP(instantiator) &&
 (!VECTORP (instantiator) ||
-XVECTOR (instantiator)->size != DISP_TABLE_SIZE))
+XVECTOR_LENGTH (instantiator) != DISP_TABLE_SIZE))
 dead_wrong_type_argument (display_table_specifier_methods->predicate_symbol,
 			      instantiator);
 }
 DEFUN ("display-table-specifier-p", Fdisplay_table_specifier_p, 1, 1, 0, /*
 Return non-nil if OBJECT is an display-table specifier.
 */
 (object))
 {
-return (DISPLAYTABLE_SPECIFIERP (object) ? Qt : Qnil);
+return DISPLAYTABLE_SPECIFIERP (object) ? Qt : Qnil;
 }
 /************************************************************************/
 /*                           Initialization                             */

Mercurial > hg > xemacs-beta

comparison src/specifier.c @ 173:8eaf7971accc r20-3b13