1990-11-12 20:20:45 +00:00
|
|
|
|
/* GNU Emacs routines to deal with case tables.
|
1994-05-04 02:41:09 +00:00
|
|
|
|
Copyright (C) 1993, 1994 Free Software Foundation, Inc.
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
|
|
|
|
This file is part of GNU Emacs.
|
|
|
|
|
|
|
|
|
|
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
|
1995-06-15 20:42:24 +00:00
|
|
|
|
the Free Software Foundation; either version 2, or (at your option)
|
1990-11-12 20:20:45 +00:00
|
|
|
|
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
|
|
|
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
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
|
1996-01-15 09:18:04 +00:00
|
|
|
|
the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
|
|
|
|
|
Boston, MA 02111-1307, USA. */
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
2005-01-29 17:18:06 +00:00
|
|
|
|
/* Written by Howard Gayle. */
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1993-09-10 06:15:46 +00:00
|
|
|
|
#include <config.h>
|
1990-11-12 20:20:45 +00:00
|
|
|
|
#include "lisp.h"
|
|
|
|
|
#include "buffer.h"
|
1997-05-15 02:23:20 +00:00
|
|
|
|
#include "charset.h"
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1995-10-19 00:14:14 +00:00
|
|
|
|
Lisp_Object Qcase_table_p, Qcase_table;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
Lisp_Object Vascii_downcase_table, Vascii_upcase_table;
|
|
|
|
|
Lisp_Object Vascii_canon_table, Vascii_eqv_table;
|
|
|
|
|
|
1997-05-28 04:36:34 +00:00
|
|
|
|
/* Used as a temporary in DOWNCASE and other macros in lisp.h. No
|
|
|
|
|
need to mark it, since it is used only very temporarily. */
|
1997-07-04 20:44:52 +00:00
|
|
|
|
int case_temp1;
|
|
|
|
|
Lisp_Object case_temp2;
|
1997-05-28 04:36:34 +00:00
|
|
|
|
|
|
|
|
|
static void set_canon ();
|
|
|
|
|
static void set_identity ();
|
|
|
|
|
static void shuffle ();
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
|
|
|
|
DEFUN ("case-table-p", Fcase_table_p, Scase_table_p, 1, 1, 0,
|
2001-10-20 20:56:10 +00:00
|
|
|
|
doc: /* Return t iff OBJECT is a case table.
|
|
|
|
|
See `set-case-table' for more information on these data structures. */)
|
|
|
|
|
(object)
|
1996-01-09 00:30:49 +00:00
|
|
|
|
Lisp_Object object;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
{
|
1995-10-23 04:35:45 +00:00
|
|
|
|
Lisp_Object up, canon, eqv;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1996-01-09 00:30:49 +00:00
|
|
|
|
if (! CHAR_TABLE_P (object))
|
1995-10-19 00:14:14 +00:00
|
|
|
|
return Qnil;
|
1996-01-09 00:30:49 +00:00
|
|
|
|
if (! EQ (XCHAR_TABLE (object)->purpose, Qcase_table))
|
1995-10-19 00:14:14 +00:00
|
|
|
|
return Qnil;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1996-01-09 00:30:49 +00:00
|
|
|
|
up = XCHAR_TABLE (object)->extras[0];
|
|
|
|
|
canon = XCHAR_TABLE (object)->extras[1];
|
|
|
|
|
eqv = XCHAR_TABLE (object)->extras[2];
|
1995-10-19 00:14:14 +00:00
|
|
|
|
|
|
|
|
|
return ((NILP (up) || CHAR_TABLE_P (up))
|
1992-01-13 21:48:03 +00:00
|
|
|
|
&& ((NILP (canon) && NILP (eqv))
|
1995-10-19 00:14:14 +00:00
|
|
|
|
|| (CHAR_TABLE_P (canon)
|
|
|
|
|
&& (NILP (eqv) || CHAR_TABLE_P (eqv))))
|
1990-11-12 20:20:45 +00:00
|
|
|
|
? Qt : Qnil);
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
static Lisp_Object
|
|
|
|
|
check_case_table (obj)
|
|
|
|
|
Lisp_Object obj;
|
|
|
|
|
{
|
|
|
|
|
register Lisp_Object tem;
|
|
|
|
|
|
1992-01-13 21:48:03 +00:00
|
|
|
|
while (tem = Fcase_table_p (obj), NILP (tem))
|
1993-02-22 14:48:45 +00:00
|
|
|
|
obj = wrong_type_argument (Qcase_table_p, obj);
|
1990-11-12 20:20:45 +00:00
|
|
|
|
return (obj);
|
2003-02-04 14:56:31 +00:00
|
|
|
|
}
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
|
|
|
|
DEFUN ("current-case-table", Fcurrent_case_table, Scurrent_case_table, 0, 0, 0,
|
2001-10-20 20:56:10 +00:00
|
|
|
|
doc: /* Return the case table of the current buffer. */)
|
|
|
|
|
()
|
1990-11-12 20:20:45 +00:00
|
|
|
|
{
|
1995-10-19 00:14:14 +00:00
|
|
|
|
return current_buffer->downcase_table;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
}
|
|
|
|
|
|
1993-05-25 13:03:47 +00:00
|
|
|
|
DEFUN ("standard-case-table", Fstandard_case_table, Sstandard_case_table, 0, 0, 0,
|
2001-10-20 20:56:10 +00:00
|
|
|
|
doc: /* Return the standard case table.
|
|
|
|
|
This is the one used for new buffers. */)
|
|
|
|
|
()
|
1990-11-12 20:20:45 +00:00
|
|
|
|
{
|
1995-10-19 00:14:14 +00:00
|
|
|
|
return Vascii_downcase_table;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
}
|
|
|
|
|
|
1992-10-31 04:55:02 +00:00
|
|
|
|
static Lisp_Object set_case_table ();
|
|
|
|
|
|
1990-11-12 20:20:45 +00:00
|
|
|
|
DEFUN ("set-case-table", Fset_case_table, Sset_case_table, 1, 1, 0,
|
2001-10-20 20:56:10 +00:00
|
|
|
|
doc: /* Select a new case table for the current buffer.
|
|
|
|
|
A case table is a char-table which maps characters
|
|
|
|
|
to their lower-case equivalents. It also has three \"extra\" slots
|
|
|
|
|
which may be additional char-tables or nil.
|
|
|
|
|
These slots are called UPCASE, CANONICALIZE and EQUIVALENCES.
|
|
|
|
|
UPCASE maps each character to its upper-case equivalent;
|
|
|
|
|
if lower and upper case characters are in 1-1 correspondence,
|
|
|
|
|
you may use nil and the upcase table will be deduced from DOWNCASE.
|
|
|
|
|
CANONICALIZE maps each character to a canonical equivalent;
|
|
|
|
|
any two characters that are related by case-conversion have the same
|
|
|
|
|
canonical equivalent character; it may be nil, in which case it is
|
|
|
|
|
deduced from DOWNCASE and UPCASE.
|
|
|
|
|
EQUIVALENCES is a map that cyclicly permutes each equivalence class
|
|
|
|
|
(of characters with the same canonical equivalent); it may be nil,
|
|
|
|
|
in which case it is deduced from CANONICALIZE. */)
|
|
|
|
|
(table)
|
1990-11-12 20:20:45 +00:00
|
|
|
|
Lisp_Object table;
|
|
|
|
|
{
|
1992-10-31 04:55:02 +00:00
|
|
|
|
return set_case_table (table, 0);
|
1990-11-12 20:20:45 +00:00
|
|
|
|
}
|
|
|
|
|
|
1993-05-25 13:03:47 +00:00
|
|
|
|
DEFUN ("set-standard-case-table", Fset_standard_case_table, Sset_standard_case_table, 1, 1, 0,
|
2001-10-20 20:56:10 +00:00
|
|
|
|
doc: /* Select a new standard case table for new buffers.
|
|
|
|
|
See `set-case-table' for more info on case tables. */)
|
|
|
|
|
(table)
|
1990-11-12 20:20:45 +00:00
|
|
|
|
Lisp_Object table;
|
|
|
|
|
{
|
1992-10-31 04:55:02 +00:00
|
|
|
|
return set_case_table (table, 1);
|
1990-11-12 20:20:45 +00:00
|
|
|
|
}
|
|
|
|
|
|
1992-10-31 04:55:02 +00:00
|
|
|
|
static Lisp_Object
|
1990-11-12 20:20:45 +00:00
|
|
|
|
set_case_table (table, standard)
|
|
|
|
|
Lisp_Object table;
|
|
|
|
|
int standard;
|
|
|
|
|
{
|
1995-10-23 04:35:45 +00:00
|
|
|
|
Lisp_Object up, canon, eqv;
|
1997-05-28 04:36:34 +00:00
|
|
|
|
Lisp_Object indices[3];
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
|
|
|
|
check_case_table (table);
|
|
|
|
|
|
1995-10-19 00:14:14 +00:00
|
|
|
|
up = XCHAR_TABLE (table)->extras[0];
|
|
|
|
|
canon = XCHAR_TABLE (table)->extras[1];
|
|
|
|
|
eqv = XCHAR_TABLE (table)->extras[2];
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1992-01-13 21:48:03 +00:00
|
|
|
|
if (NILP (up))
|
1990-11-12 20:20:45 +00:00
|
|
|
|
{
|
1995-10-19 00:14:14 +00:00
|
|
|
|
up = Fmake_char_table (Qcase_table, Qnil);
|
2003-05-17 12:44:28 +00:00
|
|
|
|
map_char_table (set_identity, Qnil, table, table, up, 0, indices);
|
|
|
|
|
map_char_table (shuffle, Qnil, table, table, up, 0, indices);
|
1995-10-19 00:14:14 +00:00
|
|
|
|
XCHAR_TABLE (table)->extras[0] = up;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
}
|
|
|
|
|
|
1992-01-13 21:48:03 +00:00
|
|
|
|
if (NILP (canon))
|
1990-11-12 20:20:45 +00:00
|
|
|
|
{
|
1995-10-23 04:35:45 +00:00
|
|
|
|
canon = Fmake_char_table (Qcase_table, Qnil);
|
1995-10-19 00:14:14 +00:00
|
|
|
|
XCHAR_TABLE (table)->extras[1] = canon;
|
2003-05-17 12:44:28 +00:00
|
|
|
|
map_char_table (set_canon, Qnil, table, table, table, 0, indices);
|
1994-04-17 23:02:52 +00:00
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
if (NILP (eqv))
|
|
|
|
|
{
|
1995-10-19 00:14:14 +00:00
|
|
|
|
eqv = Fmake_char_table (Qcase_table, Qnil);
|
2003-05-17 12:44:28 +00:00
|
|
|
|
map_char_table (set_identity, Qnil, canon, canon, eqv, 0, indices);
|
|
|
|
|
map_char_table (shuffle, Qnil, canon, canon, eqv, 0, indices);
|
1995-10-23 04:35:45 +00:00
|
|
|
|
XCHAR_TABLE (table)->extras[2] = eqv;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
}
|
|
|
|
|
|
2002-09-06 16:46:08 +00:00
|
|
|
|
/* This is so set_image_of_range_1 in regex.c can find the EQV table. */
|
|
|
|
|
XCHAR_TABLE (canon)->extras[2] = eqv;
|
|
|
|
|
|
1990-11-12 20:20:45 +00:00
|
|
|
|
if (standard)
|
1995-10-23 04:35:45 +00:00
|
|
|
|
Vascii_downcase_table = table;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
else
|
1996-05-06 04:28:32 +00:00
|
|
|
|
{
|
|
|
|
|
current_buffer->downcase_table = table;
|
|
|
|
|
current_buffer->upcase_table = up;
|
|
|
|
|
current_buffer->case_canon_table = canon;
|
|
|
|
|
current_buffer->case_eqv_table = eqv;
|
|
|
|
|
}
|
1995-10-19 00:14:14 +00:00
|
|
|
|
|
1990-11-12 20:20:45 +00:00
|
|
|
|
return table;
|
|
|
|
|
}
|
|
|
|
|
|
1997-05-28 04:36:34 +00:00
|
|
|
|
/* The following functions are called in map_char_table. */
|
|
|
|
|
|
|
|
|
|
/* Set CANON char-table element for C to a translated ELT by UP and
|
|
|
|
|
DOWN char-tables. This is done only when ELT is a character. The
|
|
|
|
|
char-tables CANON, UP, and DOWN are in CASE_TABLE. */
|
1997-05-15 07:35:32 +00:00
|
|
|
|
|
1997-05-15 02:23:20 +00:00
|
|
|
|
static void
|
1997-05-28 04:36:34 +00:00
|
|
|
|
set_canon (case_table, c, elt)
|
|
|
|
|
Lisp_Object case_table, c, elt;
|
1997-05-15 02:23:20 +00:00
|
|
|
|
{
|
1997-05-28 04:36:34 +00:00
|
|
|
|
Lisp_Object up = XCHAR_TABLE (case_table)->extras[0];
|
|
|
|
|
Lisp_Object canon = XCHAR_TABLE (case_table)->extras[1];
|
1997-05-15 02:23:20 +00:00
|
|
|
|
|
1997-05-28 04:36:34 +00:00
|
|
|
|
if (NATNUMP (elt))
|
|
|
|
|
Faset (canon, c, Faref (case_table, Faref (up, elt)));
|
1997-05-15 02:23:20 +00:00
|
|
|
|
}
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1997-05-28 04:36:34 +00:00
|
|
|
|
/* Set elements of char-table TABLE for C to C itself. This is done
|
|
|
|
|
only when ELT is a character. This is called in map_char_table. */
|
1997-05-15 07:35:32 +00:00
|
|
|
|
|
1995-10-19 00:14:14 +00:00
|
|
|
|
static void
|
1997-05-28 04:36:34 +00:00
|
|
|
|
set_identity (table, c, elt)
|
|
|
|
|
Lisp_Object table, c, elt;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
{
|
1997-05-28 04:36:34 +00:00
|
|
|
|
if (NATNUMP (elt))
|
|
|
|
|
Faset (table, c, c);
|
1990-11-12 20:20:45 +00:00
|
|
|
|
}
|
1997-05-15 02:23:20 +00:00
|
|
|
|
|
1997-05-28 04:36:34 +00:00
|
|
|
|
/* Permute the elements of TABLE (which is initially an identity
|
|
|
|
|
mapping) so that it has one cycle for each equivalence class
|
|
|
|
|
induced by the translation table on which map_char_table is
|
|
|
|
|
operated. */
|
1997-05-15 02:23:20 +00:00
|
|
|
|
|
|
|
|
|
static void
|
1997-05-28 04:36:34 +00:00
|
|
|
|
shuffle (table, c, elt)
|
|
|
|
|
Lisp_Object table, c, elt;
|
1997-05-15 02:23:20 +00:00
|
|
|
|
{
|
1997-07-04 20:44:52 +00:00
|
|
|
|
if (NATNUMP (elt) && !EQ (c, elt))
|
1997-05-28 04:36:34 +00:00
|
|
|
|
{
|
|
|
|
|
Lisp_Object tem = Faref (table, elt);
|
|
|
|
|
Faset (table, elt, c);
|
|
|
|
|
Faset (table, c, tem);
|
|
|
|
|
}
|
1997-05-15 02:23:20 +00:00
|
|
|
|
}
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1998-04-14 12:25:56 +00:00
|
|
|
|
void
|
1990-11-12 20:20:45 +00:00
|
|
|
|
init_casetab_once ()
|
|
|
|
|
{
|
|
|
|
|
register int i;
|
1995-10-19 00:14:14 +00:00
|
|
|
|
Lisp_Object down, up;
|
|
|
|
|
Qcase_table = intern ("case-table");
|
|
|
|
|
staticpro (&Qcase_table);
|
|
|
|
|
|
|
|
|
|
/* Intern this now in case it isn't already done.
|
|
|
|
|
Setting this variable twice is harmless.
|
|
|
|
|
But don't staticpro it here--that is done in alloc.c. */
|
|
|
|
|
Qchar_table_extra_slots = intern ("char-table-extra-slots");
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1995-10-19 00:14:14 +00:00
|
|
|
|
/* Now we are ready to set up this property, so we can
|
|
|
|
|
create char tables. */
|
1995-10-23 04:35:45 +00:00
|
|
|
|
Fput (Qcase_table, Qchar_table_extra_slots, make_number (3));
|
1995-10-19 00:14:14 +00:00
|
|
|
|
|
|
|
|
|
down = Fmake_char_table (Qcase_table, Qnil);
|
|
|
|
|
Vascii_downcase_table = down;
|
1997-04-08 19:05:57 +00:00
|
|
|
|
XCHAR_TABLE (down)->purpose = Qcase_table;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1997-05-15 02:23:20 +00:00
|
|
|
|
for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
|
|
|
|
|
XSETFASTINT (XCHAR_TABLE (down)->contents[i],
|
|
|
|
|
(i >= 'A' && i <= 'Z') ? i + ('a' - 'A') : i);
|
1995-10-19 00:14:14 +00:00
|
|
|
|
|
|
|
|
|
XCHAR_TABLE (down)->extras[1] = Fcopy_sequence (down);
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1995-10-19 00:14:14 +00:00
|
|
|
|
up = Fmake_char_table (Qcase_table, Qnil);
|
|
|
|
|
XCHAR_TABLE (down)->extras[0] = up;
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
1997-05-15 02:23:20 +00:00
|
|
|
|
for (i = 0; i < CHAR_TABLE_SINGLE_BYTE_SLOTS; i++)
|
|
|
|
|
XSETFASTINT (XCHAR_TABLE (up)->contents[i],
|
|
|
|
|
((i >= 'A' && i <= 'Z')
|
|
|
|
|
? i + ('a' - 'A')
|
|
|
|
|
: ((i >= 'a' && i <= 'z')
|
|
|
|
|
? i + ('A' - 'a')
|
|
|
|
|
: i)));
|
1995-10-19 00:14:14 +00:00
|
|
|
|
|
|
|
|
|
XCHAR_TABLE (down)->extras[2] = Fcopy_sequence (up);
|
1990-11-12 20:20:45 +00:00
|
|
|
|
}
|
|
|
|
|
|
1998-04-14 12:25:56 +00:00
|
|
|
|
void
|
1990-11-12 20:20:45 +00:00
|
|
|
|
syms_of_casetab ()
|
|
|
|
|
{
|
|
|
|
|
Qcase_table_p = intern ("case-table-p");
|
|
|
|
|
staticpro (&Qcase_table_p);
|
1995-10-19 00:14:14 +00:00
|
|
|
|
|
1996-09-17 16:18:00 +00:00
|
|
|
|
staticpro (&Vascii_canon_table);
|
1990-11-12 20:20:45 +00:00
|
|
|
|
staticpro (&Vascii_downcase_table);
|
1996-09-17 16:18:00 +00:00
|
|
|
|
staticpro (&Vascii_eqv_table);
|
|
|
|
|
staticpro (&Vascii_upcase_table);
|
1990-11-12 20:20:45 +00:00
|
|
|
|
|
|
|
|
|
defsubr (&Scase_table_p);
|
|
|
|
|
defsubr (&Scurrent_case_table);
|
|
|
|
|
defsubr (&Sstandard_case_table);
|
|
|
|
|
defsubr (&Sset_case_table);
|
|
|
|
|
defsubr (&Sset_standard_case_table);
|
|
|
|
|
}
|
2003-09-01 15:45:59 +00:00
|
|
|
|
|
|
|
|
|
/* arch-tag: e06388ad-99fe-40ec-ba67-9d010fcc4916
|
|
|
|
|
(do not change this comment) */
|