xemacs-beta: src/chartab.c comparison

comparison src/chartab.c @ 183:e121b013d1f0 r20-3b18

Import from CVS: tag r20-3b18

author	cvs
date	Mon, 13 Aug 2007 09:54:23 +0200
parents	bfd6434d15b3
children	3d6bfa290dbd

comparison

equal deleted inserted replaced

-:f07455f06202
+:e121b013d1f0
 Lisp_Object Qcategory_table_p;
 Lisp_Object Qcategory_designator_p;
 Lisp_Object Qcategory_table_value_p;
 Lisp_Object Vstandard_category_table;
-#endif
+#endif /* MULE */
 /* A char table maps from ranges of characters to values.
 Implementing a general data structure that maps from arbitrary
 ranges of numbers to values is tricky to do efficiently.  As it
-happens, it should suffice fine (and is usually more convenient,
+happens, it should suffice (and is usually more convenient, anyway)
-anyway) when dealing with characters to restrict the sorts of
+when dealing with characters to restrict the sorts of ranges that
-ranges that can be assigned values, as follows:
+can be assigned values, as follows:
 1) All characters.
 2) All characters in a charset.
 3) All characters in a particular row of a charset, where a "row"
 means all characters with the same first byte.
 4) A particular character in a charset.
 We use char tables to generalize the 256-element vectors now
 littering the Emacs code.
 Possible uses (all should be converted at some point):
 abstract type to generalize the Emacs vectors and Mule
 vectors-of-vectors goo.
 */
 /************************************************************************/
