xemacs-beta: src/chartab.c comparison

comparison 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

comparison

equal deleted inserted replaced

-:30eda07fe280
+:cf808b4c4290
 /* Authorship:
 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>
 #include "lisp.h"
 return val;
 }
 #endif /* MULE */
-DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
+static Lisp_Object
-Find value for char CH in TABLE.
+get_char_table (Emchar ch, struct Lisp_Char_Table *ct)
-*/
+{
-(ch, table))
-{
-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];
 else if (EQ (charset, Vcharset_control_1))
 val = ct->ascii[byte1 + 128];
 }
 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).
 				     XCHARSET_LEADING_BYTE (range->charset),
 				     fn, arg);
 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;
 	    rainj.type = CHARTAB_RANGE_ROW;
 UNGCPRO;
 return slarg.retval;
 }
 /************************************************************************/
 /*                         Char table read syntax                       */
 /************************************************************************/
 There are 95 different categories available, one for each printable
 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
 category.  More specifically, a category table maps from a character
 to either the value nil (meaning the character is in no categories)
 obj = def;
 while (NILP (Fcategory_table_p (obj)))
 obj = wrong_type_argument (Qcategory_table_p, obj);
 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
 is non-nil.
 DEFSUBR (Fcategory_table_p);
 DEFSUBR (Fcategory_table);
 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 */
 /* DO NOT staticpro this.  It works just like Vweak_hash_tables. */

Mercurial > hg > xemacs-beta

comparison src/chartab.c @ 104:cf808b4c4290 r20-1b4