#include <config.h>
#include <ctype.h>
#include "lisp.h"
#include "buffer.h"
#include "charset.h"
#include "category.h"
#include "keymap.h"
static int category_table_version;
Lisp_Object Qcategory_table, Qcategoryp, Qcategorysetp, Qcategory_table_p;
Lisp_Object Vword_combining_categories, Vword_separating_categories;
Lisp_Object _temp_category_set;
DEFUN ("make-category-set", Fmake_category_set, Smake_category_set, 1, 1, 0,
doc: )
(categories)
Lisp_Object categories;
{
Lisp_Object val;
int len;
CHECK_STRING (categories);
val = MAKE_CATEGORY_SET;
if (STRING_MULTIBYTE (categories))
error ("Multibyte string in `make-category-set'");
len = SCHARS (categories);
while (--len >= 0)
{
Lisp_Object category;
XSETFASTINT (category, SREF (categories, len));
CHECK_CATEGORY (category);
SET_CATEGORY_SET (val, category, Qt);
}
return val;
}
Lisp_Object check_category_table ();
DEFUN ("define-category", Fdefine_category, Sdefine_category, 2, 3, 0,
doc: )
(category, docstring, table)
Lisp_Object category, docstring, table;
{
CHECK_CATEGORY (category);
CHECK_STRING (docstring);
table = check_category_table (table);
if (!NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
error ("Category `%c' is already defined", XFASTINT (category));
CATEGORY_DOCSTRING (table, XFASTINT (category)) = docstring;
return Qnil;
}
DEFUN ("category-docstring", Fcategory_docstring, Scategory_docstring, 1, 2, 0,
doc: )
(category, table)
Lisp_Object category, table;
{
CHECK_CATEGORY (category);
table = check_category_table (table);
return CATEGORY_DOCSTRING (table, XFASTINT (category));
}
DEFUN ("get-unused-category", Fget_unused_category, Sget_unused_category,
0, 1, 0,
doc: )
(table)
Lisp_Object table;
{
int i;
table = check_category_table (table);
for (i = ' '; i <= '~'; i++)
if (NILP (CATEGORY_DOCSTRING (table, i)))
return make_number (i);
return Qnil;
}
DEFUN ("category-table-p", Fcategory_table_p, Scategory_table_p, 1, 1, 0,
doc: )
(arg)
Lisp_Object arg;
{
if (CHAR_TABLE_P (arg)
&& EQ (XCHAR_TABLE (arg)->purpose, Qcategory_table))
return Qt;
return Qnil;
}
Lisp_Object
check_category_table (table)
Lisp_Object table;
{
if (NILP (table))
return current_buffer->category_table;
CHECK_TYPE (!NILP (Fcategory_table_p (table)), Qcategory_table_p, table);
return table;
}
DEFUN ("category-table", Fcategory_table, Scategory_table, 0, 0, 0,
doc: )
()
{
return current_buffer->category_table;
}
DEFUN ("standard-category-table", Fstandard_category_table,
Sstandard_category_table, 0, 0, 0,
doc: )
()
{
return Vstandard_category_table;
}
Lisp_Object
copy_category_table (table)
Lisp_Object table;
{
Lisp_Object tmp;
int i, to;
if (!NILP (XCHAR_TABLE (table)->top))
{
table = Fcopy_sequence (table);
for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
if (!NILP (tmp = XCHAR_TABLE (table)->contents[i]))
XCHAR_TABLE (table)->contents[i] = Fcopy_sequence (tmp);
to = CHAR_TABLE_ORDINARY_SLOTS;
Fset_char_table_extra_slot
(table, make_number (0),
Fcopy_sequence (Fchar_table_extra_slot (table, make_number (0))));
}
else
{
i = 32;
to = SUB_CHAR_TABLE_ORDINARY_SLOTS;
}
if (!NILP (tmp = XCHAR_TABLE (table)->defalt))
XCHAR_TABLE (table)->defalt = Fcopy_sequence (tmp);
for (; i < to; i++)
if (!NILP (tmp = XCHAR_TABLE (table)->contents[i]))
XCHAR_TABLE (table)->contents[i]
= (SUB_CHAR_TABLE_P (tmp)
? copy_category_table (tmp) : Fcopy_sequence (tmp));
return table;
}
DEFUN ("copy-category-table", Fcopy_category_table, Scopy_category_table,
0, 1, 0,
doc: )
(table)
Lisp_Object table;
{
if (!NILP (table))
check_category_table (table);
else
table = Vstandard_category_table;
return copy_category_table (table);
}
DEFUN ("make-category-table", Fmake_category_table, Smake_category_table,
0, 0, 0,
doc: )
()
{
Lisp_Object val;
val = Fmake_char_table (Qcategory_table, Qnil);
XCHAR_TABLE (val)->defalt = MAKE_CATEGORY_SET;
Fset_char_table_extra_slot (val, make_number (0),
Fmake_vector (make_number (95), Qnil));
return val;
}
DEFUN ("set-category-table", Fset_category_table, Sset_category_table, 1, 1, 0,
doc: )
(table)
Lisp_Object table;
{
int idx;
table = check_category_table (table);
current_buffer->category_table = table;
idx = PER_BUFFER_VAR_IDX (category_table);
SET_PER_BUFFER_VALUE_P (current_buffer, idx, 1);
return table;
}
DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,
doc: )
(ch)
Lisp_Object ch;
{
CHECK_NUMBER (ch);
return CATEGORY_SET (XFASTINT (ch));
}
DEFUN ("category-set-mnemonics", Fcategory_set_mnemonics,
Scategory_set_mnemonics, 1, 1, 0,
doc: )
(category_set)
Lisp_Object category_set;
{
int i, j;
char str[96];
CHECK_CATEGORY_SET (category_set);
j = 0;
for (i = 32; i < 127; i++)
if (CATEGORY_MEMBER (i, category_set))
str[j++] = i;
str[j] = '\0';
return build_string (str);
}
void
modify_lower_category_set (table, category, set_value)
Lisp_Object table, category, set_value;
{
Lisp_Object val;
int i;
val = XCHAR_TABLE (table)->defalt;
if (!CATEGORY_SET_P (val))
val = MAKE_CATEGORY_SET;
SET_CATEGORY_SET (val, category, set_value);
XCHAR_TABLE (table)->defalt = val;
for (i = 32; i < SUB_CHAR_TABLE_ORDINARY_SLOTS; i++)
{
val = XCHAR_TABLE (table)->contents[i];
if (CATEGORY_SET_P (val))
SET_CATEGORY_SET (val, category, set_value);
else if (SUB_CHAR_TABLE_P (val))
modify_lower_category_set (val, category, set_value);
}
}
void
set_category_set (category_set, category, val)
Lisp_Object category_set, category, val;
{
do {
int idx = XINT (category) / 8;
unsigned char bits = 1 << (XINT (category) % 8);
if (NILP (val))
XCATEGORY_SET (category_set)->data[idx] &= ~bits;
else
XCATEGORY_SET (category_set)->data[idx] |= bits;
} while (0);
}
DEFUN ("modify-category-entry", Fmodify_category_entry,
Smodify_category_entry, 2, 4, 0,
doc: )
(character, category, table, reset)
Lisp_Object character, category, table, reset;
{
int c, charset, c1, c2;
Lisp_Object set_value;
Lisp_Object val, category_set;
CHECK_NUMBER (character);
c = XINT (character);
CHECK_CATEGORY (category);
table = check_category_table (table);
if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
error ("Undefined category: %c", XFASTINT (category));
set_value = NILP (reset) ? Qt : Qnil;
if (c < CHAR_TABLE_SINGLE_BYTE_SLOTS)
{
val = XCHAR_TABLE (table)->contents[c];
if (!CATEGORY_SET_P (val))
XCHAR_TABLE (table)->contents[c] = (val = MAKE_CATEGORY_SET);
SET_CATEGORY_SET (val, category, set_value);
return Qnil;
}
SPLIT_CHAR (c, charset, c1, c2);
val = XCHAR_TABLE (table)->contents[charset + 128];
if (CATEGORY_SET_P (val))
category_set = val;
else if (!SUB_CHAR_TABLE_P (val))
{
category_set = val = MAKE_CATEGORY_SET;
XCHAR_TABLE (table)->contents[charset + 128] = category_set;
}
if (c1 <= 0)
{
if (SUB_CHAR_TABLE_P (val))
modify_lower_category_set (val, category, set_value);
else
SET_CATEGORY_SET (category_set, category, set_value);
return Qnil;
}
if (!SUB_CHAR_TABLE_P (val))
{
val = make_sub_char_table (Qnil);
XCHAR_TABLE (table)->contents[charset + 128] = val;
XCHAR_TABLE (val)->defalt = category_set;
}
table = val;
val = XCHAR_TABLE (table)->contents[c1];
if (CATEGORY_SET_P (val))
category_set = val;
else if (!SUB_CHAR_TABLE_P (val))
{
category_set = val = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
XCHAR_TABLE (table)->contents[c1] = category_set;
}
if (c2 <= 0)
{
if (SUB_CHAR_TABLE_P (val))
modify_lower_category_set (val, category, set_value);
else
SET_CATEGORY_SET (category_set, category, set_value);
return Qnil;
}
if (!SUB_CHAR_TABLE_P (val))
{
val = make_sub_char_table (Qnil);
XCHAR_TABLE (table)->contents[c1] = val;
XCHAR_TABLE (val)->defalt = category_set;
}
table = val;
val = XCHAR_TABLE (table)->contents[c2];
if (CATEGORY_SET_P (val))
category_set = val;
else if (!SUB_CHAR_TABLE_P (val))
{
category_set = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
XCHAR_TABLE (table)->contents[c2] = category_set;
}
else
error ("Invalid category table");
SET_CATEGORY_SET (category_set, category, set_value);
return Qnil;
}
int
word_boundary_p (c1, c2)
int c1, c2;
{
Lisp_Object category_set1, category_set2;
Lisp_Object tail;
int default_result;
if (CHAR_CHARSET (c1) == CHAR_CHARSET (c2))
{
tail = Vword_separating_categories;
default_result = 0;
}
else
{
tail = Vword_combining_categories;
default_result = 1;
}
category_set1 = CATEGORY_SET (c1);
if (NILP (category_set1))
return default_result;
category_set2 = CATEGORY_SET (c2);
if (NILP (category_set2))
return default_result;
for (; CONSP (tail); tail = XCDR (tail))
{
Lisp_Object elt = XCAR (tail);
if (CONSP (elt)
&& CATEGORYP (XCAR (elt))
&& CATEGORYP (XCDR (elt))
&& CATEGORY_MEMBER (XFASTINT (XCAR (elt)), category_set1)
&& CATEGORY_MEMBER (XFASTINT (XCDR (elt)), category_set2))
return !default_result;
}
return default_result;
}
void
init_category_once ()
{
Qcategory_table = intern ("category-table");
staticpro (&Qcategory_table);
Qchar_table_extra_slots = intern ("char-table-extra-slots");
Fput (Qcategory_table, Qchar_table_extra_slots, make_number (2));
Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil);
XCHAR_TABLE (Vstandard_category_table)->defalt = MAKE_CATEGORY_SET;
Fset_char_table_extra_slot (Vstandard_category_table, make_number (0),
Fmake_vector (make_number (95), Qnil));
}
void
syms_of_category ()
{
Qcategoryp = intern ("categoryp");
staticpro (&Qcategoryp);
Qcategorysetp = intern ("categorysetp");
staticpro (&Qcategorysetp);
Qcategory_table_p = intern ("category-table-p");
staticpro (&Qcategory_table_p);
DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories,
doc: );
Vword_combining_categories = Qnil;
DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories,
doc: );
Vword_separating_categories = Qnil;
defsubr (&Smake_category_set);
defsubr (&Sdefine_category);
defsubr (&Scategory_docstring);
defsubr (&Sget_unused_category);
defsubr (&Scategory_table_p);
defsubr (&Scategory_table);
defsubr (&Sstandard_category_table);
defsubr (&Scopy_category_table);
defsubr (&Smake_category_table);
defsubr (&Sset_category_table);
defsubr (&Schar_category_set);
defsubr (&Scategory_set_mnemonics);
defsubr (&Smodify_category_entry);
category_table_version = 0;
}