Mercurial > hg > xemacs-beta
diff src/chartab.c @ 104:cf808b4c4290 r20-1b4
Import from CVS: tag r20-1b4
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:16:51 +0200 |
parents | 131b0175ea99 |
children | fe104dbd9147 |
line wrap: on
line diff
--- a/src/chartab.c Mon Aug 13 09:15:51 2007 +0200 +++ b/src/chartab.c Mon Aug 13 09:16:51 2007 +0200 @@ -29,6 +29,8 @@ Ben Wing: wrote, for 19.13 (Mule). Some category table stuff loosely based on the original Mule. + Jareth Hein: fixed a couple of bugs in the implementation, and + added regex support for categories with check_category_at */ #include <config.h> @@ -786,24 +788,16 @@ #endif /* MULE */ -DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* -Find value for char CH in TABLE. -*/ - (ch, table)) +static Lisp_Object +get_char_table (Emchar ch, struct Lisp_Char_Table *ct) { - struct Lisp_Char_Table *ct; - - CHECK_CHAR_TABLE (table); - ct = XCHAR_TABLE (table); - CHECK_CHAR_COERCE_INT (ch); - #ifdef MULE { Lisp_Object charset; int byte1, byte2; Lisp_Object val; - BREAKUP_CHAR (XCHAR (ch), charset, byte1, byte2); + BREAKUP_CHAR (ch, charset, byte1, byte2); if (EQ (charset, Vcharset_ascii)) val = ct->ascii[byte1]; @@ -830,10 +824,27 @@ return val; } #else /* not MULE */ - return ct->ascii[(unsigned char) XCHAR (ch)]; + return ct->ascii[(unsigned char)ch]; #endif /* not MULE */ } + +DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* +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 (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). @@ -1386,7 +1397,7 @@ case CHARTAB_RANGE_ROW: { - Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset)]; + Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE]; if (!CHAR_TABLE_ENTRYP (val)) { struct chartab_range rainj; @@ -1491,6 +1502,7 @@ return slarg.retval; } + /************************************************************************/ /* Char table read syntax */ @@ -1605,7 +1617,7 @@ character (including space) in the ASCII charset. Each category is designated by one such character, called a \"category designator\". They are specified in a regexp using the syntax \"\\cX\", where X is -a category designator. (This is not yet implemented.) +a category designator. A category table specifies, for each character, the categories that the character is in. Note that a character can be in more than one @@ -1634,6 +1646,46 @@ return (obj); } +int +check_category_at(Emchar ch, Lisp_Object table, + unsigned int designator, unsigned int not) +{ + register Lisp_Object temp; + struct Lisp_Char_Table *ctbl; +#if 1 /* ifdef ERROR_CHECK_TYPECHECK */ + if (NILP (Fcategory_table_p (table))) + signal_simple_error("Expected category table", table); +#endif + ctbl = XCHAR_TABLE(table); + temp = get_char_table(ch, ctbl); + if (EQ (temp, Qnil)) return not; + + designator -= ' '; + 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 DESIGNATIOR, +else return nil. Optional third arg specifies which buffer +(defaulting to current), and fourth specifies the CATEGORY-TABLE, +(defaulting to the buffer's category table). +*/ + (pos, designator, buffer, category_table)) +{ + Lisp_Object ctbl; + Emchar ch; + unsigned int des; + struct buffer *buf = decode_buffer(buffer, 0); + + CHECK_INT (pos); + CHECK_CATEGORY_DESIGNATOR (designator); + des = XREALINT(designator); + ctbl = check_category_table (category_table, Vstandard_category_table); + ch = BUF_FETCH_CHAR (buf, XINT(pos)); + return (check_category_at(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 @@ -1737,7 +1789,7 @@ DEFSUBR (Fstandard_category_table); DEFSUBR (Fcopy_category_table); DEFSUBR (Fset_category_table); - + DEFSUBR (Fcheck_category_at); DEFSUBR (Fcategory_designator_p); DEFSUBR (Fcategory_table_value_p); #endif /* MULE */