/* chartab.c -- char-table support
- Copyright (C) 2003
+ Copyright (C) 2003, 2004, 2005, 2006, 2007, 2008
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H13PRO009
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
#include "lisp.h"
size = VECSIZE (struct Lisp_Char_Table) - 1 + n_extras;
vector = Fmake_vector (make_number (size), init);
+ XSETPVECTYPE (XVECTOR (vector), PVEC_CHAR_TABLE);
XCHAR_TABLE (vector)->parent = Qnil;
XCHAR_TABLE (vector)->purpose = purpose;
XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
int size = VECSIZE (struct Lisp_Sub_Char_Table) - 1 + chartab_size[depth];
table = Fmake_vector (make_number (size), defalt);
+ XSETPVECTYPE (XVECTOR (table), PVEC_SUB_CHAR_TABLE);
XSUB_CHAR_TABLE (table)->depth = make_number (depth);
XSUB_CHAR_TABLE (table)->min_char = make_number (min_char);
- XSETSUB_CHAR_TABLE (table, XSUB_CHAR_TABLE (table));
return table;
}
int i;
copy = Fmake_vector (make_number (size), Qnil);
+ XSETPVECTYPE (XVECTOR (copy), PVEC_CHAR_TABLE);
XCHAR_TABLE (copy)->defalt = XCHAR_TABLE (table)->defalt;
XCHAR_TABLE (copy)->parent = XCHAR_TABLE (table)->parent;
XCHAR_TABLE (copy)->purpose = XCHAR_TABLE (table)->purpose;
- XCHAR_TABLE (copy)->ascii = XCHAR_TABLE (table)->ascii;
for (i = 0; i < chartab_size[0]; i++)
XCHAR_TABLE (copy)->contents[i]
= (SUB_CHAR_TABLE_P (XCHAR_TABLE (table)->contents[i])
? copy_sub_char_table (XCHAR_TABLE (table)->contents[i])
: XCHAR_TABLE (table)->contents[i]);
- if (SUB_CHAR_TABLE_P (XCHAR_TABLE (copy)->ascii))
- XCHAR_TABLE (copy)->ascii = char_table_ascii (copy);
+ XCHAR_TABLE (copy)->ascii = char_table_ascii (copy);
size -= VECSIZE (struct Lisp_Char_Table) - 1;
for (i = 0; i < size; i++)
XCHAR_TABLE (copy)->extras[i] = XCHAR_TABLE (table)->extras[i];
{
int i;
- XCHAR_TABLE (char_table)->ascii = Qnil;
+ XCHAR_TABLE (char_table)->ascii = value;
for (i = 0; i < chartab_size[0]; i++)
- XCHAR_TABLE (char_table)->contents[i] = Qnil;
- XCHAR_TABLE (char_table)->defalt = value;
+ XCHAR_TABLE (char_table)->contents[i] = value;
}
else if (EQ (range, Qnil))
XCHAR_TABLE (char_table)->defalt = value;
}
static Lisp_Object
-optimize_sub_char_table (table)
- Lisp_Object table;
+optimize_sub_char_table (table, test)
+ Lisp_Object table, test;
{
struct Lisp_Sub_Char_Table *tbl = XSUB_CHAR_TABLE (table);
int depth = XINT (tbl->depth);
elt = XSUB_CHAR_TABLE (table)->contents[0];
if (SUB_CHAR_TABLE_P (elt))
- elt = XSUB_CHAR_TABLE (table)->contents[0] = optimize_sub_char_table (elt);
+ elt = XSUB_CHAR_TABLE (table)->contents[0]
+ = optimize_sub_char_table (elt, test);
if (SUB_CHAR_TABLE_P (elt))
return table;
for (i = 1; i < chartab_size[depth]; i++)
this = XSUB_CHAR_TABLE (table)->contents[i];
if (SUB_CHAR_TABLE_P (this))
this = XSUB_CHAR_TABLE (table)->contents[i]
- = optimize_sub_char_table (this);
+ = optimize_sub_char_table (this, test);
if (SUB_CHAR_TABLE_P (this)
- || NILP (Fequal (this, elt)))
+ || (NILP (test) ? NILP (Fequal (this, elt)) /* defaults to `equal'. */
+ : EQ (test, Qeq) ? !EQ (this, elt) /* Optimize `eq' case. */
+ : NILP (call2 (test, this, elt))))
break;
}
}
DEFUN ("optimize-char-table", Foptimize_char_table, Soptimize_char_table,
- 1, 1, 0,
- doc: /* Optimize CHAR-TABLE. */)
- (char_table)
- Lisp_Object char_table;
+ 1, 2, 0,
+ doc: /* Optimize CHAR-TABLE.
+TEST is the comparison function used to decide whether two entries are
+equivalent and can be merged. It defaults to `equal'. */)
+ (char_table, test)
+ Lisp_Object char_table, test;
{
Lisp_Object elt;
int i;
{
elt = XCHAR_TABLE (char_table)->contents[i];
if (SUB_CHAR_TABLE_P (elt))
- XCHAR_TABLE (char_table)->contents[i] = optimize_sub_char_table (elt);
+ XCHAR_TABLE (char_table)->contents[i]
+ = optimize_sub_char_table (elt, test);
}
return Qnil;
}
{
if (NILP (this))
this = default_val;
- if (NILP (Fequal (val, this)))
+ if (!EQ (val, this))
{
int different_value = 1;
parent, arg, val, range,
XCHAR_TABLE (parent)->defalt,
XCHAR_TABLE (parent)->parent);
- if (! NILP (Fequal (val, this)))
+ if (EQ (val, this))
different_value = 0;
}
}
if (! NILP (val) && different_value)
{
XSETCDR (range, make_number (c - 1));
- if (depth == 3
- && EQ (XCAR (range), XCDR (range)))
+ if (EQ (XCAR (range), XCDR (range)))
{
if (c_function)
(*c_function) (arg, XCAR (range), val);
Lisp_Object function, table, arg;
{
Lisp_Object range, val;
- int c, i;
struct gcpro gcpro1, gcpro2, gcpro3;
range = Fcons (make_number (0), make_number (MAX_CHAR));
if (! NILP (val))
{
- if (c_function)
- (*c_function) (arg, range, val);
+ if (EQ (XCAR (range), XCDR (range)))
+ {
+ if (c_function)
+ (*c_function) (arg, XCAR (range), val);
+ else
+ call2 (function, XCAR (range), val);
+ }
else
- call2 (function, range, val);
+ {
+ if (c_function)
+ (*c_function) (arg, range, val);
+ else
+ call2 (function, range, val);
+ }
}
UNGCPRO;
HCoop / bpt / emacs.git / blobdiff