-/*                            Char Table object                         */
+/*                         Char Table object                            */
 /************************************************************************/
 #ifdef MULE
 static Lisp_Object mark_char_table_entry (Lisp_Object, void (*) (Lisp_Object));
 case CHAR_TABLE_TYPE_CHAR:     return Qchar;
 #ifdef MULE
 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
 #endif
 }
 abort ();
 return Qnil; /* not reached */
 }
 static enum char_table_type
 symbol_to_char_table_type (Lisp_Object symbol)
 {
 CHECK_SYMBOL (symbol);
 if (EQ (symbol, Qgeneric))  return CHAR_TABLE_TYPE_GENERIC;
 if (EQ (symbol, Qsyntax))   return CHAR_TABLE_TYPE_SYNTAX;
 if (EQ (symbol, Qdisplay))  return CHAR_TABLE_TYPE_DISPLAY;
 if (EQ (symbol, Qchar))     return CHAR_TABLE_TYPE_CHAR;
 #ifdef MULE
 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
 #endif
 signal_simple_error ("Unrecognized char table type", symbol);
 return CHAR_TABLE_TYPE_GENERIC; /* not reached */
 }
 static void
 				 cat, printcharfun);
 	  first = -1;
 	  i--;
 	}
 }
 if (first != -1)
 {
 if (row == -1)
 	print_chartab_range (MAKE_CHAR (charset, first, 0),
 			     MAKE_CHAR (charset, i - 1, 0),
 static void
 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
 {
 struct Lisp_Char_Table *ct = XCHAR_TABLE (obj);
 char buf[200];
 sprintf (buf, "#s(char-table type %s data (",
 	   string_data (symbol_name (XSYMBOL
 				     (char_table_type_to_symbol (ct->type)))));
 write_c_string (buf, printcharfun);
 case CHAR_TABLE_TYPE_GENERIC:
 #ifdef MULE
 case CHAR_TABLE_TYPE_CATEGORY:
 fill_char_table (ct, Qnil);
 break;
-#endif
+#endif /* MULE */
 case CHAR_TABLE_TYPE_SYNTAX:
 fill_char_table (ct, make_int (Sinherit));
 break;
 }
 #endif /* MULE */
 static Lisp_Object
 get_char_table (Emchar ch, struct Lisp_Char_Table *ct)
 {
 #ifdef MULE
 {
 Lisp_Object charset;
 int byte1, byte2;
 Lisp_Object val;
 BREAKUP_CHAR (ch, charset, byte1, byte2);
 if (EQ (charset, Vcharset_ascii))
 val = ct->ascii[byte1];
 else if (EQ (charset, Vcharset_control_1))
 val = ct->ascii[byte1 + 128];
 else
 Find value for char CH in TABLE.
 */
 (ch, table))
 {
 struct Lisp_Char_Table *ct;
-Emchar chr;
 CHECK_CHAR_TABLE (table);
 ct = XCHAR_TABLE (table);
 CHECK_CHAR_COERCE_INT (ch);
-chr = XCHAR(ch);
+return get_char_table (XCHAR (ch), ct);
-return get_char_table (chr, ct);
 }
 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
 Find value for a range in TABLE.
 If there is more than one value, return MULTI (defaults to nil).
 {
 case CHARTAB_RANGE_ALL:
 {
 	int i;
 	Lisp_Object first = ct->ascii[0];
 	for (i = 1; i < NUM_ASCII_CHARS; i++)
 	  if (!EQ (first, ct->ascii[i]))
 	    return multi;
 #ifdef MULE
 	for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
 	     i++)
 	  {
 	    if (!CHARSETP (CHARSET_BY_LEADING_BYTE (i))
 case CHARTAB_RANGE_CHARSET:
 if (EQ (rainj.charset, Vcharset_ascii))
 	{
 	  int i;
 	  Lisp_Object first = ct->ascii[0];
 	  for (i = 1; i < 128; i++)
 	    if (!EQ (first, ct->ascii[i]))
 	      return multi;
 	  return first;
 	}
 if (EQ (rainj.charset, Vcharset_control_1))
 	{
 	  int i;
 	  Lisp_Object first = ct->ascii[128];
 	  for (i = 129; i < 160; i++)
 	    if (!EQ (first, ct->ascii[i]))
 	      return multi;
 	  return first;
 	}
 {
 	Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (rainj.charset) -
 				     MIN_LEADING_BYTE];
 	if (CHAR_TABLE_ENTRYP (val))
 	  return multi;
 case CHAR_TABLE_TYPE_CATEGORY:
 if (!ERRB_EQ (errb, ERROR_ME))
 	return CATEGORY_TABLE_VALUEP (value);
 CHECK_CATEGORY_TABLE_VALUE (value);
 break;
-#endif
+#endif /* MULE */
 case CHAR_TABLE_TYPE_GENERIC:
 return 1;
 case CHAR_TABLE_TYPE_DISPLAY:
 case CHARTAB_RANGE_CHAR:
 #ifdef MULE
 {
 	Lisp_Object charset;
 	int byte1, byte2;
 	BREAKUP_CHAR (range->ch, charset, byte1, byte2);
 	if (EQ (charset, Vcharset_ascii))
 	  ct->ascii[byte1] = val;
 	else if (EQ (charset, Vcharset_control_1))
 	  ct->ascii[byte1 + 128] = val;
 map_over_charset_ascii (struct Lisp_Char_Table *ct,
 			int (*fn) (struct chartab_range *range,
 				   Lisp_Object val, void *arg),
 			void *arg)
 {
-int i;
+struct chartab_range rainj;
+int i, retval;
-#ifdef MULE
+int start = 0;
-for (i = 0; i < 128; i++)
+#ifdef MULE
+int stop = 128;
 #else
-for (i = 0; i < 256; i++)
+int stop = 256;
 #endif
-{
-Lisp_Object val = ct->ascii[i];
+rainj.type = CHARTAB_RANGE_CHAR;
-struct chartab_range rainj;
-int retval;
+for (i = start, retval = 0; i < stop && retval == 0; i++)
+{
-rainj.type = CHARTAB_RANGE_CHAR;
 rainj.ch = (Emchar) i;
-retval = (fn) (&rainj, val, arg);
+retval = (fn) (&rainj, ct->ascii[i], arg);
-if (retval)
+}
-	return retval;
-}
+return retval;
-return 0;
 }
 #ifdef MULE
 /* Map FN over the Control-1 chars in CT. */
 map_over_charset_control_1 (struct Lisp_Char_Table *ct,
 			    int (*fn) (struct chartab_range *range,
 				       Lisp_Object val, void *arg),
 			    void *arg)
 {
-int i;
+struct chartab_range rainj;
+int i, retval;
-for (i = 0; i < 32; i++)
+int start = 128;
-{
+int stop  = start + 32;
-Lisp_Object val = ct->ascii[i + 128];
-struct chartab_range rainj;
+rainj.type = CHARTAB_RANGE_CHAR;
-int retval;
+for (i = start, retval = 0; i < stop && retval == 0; i++)
-rainj.type = CHARTAB_RANGE_CHAR;
+{
-rainj.ch = (Emchar) (i + 128);
+rainj.ch = (Emchar) (i);
-retval = (fn) (&rainj, val, arg);
+retval = (fn) (&rainj, ct->ascii[i], arg);
-if (retval)
+}
-	return retval;
-}
+return retval;
-return 0;
 }
 /* Map FN over the row ROW of two-byte charset CHARSET.
 There must be a separate value for that row in the char table.
 CTE specifies the char table entry for CHARSET. */
 		      Lisp_Object charset, int row,
 		      int (*fn) (struct chartab_range *range,
 				 Lisp_Object val, void *arg),
 		      void *arg)
 {
-Lisp_Object val;
+Lisp_Object val = cte->level2[row - 32];
-val = cte->level2[row - 32];
 if (!CHAR_TABLE_ENTRYP (val))
 {
 struct chartab_range rainj;
 rainj.type = CHARTAB_RANGE_ROW;
 rainj.row = row;
 return (fn) (&rainj, val, arg);
 }
 else
 {
-int i;
+struct chartab_range rainj;
-int start, stop;
+int i, retval;
+int charset94_p = (XCHARSET_CHARS (charset) == 94);
+int start = charset94_p ?  33 :  32;
+int stop  = charset94_p ? 127 : 128;
 cte = XCHAR_TABLE_ENTRY (val);
-if (XCHARSET_CHARS (charset) == 94)
+rainj.type = CHARTAB_RANGE_CHAR;
+for (i = start, retval = 0; i < stop && retval == 0; i++)
 	{
-	  start = 33;
+	  rainj.ch = MAKE_CHAR (charset, row, i);
-	  stop = 127;
+	  retval = (fn) (&rainj, cte->level2[i - 32], arg);
 	}
-else
+return retval;
-	{
+}
-	  start = 32;
+}
-	  stop = 128;
-	}
-for (i = start; i < stop; i++)
-	{
-	  int retval;
-	  struct chartab_range rainj;
-	  rainj.type = CHARTAB_RANGE_CHAR;
-	  rainj.ch = MAKE_CHAR (charset, row, i);
-	  val = cte->level2[i - 32];
-	  retval = (fn) (&rainj, val, arg);
-	  if (retval)
-	    return retval;
-	}
-}
-return 0;
-}
 static int
 map_over_other_charset (struct Lisp_Char_Table *ct, int lb,
 			int (*fn) (struct chartab_range *range,
 				   Lisp_Object val, void *arg),
 			void *arg)
 {
 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
 Lisp_Object charset = CHARSET_BY_LEADING_BYTE (lb);
 if (!CHARSETP (charset)
 || lb == LEADING_BYTE_ASCII
 || lb == LEADING_BYTE_CONTROL_1)
 return 0;
 if (!CHAR_TABLE_ENTRYP (val))
 {
 struct chartab_range rainj;
 rainj.type = CHARTAB_RANGE_CHARSET;
 rainj.charset = charset;
 return (fn) (&rainj, val, arg);
 }
 {
 struct Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
 int charset94_p = (XCHARSET_CHARS (charset) == 94);
 int start = charset94_p ?  33 :  32;
 int stop  = charset94_p ? 127 : 128;
 int i, retval;
 if (XCHARSET_DIMENSION (charset) == 1)
-for (i = start; i < stop; i++)
+{
-	{
+	struct chartab_range rainj;
-	  struct chartab_range rainj;
+	rainj.type = CHARTAB_RANGE_CHAR;
-	  rainj.type = CHARTAB_RANGE_CHAR;
+	for (i = start, retval = 0; i < stop && retval == 0; i++)
-	  rainj.ch = MAKE_CHAR (charset, i, 0);
+	  {
-	  retval = (fn) (&rainj, cte->level2[i - 32], arg);
+	    rainj.ch = MAKE_CHAR (charset, i, 0);
-	  if (retval)
+	    retval = (fn) (&rainj, cte->level2[i - 32], arg);
-	    return retval;
+	  }
-	}
+}
 else
-for (i = start; i < stop; i++)
+{
-	{
+	for (i = start, retval = 0; i < stop && retval == 0; i++)
 	  retval = map_over_charset_row (cte, charset, i, fn, arg);
-	  if (retval)
+}
-	    return retval;
-	}
+return retval;
 }
-return 0;
 }
 #endif /* MULE */
 /* Map FN (with client data ARG) over range RANGE in char table CT.
 switch (range->type)
 {
 case CHARTAB_RANGE_ALL:
 {
 	int retval;
 	retval = map_over_charset_ascii (ct, fn, arg);
 	if (retval)
 	  return retval;
 #ifdef MULE
 	retval = map_over_charset_control_1 (ct, fn, arg);
 	if (retval)
 	  return retval;
 	{
 	  int i;
-	  for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
+	  int start = MIN_LEADING_BYTE;
-	       i++)
+	  int stop  = start + NUM_LEADING_BYTES;
+	  for (i = start, retval = 0; i < stop && retval == 0; i++)
 	    {
 	      retval = map_over_other_charset (ct, i, fn, arg);
-	      if (retval)
-		return retval;
 	    }
 	}
 #endif /* MULE */
+	return retval;
 }
-break;
 #ifdef MULE
 case CHARTAB_RANGE_CHARSET:
 return map_over_other_charset (ct,
 				     XCHARSET_LEADING_BYTE (range->charset),
 case CHARTAB_RANGE_ROW:
 ranjarg = vector2 (XCHARSET_NAME (range->charset),
 			 make_int (range->row));
 break;
-#endif
+#endif /* MULE */
 case CHARTAB_RANGE_CHAR:
 ranjarg = make_char (range->ch);
 break;
 default:
 abort ();
 }
 closure->retval = call2 (closure->function, ranjarg, val);
-return (!NILP (closure->retval));
+return !NILP (closure->retval);
 }
 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
 Map FUNCTION over entries in TABLE, calling it with two args,
 each key and value in the table.
 static int
 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
 		       Error_behavior errb)
 {
 /* #### should deal with ERRB */
-(void) symbol_to_char_table_type (value);
+symbol_to_char_table_type (value);
 return 1;
 }
 static int
 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
 data = dataval;
 while (!NILP (data))
 {
 Lisp_Object range = Fcar (data);
 Lisp_Object val = Fcar (Fcdr (data));
 data = Fcdr (Fcdr (data));
 if (CONSP (range))
 {
 	  if (CHAR_OR_CHAR_INTP (XCAR (range)))
 	    {
 Special Lisp functions are provided that abstract this, so you do not
 have to directly manipulate bit vectors.
 */
 (obj))
 {
-if (CHAR_TABLEP (obj) && XCHAR_TABLE_TYPE (obj) == CHAR_TABLE_TYPE_CATEGORY)
+return (CHAR_TABLEP (obj) &&
-return Qt;
+	  XCHAR_TABLE_TYPE (obj) == CHAR_TABLE_TYPE_CATEGORY) ?
-return Qnil;
+Qt : Qnil;
 }
 static Lisp_Object
 check_category_table (Lisp_Object obj, Lisp_Object def)
 {
 if (NILP (obj))
 obj = def;
 while (NILP (Fcategory_table_p (obj)))
 obj = wrong_type_argument (Qcategory_table_p, obj);
-return (obj);
+return obj;
 }
 int
-check_category_char(Emchar ch, Lisp_Object table,
+check_category_char (Emchar ch, Lisp_Object table,
-		    unsigned int designator, unsigned int not)
+		     unsigned int designator, unsigned int not)
 {
 register Lisp_Object temp;
 struct Lisp_Char_Table *ctbl;
 #ifdef ERROR_CHECK_TYPECHECK
 if (NILP (Fcategory_table_p (table)))
-signal_simple_error("Expected category table", table);
+signal_simple_error ("Expected category table", table);
 #endif
-ctbl = XCHAR_TABLE(table);
+ctbl = XCHAR_TABLE (table);
-temp = get_char_table(ch, ctbl);
+temp = get_char_table (ch, ctbl);
 if (EQ (temp, Qnil)) return not;
 designator -= ' ';
-return bit_vector_bit(XBIT_VECTOR (temp), designator) ? !not : not;
+return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not : not;
 }
 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
 Return t if category of a character at POS includes DESIGNATOR,
 else return nil. Optional third arg specifies which buffer
 (pos, designator, buffer, category_table))
 {
 Lisp_Object ctbl;
 Emchar ch;
 unsigned int des;
-struct buffer *buf = decode_buffer(buffer, 0);
+struct buffer *buf = decode_buffer (buffer, 0);
 CHECK_INT (pos);
 CHECK_CATEGORY_DESIGNATOR (designator);
-des = XREALINT(designator);
+des = XREALINT (designator);
 ctbl = check_category_table (category_table, Vstandard_category_table);
-ch = BUF_FETCH_CHAR (buf, XINT(pos));
+ch = BUF_FETCH_CHAR (buf, XINT (pos));
-return check_category_char(ch, ctbl, des, 0) ? Qt : Qnil;
+return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
 }
 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
-Return t if category of character CHR includes DESIGNATOR, else
+Return t if category of character CHR includes DESIGNATOR, else nil.
-return nil. Optional third arg specifies the CATEGORY-TABLE to use,
+Optional third arg specifies the CATEGORY-TABLE to use,
 which defaults to the system default table.
 */
 (chr, designator, category_table))
 {
 Lisp_Object ctbl;
 Emchar ch;
 unsigned int des;
 CHECK_CATEGORY_DESIGNATOR (designator);
-des = XREALINT(designator);
+des = XREALINT (designator);
-CHECK_CHAR(chr);
+CHECK_CHAR (chr);
-ch = XCHAR(chr);
+ch = XCHAR (chr);
 ctbl = check_category_table (category_table, Vstandard_category_table);
-return check_category_char(ch, ctbl, des, 0) ? Qt : Qnil;
+return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
 }
 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
 Return the current category table.
 This is the one specified by the current buffer, or by BUFFER if it

Mercurial > hg > xemacs-beta

comparison src/chartab.c @ 183:e121b013d1f0 r20-3b18