annotate src/casetab.c @ 815:66265f190a16

[xemacs-hg @ 2002-04-14 17:40:13 by jhar] Undo accidental removal of reference to makeinfo-test
author jhar
date Sun, 14 Apr 2002 17:40:13 +0000
parents a5954632b187
children 6728e641994e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* XEmacs routines to deal with case tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1987, 1992, 1993, 1994 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Sun Microsystems, Inc.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
4 Copyright (C) 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
23 /* Synched up with: FSF 19.28. Between FSF 19.28 and 19.30, casetab.c
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 was rewritten to use junky FSF char tables. Meanwhile I rewrote it
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
25 to use more logical char tables. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 /* Written by Howard Gayle. See some mythical and not-in-the-Emacs-
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 distribution file chartab.c for details. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 /* Modified for Mule by Ben Wing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
32 /* #### Someone (Yoshiki?) wrote the following comment, which I don't
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
33 understand.
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
34
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
35 Case tables consist of four char-tables. These are for downcase,
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
36 upcase, canonical and equivalent respectively.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
37
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
38 The entries are like this:
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
39
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
40 downcase: a -> a, A -> a.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
41 upcase: a -> A, A -> a. (The latter is for NOCASEP.)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
42 canon: a -> a, A -> a.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
43 eqv: a -> A, A -> a.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
44 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include "opaque.h"
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
50 #include "chartab.h"
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
51 #include "casetab.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
53 Lisp_Object Qcase_tablep, Qdowncase, Qupcase;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
54 Lisp_Object Vstandard_case_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 static void compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
57 Lisp_Object case_table_char (Lisp_Object ch, Lisp_Object table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
59 #define STRING256_P(obj) ((STRINGP (obj) && XSTRING_CHAR_LENGTH (obj) == 256))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
60
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
61 static Lisp_Object
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
62 mark_case_table (Lisp_Object obj)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
63 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
64 Lisp_Case_Table *ct = XCASE_TABLE (obj);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
65
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
66 mark_object (CASE_TABLE_DOWNCASE (ct));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
67 mark_object (CASE_TABLE_UPCASE (ct));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
68 mark_object (CASE_TABLE_CANON (ct));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
69 mark_object (CASE_TABLE_EQV (ct));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
70 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
71 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
72
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
73 static void
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
74 print_case_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
75 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
76 Lisp_Case_Table *ct = XCASE_TABLE (obj);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
77 if (print_readably)
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
78 printing_unreadable_object ("#<case-table 0x%x", ct->header.uid);
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
79 write_fmt_string (printcharfun, "#<case-table 0x%x>", ct->header.uid);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
80 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
81
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
82 static const struct lrecord_description case_table_description [] = {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
83 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, downcase_table) },
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
84 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, upcase_table) },
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
85 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_canon_table) },
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
86 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_eqv_table) },
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
87 { XD_END }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
88 };
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
89
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
90 DEFINE_LRECORD_IMPLEMENTATION ("case-table", case_table,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
91 mark_case_table, print_case_table, 0,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
92 0, 0, case_table_description, Lisp_Case_Table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
93
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
94 static Lisp_Object
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
95 allocate_case_table (void)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
96 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
97 Lisp_Case_Table *ct =
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
98 alloc_lcrecord_type (Lisp_Case_Table, &lrecord_case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
99
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
100 SET_CASE_TABLE_DOWNCASE (ct, Qnil);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
101 SET_CASE_TABLE_UPCASE (ct, Qnil);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
102 SET_CASE_TABLE_CANON (ct, Qnil);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
103 SET_CASE_TABLE_EQV (ct, Qnil);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
104
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
105 return wrap_case_table (ct);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
106 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
109 Return t if OBJECT is a case table.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 See `set-case-table' for more information on these data structures.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
112 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
114 if (CASE_TABLEP (object))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
115 return Qt;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
116 else
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
117 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
118 Lisp_Object down, up, canon, eqv;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
119 if (!CONSP (object))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
120 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
121 down = XCAR (object); object = XCDR (object);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
122 if (!CONSP (object))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
123 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
124 up = XCAR (object); object = XCDR (object);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
125 if (!CONSP (object))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
126 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
127 canon = XCAR (object); object = XCDR (object);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
128 if (!CONSP (object))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
129 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
130 eqv = XCAR (object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
132 return ((STRING256_P (down)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
133 && (NILP (up) || STRING256_P (up))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
134 && ((NILP (canon) && NILP (eqv))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
135 || STRING256_P (canon))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
136 && (NILP (eqv) || STRING256_P (eqv)))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
137 ? Qt : Qnil);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
138
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
139 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 static Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
143 check_case_table (Lisp_Object object)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
145 /* This function can GC */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
146 while (NILP (Fcase_table_p (object)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
147 object = wrong_type_argument (Qcase_tablep, object);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
148 return object;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
151 Lisp_Object
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
152 case_table_char (Lisp_Object ch, Lisp_Object table)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
153 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
154 Lisp_Object ct_char;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
155 ct_char = get_char_table (XCHAR (ch), XCHAR_TABLE (table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
156 if (NILP (ct_char))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
157 return ch;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
158 else
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
159 return ct_char;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
160 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
161
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
162 DEFUN ("get-case-table", Fget_case_table, 3, 3, 0, /*
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
163 Return CHAR-CASE version of CHARACTER in CASE-TABLE.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
164
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
165 CHAR-CASE is either downcase or upcase.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
166 */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
167 (char_case, character, case_table))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
168 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
169 CHECK_CHAR (character);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
170 CHECK_CASE_TABLE (case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
171 if (EQ (char_case, Qdowncase))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
172 return case_table_char (character, XCASE_TABLE_DOWNCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
173 else if (EQ (char_case, Qupcase))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
174 return case_table_char (character, XCASE_TABLE_UPCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
175 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
176 invalid_constant ("Char case must be downcase or upcase", char_case);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
177
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
178 return Qnil; /* Not reached. */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
179 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
180
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
181 DEFUN ("put-case-table", Fput_case_table, 4, 4, 0, /*
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
182 Set CHAR-CASE version of CHARACTER to be VALUE in CASE-TABLE.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
183
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
184 CHAR-CASE is either downcase or upcase.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
185 See also `put-case-table-pair'.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
186 */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
187 (char_case, character, value, case_table))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
188 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
189 CHECK_CHAR (character);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
190 CHECK_CHAR (value);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
191
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
192 if (EQ (char_case, Qdowncase))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
193 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
194 Fput_char_table (character, value, XCASE_TABLE_DOWNCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
195 /* This one is not at all intuitive. */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
196 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
197 Fput_char_table (character, value, XCASE_TABLE_CANON (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
198 Fput_char_table (value, value, XCASE_TABLE_CANON (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
199 Fput_char_table (value, character, XCASE_TABLE_EQV (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
200 Fput_char_table (character, value, XCASE_TABLE_EQV (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
201 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
202 else if (EQ (char_case, Qupcase))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
203 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
204 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
205 Fput_char_table (character, character, XCASE_TABLE_DOWNCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
206 Fput_char_table (character, character, XCASE_TABLE_CANON (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
207 Fput_char_table (value, character, XCASE_TABLE_CANON (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
208 Fput_char_table (value, character, XCASE_TABLE_EQV (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
209 Fput_char_table (character, value, XCASE_TABLE_EQV (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
210 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
211 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
212 invalid_constant ("Char case must be downcase or upcase", char_case);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
213
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
214 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
215 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
216
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
217 DEFUN ("put-case-table-pair", Fput_case_table_pair, 3, 3, 0, /*
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
218 Make UC and LC a pair of inter-case-converting letters in CASE-TABLE.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
219 UC is an uppercase character and LC is a downcase character.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
220 */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
221 (uc, lc, case_table))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
222 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
223 CHECK_CHAR (uc);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
224 CHECK_CHAR (lc);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
225 CHECK_CASE_TABLE (case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
226
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
227 Fput_char_table (lc, lc, XCASE_TABLE_DOWNCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
228 Fput_char_table (uc, lc, XCASE_TABLE_UPCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
229 Fput_char_table (uc, lc, XCASE_TABLE_DOWNCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
230 Fput_char_table (lc, uc, XCASE_TABLE_UPCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
231
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
232 Fput_char_table (lc, lc, XCASE_TABLE_CANON (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
233 Fput_char_table (uc, lc, XCASE_TABLE_CANON (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
234 Fput_char_table (uc, lc, XCASE_TABLE_EQV (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
235 Fput_char_table (lc, uc, XCASE_TABLE_EQV (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
236 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
237 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
238
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
239 DEFUN ("copy-case-table", Fcopy_case_table, 1, 1, 0, /*
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
240 Return a new case table which is a copy of CASE-TABLE
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
241 */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
242 (case_table))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
243 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
244 Lisp_Object new_obj;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
245 CHECK_CASE_TABLE (case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
246
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
247 new_obj = allocate_case_table ();
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
248 XSET_CASE_TABLE_DOWNCASE
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
249 (new_obj, Fcopy_char_table (XCASE_TABLE_DOWNCASE (case_table)));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
250 XSET_CASE_TABLE_UPCASE
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
251 (new_obj, Fcopy_char_table (XCASE_TABLE_UPCASE (case_table)));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
252 XSET_CASE_TABLE_CANON
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
253 (new_obj, Fcopy_char_table (XCASE_TABLE_CANON (case_table)));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
254 XSET_CASE_TABLE_EQV
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
255 (new_obj, Fcopy_char_table (XCASE_TABLE_EQV (case_table)));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
256 return new_obj;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
257 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
258
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 Return the case table of BUFFER, which defaults to the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 struct buffer *buf = decode_buffer (buffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
266 return buf->case_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 Return the standard case table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 This is the one used for new buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
275 return Vstandard_case_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 static Lisp_Object set_case_table (Lisp_Object table, int standard);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
281 Select CASE-TABLE as the new case table for the current buffer.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
282 A case table is a case-table object or list
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
283 (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284 where each element is either nil or a string of length 256.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
285 The latter is provided for backward-compatibility.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
286 DOWNCASE maps each character to its lower-case equivalent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 UPCASE maps each character to its upper-case equivalent;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
288 if lower and upper case characters are in 1-1 correspondence,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 you may use nil and the upcase table will be deduced from DOWNCASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 CANONICALIZE maps each character to a canonical equivalent;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 any two characters that are related by case-conversion have the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 canonical equivalent character; it may be nil, in which case it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 deduced from DOWNCASE and UPCASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
294 EQUIVALENCES is a map that cyclicly permutes each equivalence class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 (of characters with the same canonical equivalent); it may be nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 in which case it is deduced from CANONICALIZE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
298 See also `get-case-table', `put-case-table' and `put-case-table-pair'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
300 (case_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
302 /* This function can GC */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
303 return set_case_table (case_table, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
307 Select CASE-TABLE as the new standard case table for new buffers.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 See `set-case-table' for more info on case tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
310 (case_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
312 /* This function can GC */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
313 return set_case_table (case_table, 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 set_case_table (Lisp_Object table, int standard)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
319 /* This function can GC */
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
320 struct buffer *buf =
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
321 standard ? XBUFFER(Vbuffer_defaults) : current_buffer;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 check_case_table (table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
325 if (CASE_TABLEP (table))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
326 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
327 if (standard)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
328 Vstandard_case_table = table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
330 buf->case_table = table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 }
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
332 else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
334 /* For backward compatibility. */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
335 Lisp_Object down, up, canon, eqv, tail = table;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
336 Lisp_Object temp;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
337 int i;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
338
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
339 down = XCAR (tail); tail = XCDR (tail);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
340 up = XCAR (tail); tail = XCDR (tail);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
341 canon = XCAR (tail); tail = XCDR (tail);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
342 eqv = XCAR (tail);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
343
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
344 temp = down;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
345 down = MAKE_TRT_TABLE ();
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
346 for (i = 0; i < 256; i++)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
347 SET_TRT_TABLE_CHAR_1 (down, i, XSTRING_CHAR (temp, i));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
349 if (NILP (up))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
350 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
351 up = MAKE_TRT_TABLE ();
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
352 compute_trt_inverse (down, up);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
353 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
354 else
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
355 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
356 temp = up;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
357 up = MAKE_TRT_TABLE ();
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
358 for (i = 0; i < 256; i++)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
359 SET_TRT_TABLE_CHAR_1 (up, i, XSTRING_CHAR (temp, i));
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
360 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
361 if (NILP (canon))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
362 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
363 canon = MAKE_TRT_TABLE ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
365 /* Set up the CANON table; for each character,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
366 this sequence of upcasing and downcasing ought to
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
367 get the "preferred" lowercase equivalent. */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
368 for (i = 0; i < 256; i++)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
369 SET_TRT_TABLE_CHAR_1 (canon, i,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
370 TRT_TABLE_CHAR_1
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
371 (down,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
372 TRT_TABLE_CHAR_1
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
373 (up,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
374 TRT_TABLE_CHAR_1 (down, i))));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
375 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
376 else
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
377 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
378 temp = canon;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
379 canon = MAKE_TRT_TABLE ();
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
380 for (i = 0; i < 256; i++)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
381 SET_TRT_TABLE_CHAR_1 (canon, i, XSTRING_CHAR (temp, i));
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
382 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
383
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
384 if (NILP (eqv))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
385 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
386 eqv = MAKE_TRT_TABLE ();
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
387 compute_trt_inverse (canon, eqv);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
388 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
389 else
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
390 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
391 temp = eqv;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
392 eqv = MAKE_TRT_TABLE ();
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
393 for (i = 0; i < 256; i++)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
394 SET_TRT_TABLE_CHAR_1 (eqv, i, XSTRING_CHAR (temp, i));
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
395 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
396
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
397 if (standard)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
398 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
399 XSET_CASE_TABLE_DOWNCASE (Vstandard_case_table, down);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
400 XSET_CASE_TABLE_UPCASE (Vstandard_case_table, up);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
401 XSET_CASE_TABLE_CANON (Vstandard_case_table, canon);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
402 XSET_CASE_TABLE_EQV (Vstandard_case_table, eqv);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
403 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
404
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
405 buf->case_table = allocate_case_table ();
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
406 XSET_CASE_TABLE_DOWNCASE (buf->case_table, down);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
407 XSET_CASE_TABLE_UPCASE (buf->case_table, up);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
408 XSET_CASE_TABLE_CANON (buf->case_table, canon);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
409 XSET_CASE_TABLE_EQV (buf->case_table, eqv);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
412 return buf->case_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 /* Given a translate table TRT, store the inverse mapping into INVERSE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 Since TRT is not one-to-one, INVERSE is not a simple mapping.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 Instead, it divides the space of characters into equivalence classes.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 All characters in a given class form one circular list, chained through
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 the elements of INVERSE. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 compute_trt_inverse (Lisp_Object trt, Lisp_Object inverse)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 Charcount i = 0400;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 Emchar c, q;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 while (--i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 SET_TRT_TABLE_CHAR_1 (inverse, i, (Emchar) i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 i = 0400;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 while (--i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 if ((q = TRT_TABLE_CHAR_1 (trt, i)) != (Emchar) i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 c = TRT_TABLE_CHAR_1 (inverse, q);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 SET_TRT_TABLE_CHAR_1 (inverse, q, (Emchar) i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 SET_TRT_TABLE_CHAR_1 (inverse, i, c);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 syms_of_casetab (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
445 INIT_LRECORD_IMPLEMENTATION (case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
446
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
447 DEFSYMBOL_MULTIWORD_PREDICATE (Qcase_tablep);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
448 DEFSYMBOL (Qdowncase);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
449 DEFSYMBOL (Qupcase);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 DEFSUBR (Fcase_table_p);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
452 DEFSUBR (Fget_case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
453 DEFSUBR (Fput_case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
454 DEFSUBR (Fput_case_table_pair);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 DEFSUBR (Fcurrent_case_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 DEFSUBR (Fstandard_case_table);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
457 DEFSUBR (Fcopy_case_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 DEFSUBR (Fset_case_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 DEFSUBR (Fset_standard_case_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 complex_vars_of_casetab (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 REGISTER Emchar i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 Lisp_Object tem;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
468 staticpro (&Vstandard_case_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
470 Vstandard_case_table = allocate_case_table ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 tem = MAKE_TRT_TABLE ();
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
473 XSET_CASE_TABLE_DOWNCASE (Vstandard_case_table, tem);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
474 XSET_CASE_TABLE_CANON (Vstandard_case_table, tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 /* Under Mule, can't do set_string_char() until Vcharset_control_1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 and Vcharset_ascii are initialized. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 for (i = 0; i < 256; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 unsigned char lowered = tolower (i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 SET_TRT_TABLE_CHAR_1 (tem, i, lowered);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 tem = MAKE_TRT_TABLE ();
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
486 XSET_CASE_TABLE_UPCASE (Vstandard_case_table, tem);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
487 XSET_CASE_TABLE_EQV (Vstandard_case_table, tem);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 for (i = 0; i < 256; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 unsigned char flipped = (isupper (i) ? tolower (i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 : (islower (i) ? toupper (i) : i));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 SET_TRT_TABLE_CHAR_1 (tem, i, flipped);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 }