annotate src/chartab.c @ 826:6728e641994e

[xemacs-hg @ 2002-05-05 11:30:15 by ben] syntax cache, 8-bit-format, lots of code cleanup README.packages: Update info about --package-path. i.c: Create an inheritable event and pass it on to XEmacs, so that ^C can be handled properly. Intercept ^C and signal the event. "Stop Build" in VC++ now works. bytecomp-runtime.el: Doc string changes. compat.el: Some attempts to redo this to make it truly useful and fix the "multiple versions interacting with each other" problem. Not yet done. Currently doesn't work. files.el: Use with-obsolete-variable to avoid warnings in new revert-buffer code. xemacs.mak: Split up CFLAGS into a version without flags specifying the C library. The problem seems to be that minitar depends on zlib, which depends specifically on libc.lib, not on any of the other C libraries. Unless you compile with libc.lib, you get errors -- specifically, no _errno in the other libraries, which must make it something other than an int. (#### But this doesn't seem to obtain in XEmacs, which also uses zlib, and can be linked with any of the C libraries. Maybe zlib is used differently and doesn't need errno, or maybe XEmacs provides an int errno; ... I don't understand. Makefile.in.in: Fix so that packages are around when testing. abbrev.c, alloc.c, buffer.c, buffer.h, bytecode.c, callint.c, casefiddle.c, casetab.c, casetab.h, charset.h, chartab.c, chartab.h, cmds.c, console-msw.h, console-stream.c, console-x.c, console.c, console.h, data.c, device-msw.c, device.c, device.h, dialog-msw.c, dialog-x.c, dired-msw.c, dired.c, doc.c, doprnt.c, dumper.c, editfns.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, events.c, events.h, extents.c, extents.h, faces.c, file-coding.c, file-coding.h, fileio.c, fns.c, font-lock.c, frame-gtk.c, frame-msw.c, frame-x.c, frame.c, frame.h, glade.c, glyphs-gtk.c, glyphs-msw.c, glyphs-msw.h, glyphs-x.c, glyphs.c, glyphs.h, gui-msw.c, gui-x.c, gui.h, gutter.h, hash.h, indent.c, insdel.c, intl-win32.c, intl.c, keymap.c, lisp-disunion.h, lisp-union.h, lisp.h, lread.c, lrecord.h, lstream.c, lstream.h, marker.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, minibuf.c, mule-ccl.c, mule-charset.c, mule-coding.c, mule-wnnfns.c, nas.c, objects-msw.c, objects-x.c, opaque.c, postgresql.c, print.c, process-nt.c, process-unix.c, process.c, process.h, profile.c, rangetab.c, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-x.c, redisplay.c, redisplay.h, regex.c, regex.h, scrollbar-msw.c, search.c, select-x.c, specifier.c, specifier.h, symbols.c, symsinit.h, syntax.c, syntax.h, syswindows.h, tests.c, text.c, text.h, tooltalk.c, ui-byhand.c, ui-gtk.c, unicode.c, win32.c, window.c: Another big Ben patch. -- FUNCTIONALITY CHANGES: add partial support for 8-bit-fixed, 16-bit-fixed, and 32-bit-fixed formats. not quite done yet. (in particular, needs functions to actually convert the buffer.) NOTE: lots of changes to regex.c here. also, many new *_fmt() inline funs that take an Internal_Format argument. redo syntax cache code. make the cache per-buffer; keep the cache valid across calls to functions that use it. also keep it valid across insertions/deletions and extent changes, as much as is possible. eliminate the junky regex-reentrancy code by passing in the relevant lisp info to the regex routines as local vars. add general mechanism in extents code for signalling extent changes. fix numerous problems with the case-table implementation; yoshiki never properly transferred many algorithms from old-style to new-style case tables. redo char tables to support a default argument, so that mapping only occurs over changed args. change many chartab functions to accept Lisp_Object instead of Lisp_Char_Table *. comment out the code in font-lock.c by default, because font-lock.el no longer uses it. we should consider eliminating it entirely. Don't output bell as ^G in console-stream when not a TTY. add -mswindows-termination-handle to interface with i.c, so we can properly kill a build. add more error-checking to buffer/string macros. add some additional buffer_or_string_() funs. -- INTERFACE CHANGES AFFECTING MORE CODE: switch the arguments of write_c_string and friends to be consistent with write_fmt_string, which must have printcharfun first. change BI_* macros to BYTE_* for increased clarity; similarly for bi_* local vars. change VOID_TO_LISP to be a one-argument function. eliminate no-longer-needed CVOID_TO_LISP. -- char/string macro changes: rename MAKE_CHAR() to make_emchar() for slightly less confusion with make_char(). (The former generates an Emchar, the latter a Lisp object. Conceivably we should rename make_char() -> wrap_char() and similarly for make_int(), make_float().) Similar changes for other *CHAR* macros -- we now consistently use names with `emchar' whenever we are working with Emchars. Any remaining name with just `char' always refers to a Lisp object. rename macros with XSTRING_* to string_* except for those that reference actual fields in the Lisp_String object, following conventions used elsewhere. rename set_string_{data,length} macros (the only ones to work with a Lisp_String_* instead of a Lisp_Object) to set_lispstringp_* to make the difference clear. try to be consistent about caps vs. lowercase in macro/inline-fun names for chars and such, which wasn't the case before. we now reserve caps either for XFOO_ macros that reference object fields (e.g. XSTRING_DATA) or for things that have non-function semantics, e.g. directly modifying an arg (BREAKUP_EMCHAR) or evaluating an arg (any arg) more than once. otherwise, use lowercase. here is a summary of most of the macros/inline funs changed by all of the above changes: BYTE_*_P -> byte_*_p XSTRING_BYTE -> string_byte set_string_data/length -> set_lispstringp_data/length XSTRING_CHAR_LENGTH -> string_char_length XSTRING_CHAR -> string_emchar INTBYTE_FIRST_BYTE_P -> intbyte_first_byte_p INTBYTE_LEADING_BYTE_P -> intbyte_leading_byte_p charptr_copy_char -> charptr_copy_emchar LEADING_BYTE_* -> leading_byte_* CHAR_* -> EMCHAR_* *_CHAR_* -> *_EMCHAR_* *_CHAR -> *_EMCHAR CHARSET_BY_ -> charset_by_* BYTE_SHIFT_JIS* -> byte_shift_jis* BYTE_BIG5* -> byte_big5* REP_BYTES_BY_FIRST_BYTE -> rep_bytes_by_first_byte char_to_unicode -> emchar_to_unicode valid_char_p -> valid_emchar_p Change intbyte_strcmp -> qxestrcmp_c (duplicated functionality). -- INTERFACE CHANGES AFFECTING LESS CODE: use DECLARE_INLINE_HEADER in various places. remove '#ifdef emacs' from XEmacs-only files. eliminate CHAR_TABLE_VALUE(), which duplicated the functionality of get_char_table(). add BUFFER_TEXT_LOOP to simplify iterations over buffer text. define typedefs for signed and unsigned types of fixed sizes (INT_32_BIT, UINT_32_BIT, etc.). create ALIGN_FOR_TYPE as a higher-level interface onto ALIGN_SIZE; fix code to use it. add charptr_emchar_len to return the text length of the character pointed to by a ptr; use it in place of charcount_to_bytecount(..., 1). add emchar_len to return the text length of a given character. add types Bytexpos and Charxpos to generalize Bytebpos/Bytecount and Charbpos/Charcount, in code (particularly, the extents code and redisplay code) that works with either kind of index. rename redisplay struct params with names such as `charbpos' to e.g. `charpos' when they are e.g. a Charxpos, not a Charbpos. eliminate xxDEFUN in place of DEFUN; no longer necessary with changes awhile back to doc.c. split up big ugly combined list of EXFUNs in lisp.h on a file-by-file basis, since other prototypes are similarly split. rewrite some "*_UNSAFE" macros as inline funs and eliminate the _UNSAFE suffix. move most string code from lisp.h to text.h; the string code and text.h code is now intertwined in such a fashion that they need to be in the same place and partially interleaved. (you can't create forward references for inline funs) automated/lisp-tests.el, automated/symbol-tests.el, automated/test-harness.el: Fix test harness to output FAIL messages to stderr when in batch mode. Fix up some problems in lisp-tests/symbol-tests that were causing spurious failures.
author ben
date Sun, 05 May 2002 11:33:57 +0000
parents 2b676dc88c66
children 2b6fa2618f76
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 char tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1992, 1995 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Sun Microsystems, Inc.
788
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
4 Copyright (C) 1995, 1996, 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 Licensed to the Free Software Foundation.
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 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 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
12 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 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
16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 /* Synched up with: Mule 2.3. Not synched with FSF.
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 This file was written independently of the FSF implementation,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 and is not compatible. */
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 /* Authorship:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 Ben Wing: wrote, for 19.13 (Mule). Some category table stuff
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 loosely based on the original Mule.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 Jareth Hein: fixed a couple of bugs in the implementation, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 added regex support for categories with check_category_at
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 #include "chartab.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 #include "syntax.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 Lisp_Object Qchar_tablep, Qchar_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 Lisp_Object Vall_syntax_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 Lisp_Object Qcategory_table_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 Lisp_Object Qcategory_designator_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 Lisp_Object Qcategory_table_value_p;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 Lisp_Object Vstandard_category_table;
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 /* Variables to determine word boundary. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 Lisp_Object Vword_combining_categories, Vword_separating_categories;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
60 static int check_valid_char_table_value (Lisp_Object value,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
61 enum char_table_type type,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
62 Error_Behavior errb);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
63
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 /* A char table maps from ranges of characters to values.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 Implementing a general data structure that maps from arbitrary
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 ranges of numbers to values is tricky to do efficiently. As it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 happens, it should suffice (and is usually more convenient, anyway)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 when dealing with characters to restrict the sorts of ranges that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 can be assigned values, as follows:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 1) All characters.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 2) All characters in a charset.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 3) All characters in a particular row of a charset, where a "row"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 means all characters with the same first byte.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 4) A particular character in a charset.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 We use char tables to generalize the 256-element vectors now
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 littering the Emacs code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 Possible uses (all should be converted at some point):
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 1) category tables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 2) syntax tables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 3) display tables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 4) case tables
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 5) keyboard-translate-table?
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 We provide an
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 abstract type to generalize the Emacs vectors and Mule
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 vectors-of-vectors goo.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 /* Char Table object */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 mark_char_table_entry (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
104 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 for (i = 0; i < 96; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 mark_object (cte->level2[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
117 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
118 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 for (i = 0; i < 96; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 if (!internal_equal (cte1->level2[i], cte2->level2[i], depth + 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
128 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 char_table_entry_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
131 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
133 return internal_array_hash (cte->level2, 96, depth + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 static const struct lrecord_description char_table_entry_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
137 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 };
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 DEFINE_LRECORD_IMPLEMENTATION ("char-table-entry", char_table_entry,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 mark_char_table_entry, internal_object_printer,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 0, char_table_entry_equal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 char_table_entry_hash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 char_table_entry_description,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
146 Lisp_Char_Table_Entry);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 mark_char_table (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
152 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 for (i = 0; i < NUM_ASCII_CHARS; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 mark_object (ct->ascii[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 for (i = 0; i < NUM_LEADING_BYTES; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 mark_object (ct->level1[i]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 #endif
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
161 mark_object (ct->parent);
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
162 mark_object (ct->default_);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 return ct->mirror_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 /* WARNING: All functions of this nature need to be written extremely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 carefully to avoid crashes during GC. Cf. prune_specifiers()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 and prune_weak_hash_tables(). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 prune_syntax_tables (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 Lisp_Object rest, prev = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 for (rest = Vall_syntax_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 !NILP (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 rest = XCHAR_TABLE (rest)->next_table)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 if (! marked_p (rest))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 /* This table is garbage. Remove it from the list. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 if (NILP (prev))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 XCHAR_TABLE (prev)->next_table =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 XCHAR_TABLE (rest)->next_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 char_table_type_to_symbol (enum char_table_type type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 switch (type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 default: abort();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 case CHAR_TABLE_TYPE_CHAR: return Qchar;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 static enum char_table_type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 symbol_to_char_table_type (Lisp_Object symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 CHECK_SYMBOL (symbol);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
220 invalid_constant ("Unrecognized char table type", symbol);
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
221 RETURN_NOT_REACHED (CHAR_TABLE_TYPE_GENERIC)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 static void
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
225 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
227 if (EQ (range, Qt))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
228 outrange->type = CHARTAB_RANGE_ALL;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
229 else if (CHAR_OR_CHAR_INTP (range))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
230 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
231 outrange->type = CHARTAB_RANGE_CHAR;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
232 outrange->ch = XCHAR_OR_CHAR_INT (range);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
233 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
234 #ifndef MULE
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 else
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
236 sferror ("Range must be t or a character", range);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
237 #else /* MULE */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
238 else if (VECTORP (range))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
239 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
240 Lisp_Vector *vec = XVECTOR (range);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
241 Lisp_Object *elts = vector_data (vec);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
242 if (vector_length (vec) != 2)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
243 sferror ("Length of charset row vector must be 2",
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
244 range);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
245 outrange->type = CHARTAB_RANGE_ROW;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
246 outrange->charset = Fget_charset (elts[0]);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
247 CHECK_INT (elts[1]);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
248 outrange->row = XINT (elts[1]);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
249 switch (XCHARSET_TYPE (outrange->charset))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
250 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
251 case CHARSET_TYPE_94:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
252 case CHARSET_TYPE_96:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
253 sferror ("Charset in row vector must be multi-byte",
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
254 outrange->charset);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
255 case CHARSET_TYPE_94X94:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
256 check_int_range (outrange->row, 33, 126);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
257 break;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
258 case CHARSET_TYPE_96X96:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
259 check_int_range (outrange->row, 32, 127);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
260 break;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
261 default:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
262 abort ();
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
263 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
264 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
265 else
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
266 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
267 if (!CHARSETP (range) && !SYMBOLP (range))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
268 sferror
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
269 ("Char table range must be t, charset, char, or vector", range);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
270 outrange->type = CHARTAB_RANGE_CHARSET;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
271 outrange->charset = Fget_charset (range);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
272 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
273 #endif /* MULE */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
276 static Lisp_Object
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
277 encode_char_table_range (struct chartab_range *range)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
279 switch (range->type)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
281 case CHARTAB_RANGE_ALL:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
282 return Qt;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
283
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
284 #ifdef MULE
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
285 case CHARTAB_RANGE_CHARSET:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
286 return XCHARSET_NAME (Fget_charset (range->charset));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
288 case CHARTAB_RANGE_ROW:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
289 return vector2 (XCHARSET_NAME (Fget_charset (range->charset)),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
290 make_int (range->row));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
291 #endif
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
292 case CHARTAB_RANGE_CHAR:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
293 return make_char (range->ch);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
294 default:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
295 abort ();
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 }
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
297 return Qnil; /* not reached */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
300 struct ptemap
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
302 Lisp_Object printcharfun;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
303 int first;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
304 };
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
306 static int
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
307 print_table_entry (struct chartab_range *range, Lisp_Object table,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
308 Lisp_Object val, void *arg)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
309 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
310 struct ptemap *a = (struct ptemap *) arg;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
311 struct gcpro gcpro1;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
312 Lisp_Object lisprange;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
313 if (!a->first)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
314 write_c_string (a->printcharfun, " ");
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
315 a->first = 0;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
316 lisprange = encode_char_table_range (range);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
317 GCPRO1 (lisprange);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
318 write_fmt_string_lisp (a->printcharfun, "%s %s", 2, lisprange, val);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
319 UNGCPRO;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
320 return 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 }
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 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
326 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
327 struct chartab_range range;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
328 struct ptemap arg;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
329
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
330 range.type = CHARTAB_RANGE_ALL;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
331 arg.printcharfun = printcharfun;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
332 arg.first = 1;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
334 write_fmt_string_lisp (printcharfun, "#s(char-table type %s data (",
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
335 1, char_table_type_to_symbol (ct->type));
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
336 map_char_table (obj, &range, print_table_entry, &arg);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
337 write_c_string (printcharfun, "))");
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
339 /* #### need to print and read the default; but that will allow the
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
340 default to be modified, which we don't (yet) support -- but FSF does */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
346 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1);
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
347 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 for (i = 0; i < NUM_ASCII_CHARS; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 if (!internal_equal (ct1->ascii[i], ct2->ascii[i], depth + 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 for (i = 0; i < NUM_LEADING_BYTES; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 if (!internal_equal (ct1->level1[i], ct2->level1[i], depth + 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
363 return internal_equal (ct1->default_, ct2->default_, depth + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
366 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 char_table_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
369 Lisp_Char_Table *ct = XCHAR_TABLE (obj);
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
370 Hashcode hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS,
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
371 depth + 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 hashval = HASH2 (hashval,
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
374 internal_array_hash (ct->level1, NUM_LEADING_BYTES,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
375 depth + 1));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 #endif /* MULE */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
377 return HASH2 (hashval, internal_hash (ct->default_, depth + 1));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
379
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 static const struct lrecord_description char_table_description[] = {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
381 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 #ifdef MULE
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
383 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 #endif
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
385 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, parent) },
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
386 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, default_) },
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
387 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) },
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
388 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) },
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
389 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
391
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 DEFINE_LRECORD_IMPLEMENTATION ("char-table", char_table,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 mark_char_table, print_char_table, 0,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 char_table_equal, char_table_hash,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 char_table_description,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
396 Lisp_Char_Table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 Return non-nil if OBJECT is a char table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 return CHAR_TABLEP (object) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 Return a list of the recognized char table types.
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
408 See `make-char-table'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 */
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 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 Return t if TYPE if a recognized char table type.
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
421 See `make-char-table'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 (type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 return (EQ (type, Qchar) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 EQ (type, Qcategory) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 EQ (type, Qdisplay) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430 EQ (type, Qgeneric) ||
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 EQ (type, Qsyntax)) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 }
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 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
435 Return the type of CHAR-TABLE.
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
436 See `make-char-table'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
438 (char_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
440 CHECK_CHAR_TABLE (char_table);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
441 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 void
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
445 set_char_table_default (Lisp_Object table, Lisp_Object value)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
446 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
447 Lisp_Char_Table *ct = XCHAR_TABLE (table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
448 ct->default_ = value;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
449 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
450 update_syntax_table (table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
451 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
452
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
453 static void
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
454 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 for (i = 0; i < NUM_ASCII_CHARS; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 ct->ascii[i] = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 for (i = 0; i < NUM_LEADING_BYTES; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 ct->level1[i] = value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 #endif /* MULE */
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 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
466 update_syntax_table (wrap_char_table (ct));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
470 Reset CHAR-TABLE to its default state.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
472 (char_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
474 Lisp_Char_Table *ct;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
475 Lisp_Object def;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
477 CHECK_CHAR_TABLE (char_table);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
478 ct = XCHAR_TABLE (char_table);
428
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 switch (ct->type)
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 case CHAR_TABLE_TYPE_CHAR:
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
483 def = make_char (0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 case CHAR_TABLE_TYPE_DISPLAY:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 case CHAR_TABLE_TYPE_GENERIC:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 case CHAR_TABLE_TYPE_CATEGORY:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 #endif /* MULE */
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
490 def = Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 case CHAR_TABLE_TYPE_SYNTAX:
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
494 def = make_int (Sinherit);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 abort ();
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
499 def = Qnil;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
500 break;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
503 /* Avoid doubly updating the syntax table by setting the default ourselves,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
504 since set_char_table_default() also updates. */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
505 ct->default_ = def;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
506 fill_char_table (ct, Qunbound);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
507
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 Return a new, empty char table of type TYPE.
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
513
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
514 A char table is a table that maps characters (or ranges of characters)
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
515 to values. Char tables are specialized for characters, only allowing
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
516 particular sorts of ranges to be assigned values. Although this
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
517 loses in generality, it makes for extremely fast (constant-time)
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
518 lookups, and thus is feasible for applications that do an extremely
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
519 large number of lookups (e.g. scanning a buffer for a character in
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
520 a particular syntax, where a lookup in the syntax table must occur
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
521 once per character).
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
522
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
523 When Mule support exists, the types of ranges that can be assigned
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
524 values are
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
525
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
526 -- all characters
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
527 -- an entire charset
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
528 -- a single row in a two-octet charset
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
529 -- a single character
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
530
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
531 When Mule support is not present, the types of ranges that can be
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
532 assigned values are
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
533
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
534 -- all characters
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
535 -- a single character
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
536
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
537 To create a char table, use `make-char-table'.
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
538 To modify a char table, use `put-char-table' or `remove-char-table'.
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
539 To retrieve the value for a particular character, use `get-char-table'.
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
540 See also `map-char-table', `reset-char-table', `copy-char-table',
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
541 `char-table-p', `valid-char-table-type-p', `char-table-type-list',
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
542 `valid-char-table-value-p', and `check-char-table-value'.
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
543
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
544 Each char table type is used for a different purpose and allows different
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
545 sorts of values. The different char table types are
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
546
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
547 `category'
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
548 Used for category tables, which specify the regexp categories
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
549 that a character is in. The valid values are nil or a
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
550 bit vector of 95 elements. Higher-level Lisp functions are
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
551 provided for working with category tables. Currently categories
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
552 and category tables only exist when Mule support is present.
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
553 `char'
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
554 A generalized char table, for mapping from one character to
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
555 another. Used for case tables, syntax matching tables,
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
556 `keyboard-translate-table', etc. The valid values are characters.
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
557 `generic'
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
558 An even more generalized char table, for mapping from a
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
559 character to anything.
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
560 `display'
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
561 Used for display tables, which specify how a particular character
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
562 is to appear when displayed. #### Not yet implemented.
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
563 `syntax'
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
564 Used for syntax tables, which specify the syntax of a particular
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
565 character. Higher-level Lisp functions are provided for
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
566 working with syntax tables. The valid values are integers.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
570 Lisp_Char_Table *ct;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 Lisp_Object obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 enum char_table_type ty = symbol_to_char_table_type (type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
574 ct = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 ct->type = ty;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
576 if (ty == CHAR_TABLE_TYPE_SYNTAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
578 /* Qgeneric not Qsyntax because a syntax table has a mirror table
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
579 and we don't want infinite recursion */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 ct->mirror_table = Fmake_char_table (Qgeneric);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
581 set_char_table_default (ct->mirror_table, make_int (Spunct));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
584 ct->mirror_table = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 ct->next_table = Qnil;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
586 ct->parent = Qnil;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
587 ct->default_ = Qnil;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
588 obj = wrap_char_table (ct);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 if (ty == CHAR_TABLE_TYPE_SYNTAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 ct->next_table = Vall_syntax_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
592 Vall_syntax_tables = obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
594 Freset_char_table (obj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 return obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
596 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
598 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 make_char_table_entry (Lisp_Object initval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 int i;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
604 Lisp_Char_Table_Entry *cte =
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
605 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
606
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 for (i = 0; i < 96; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
608 cte->level2[i] = initval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
610 return wrap_char_table_entry (cte);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 copy_char_table_entry (Lisp_Object entry)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
616 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 int i;
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
618 Lisp_Char_Table_Entry *ctenew =
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
619 alloc_lcrecord_type (Lisp_Char_Table_Entry, &lrecord_char_table_entry);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 for (i = 0; i < 96; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 Lisp_Object new = cte->level2[i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
624 if (CHAR_TABLE_ENTRYP (new))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 ctenew->level2[i] = copy_char_table_entry (new);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
626 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 ctenew->level2[i] = new;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
630 return wrap_char_table_entry (ctenew);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
631 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
636 Return a new char table which is a copy of CHAR-TABLE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 It will contain the same values for the same characters and ranges
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
638 as CHAR-TABLE. The values will not themselves be copied.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
640 (char_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
642 Lisp_Char_Table *ct, *ctnew;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 Lisp_Object obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
645
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
646 CHECK_CHAR_TABLE (char_table);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
647 ct = XCHAR_TABLE (char_table);
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
648 ctnew = alloc_lcrecord_type (Lisp_Char_Table, &lrecord_char_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 ctnew->type = ct->type;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
650 ctnew->parent = ct->parent;
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
651 ctnew->default_ = ct->default_;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
652
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 for (i = 0; i < NUM_ASCII_CHARS; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
654 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 Lisp_Object new = ct->ascii[i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 assert (! (CHAR_TABLE_ENTRYP (new)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659 ctnew->ascii[i] = new;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 for (i = 0; i < NUM_LEADING_BYTES; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
665 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 Lisp_Object new = ct->level1[i];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 if (CHAR_TABLE_ENTRYP (new))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 ctnew->level1[i] = copy_char_table_entry (new);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
670 ctnew->level1[i] = new;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
672
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 if (CHAR_TABLEP (ct->mirror_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 ctnew->mirror_table = Fcopy_char_table (ct->mirror_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678 ctnew->mirror_table = ct->mirror_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
679 ctnew->next_table = Qnil;
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 788
diff changeset
680 obj = wrap_char_table (ctnew);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 ctnew->next_table = Vall_syntax_tables;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 Vall_syntax_tables = obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
686 return obj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
688
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
691 /* called from get_char_table(). */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692 Lisp_Object
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
693 get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte,
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
694 Emchar c)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 Lisp_Object val;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
697 Lisp_Object charset = charset_by_leading_byte (leading_byte);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 int byte1, byte2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
700 BREAKUP_EMCHAR_1_UNSAFE (c, charset, byte1, byte2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 val = ct->level1[leading_byte - MIN_LEADING_BYTE];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 if (CHAR_TABLE_ENTRYP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
704 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 val = cte->level2[byte1 - 32];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
706 if (CHAR_TABLE_ENTRYP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 cte = XCHAR_TABLE_ENTRY (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709 assert (byte2 >= 32);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 val = cte->level2[byte2 - 32];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 assert (!CHAR_TABLE_ENTRYP (val));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 return val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
720 DEFUN ("char-table-default", Fchar_table_default, 1, 1, 0, /*
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
721 Return the default value for CHAR-TABLE. When an entry for a character
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
722 does not exist, the default is returned.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
723 */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
724 (char_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
726 CHECK_CHAR_TABLE (char_table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
727 return XCHAR_TABLE (char_table)->default_;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
730 DEFUN ("set-char-table-default", Fset_char_table_default, 2, 2, 0, /*
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
731 Set the default value for CHAR-TABLE to DEFAULT.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
732 Currently, the default value for syntax tables cannot be changed.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
733 (This policy might change in the future.)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
734 */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
735 (char_table, default_))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
736 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
737 CHECK_CHAR_TABLE (char_table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
738 if (XCHAR_TABLE_TYPE (char_table) == CHAR_TABLE_TYPE_SYNTAX)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
739 invalid_change ("Can't change default for syntax tables", char_table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
740 check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (char_table),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
741 ERROR_ME);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
742 set_char_table_default (char_table, default_);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
743 return Qnil;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
744 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
747 Find value for CHARACTER in CHAR-TABLE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
749 (character, char_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
751 CHECK_CHAR_TABLE (char_table);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
752 CHECK_CHAR_COERCE_INT (character);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
754 return get_char_table (XCHAR (character), char_table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
755 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
756
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
757 static int
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
758 copy_mapper (struct chartab_range *range, Lisp_Object table,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
759 Lisp_Object val, void *arg)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
760 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
761 put_char_table (VOID_TO_LISP (arg), range, val);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
762 return 0;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
763 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
764
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
765 void
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
766 copy_char_table_range (Lisp_Object from, Lisp_Object to,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
767 struct chartab_range *range)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
768 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
769 map_char_table (from, range, copy_mapper, LISP_TO_VOID (to));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
770 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
771
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
772 Lisp_Object
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
773 get_range_char_table (struct chartab_range *range, Lisp_Object table,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
774 Lisp_Object multi)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
775 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
776 Lisp_Char_Table *ct = XCHAR_TABLE (table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
777 Lisp_Object retval = Qnil;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
778
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
779 switch (range->type)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
780 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
781 case CHARTAB_RANGE_CHAR:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
782 return get_char_table (range->ch, table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
783
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
784 case CHARTAB_RANGE_ALL:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
785 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
786 int i;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
787 retval = ct->ascii[0];
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
788
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
789 for (i = 1; i < NUM_ASCII_CHARS; i++)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
790 if (!EQ (retval, ct->ascii[i]))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
791 return multi;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
792
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
793 #ifdef MULE
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
794 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
795 i++)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
796 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
797 if (!CHARSETP (charset_by_leading_byte (i))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
798 || i == LEADING_BYTE_ASCII
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
799 || i == LEADING_BYTE_CONTROL_1)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
800 continue;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
801 if (!EQ (retval, ct->level1[i - MIN_LEADING_BYTE]))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
802 return multi;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
803 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
804 #endif /* MULE */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
805
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
806 break;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
807 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
808
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
809 #ifdef MULE
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
810 case CHARTAB_RANGE_CHARSET:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
811 if (EQ (range->charset, Vcharset_ascii))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
812 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
813 int i;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
814 retval = ct->ascii[0];
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
815
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
816 for (i = 1; i < 128; i++)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
817 if (!EQ (retval, ct->ascii[i]))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
818 return multi;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
819 break;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
820 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
821
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
822 if (EQ (range->charset, Vcharset_control_1))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
823 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
824 int i;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
825 retval = ct->ascii[128];
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
827 for (i = 129; i < 160; i++)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
828 if (!EQ (retval, ct->ascii[i]))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
829 return multi;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
830 break;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
831 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
832
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
833 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
834 retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) -
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
835 MIN_LEADING_BYTE];
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
836 if (CHAR_TABLE_ENTRYP (retval))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
837 return multi;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
838 break;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
839 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
840
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
841 case CHARTAB_RANGE_ROW:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
842 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
843 retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) -
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
844 MIN_LEADING_BYTE];
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
845 if (!CHAR_TABLE_ENTRYP (retval))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
846 break;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
847 retval = XCHAR_TABLE_ENTRY (retval)->level2[range->row - 32];
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
848 if (CHAR_TABLE_ENTRYP (retval))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
849 return multi;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
850 break;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
851 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
852 #endif /* not MULE */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
853
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
854 default:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
855 abort ();
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
856 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
857
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
858 if (UNBOUNDP (retval))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
859 return ct->default_;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
860 return retval;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
864 Find value for a range in CHAR-TABLE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 If there is more than one value, return MULTI (defaults to nil).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
867 (range, char_table, multi))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 struct chartab_range rainj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 if (CHAR_OR_CHAR_INTP (range))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
872 return Fget_char_table (range, char_table);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
873 CHECK_CHAR_TABLE (char_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 decode_char_table_range (range, &rainj);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
876 return get_range_char_table (&rainj, char_table, multi);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 }
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
878
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 check_valid_char_table_value (Lisp_Object value, enum char_table_type type,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
881 Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 switch (type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 case CHAR_TABLE_TYPE_SYNTAX:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 if (!ERRB_EQ (errb, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 return INTP (value) || (CONSP (value) && INTP (XCAR (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 && CHAR_OR_CHAR_INTP (XCDR (value)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 if (CONSP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 Lisp_Object cdr = XCDR (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 CHECK_INT (XCAR (value));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 CHECK_CHAR_COERCE_INT (cdr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 CHECK_INT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 case CHAR_TABLE_TYPE_CATEGORY:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 if (!ERRB_EQ (errb, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 return CATEGORY_TABLE_VALUEP (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 CHECK_CATEGORY_TABLE_VALUE (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 case CHAR_TABLE_TYPE_GENERIC:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
910 case CHAR_TABLE_TYPE_DISPLAY:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 /* #### fix this */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
912 maybe_signal_error (Qunimplemented,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
913 "Display char tables not yet implemented",
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
914 value, Qchar_table, errb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 case CHAR_TABLE_TYPE_CHAR:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 if (!ERRB_EQ (errb, ERROR_ME))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919 return CHAR_OR_CHAR_INTP (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920 CHECK_CHAR_COERCE_INT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926
801
2b676dc88c66 [xemacs-hg @ 2002-04-01 03:58:02 by ben]
ben
parents: 800
diff changeset
927 return 0; /* not (usually) reached */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933 switch (type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 case CHAR_TABLE_TYPE_SYNTAX:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 if (CONSP (value))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 Lisp_Object car = XCAR (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 Lisp_Object cdr = XCDR (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940 CHECK_CHAR_COERCE_INT (cdr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 return Fcons (car, cdr);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 case CHAR_TABLE_TYPE_CHAR:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945 CHECK_CHAR_COERCE_INT (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 return value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 (value, char_table_type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 enum char_table_type type = symbol_to_char_table_type (char_table_type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 (value, char_table_type))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 enum char_table_type type = symbol_to_char_table_type (char_table_type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 check_valid_char_table_value (value, type, ERROR_ME);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
974 /* Assign VAL to all characters in RANGE in char table TABLE. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 void
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
977 put_char_table (Lisp_Object table, struct chartab_range *range,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 Lisp_Object val)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
980 Lisp_Char_Table *ct = XCHAR_TABLE (table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
981
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 switch (range->type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 case CHARTAB_RANGE_ALL:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 fill_char_table (ct, val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 return; /* avoid the duplicate call to update_syntax_table() below,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 since fill_char_table() also did that. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 case CHARTAB_RANGE_CHARSET:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 if (EQ (range->charset, Vcharset_ascii))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 for (i = 0; i < 128; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 ct->ascii[i] = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 else if (EQ (range->charset, Vcharset_control_1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 for (i = 128; i < 160; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 ct->ascii[i] = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 ct->level1[lb] = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 case CHARTAB_RANGE_ROW:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1012 Lisp_Char_Table_Entry *cte;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 /* make sure that there is a separate entry for the row. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018 cte->level2[range->row - 32] = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 case CHARTAB_RANGE_CHAR:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026 Lisp_Object charset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 int byte1, byte2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1029 BREAKUP_EMCHAR (range->ch, charset, byte1, byte2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 if (EQ (charset, Vcharset_ascii))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 ct->ascii[byte1] = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 else if (EQ (charset, Vcharset_control_1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 ct->ascii[byte1 + 128] = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1036 Lisp_Char_Table_Entry *cte;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 /* make sure that there is a separate entry for the row. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039 if (!CHAR_TABLE_ENTRYP (ct->level1[lb]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 ct->level1[lb] = make_char_table_entry (ct->level1[lb]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 /* now CTE is a char table entry for the charset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 each entry is for a single row (or character of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 a one-octet charset). */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 if (XCHARSET_DIMENSION (charset) == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 cte->level2[byte1 - 32] = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 /* assigning to one character in a two-octet charset. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050 /* make sure that the charset row contains a separate
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 entry for each character. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32]))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 cte->level2[byte1 - 32] =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 make_char_table_entry (cte->level2[byte1 - 32]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 cte->level2[byte2 - 32] = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 #else /* not MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 ct->ascii[(unsigned char) (range->ch)] = val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 #endif /* not MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 if (ct->type == CHAR_TABLE_TYPE_SYNTAX)
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1067 update_syntax_table (wrap_char_table (ct));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1071 Set the value for chars in RANGE to be VALUE in CHAR-TABLE.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 RANGE specifies one or more characters to be affected and should be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 one of the following:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 -- t (all characters are affected)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 -- A charset (only allowed when Mule support is present)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 -- A vector of two elements: a two-octet charset and a row number
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 (only allowed when Mule support is present)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1080 -- A single character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1081
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1082 VALUE must be a value appropriate for the type of CHAR-TABLE.
800
a5954632b187 [xemacs-hg @ 2002-03-31 08:27:14 by ben]
ben
parents: 793
diff changeset
1083 See `make-char-table'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1084 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1085 (range, value, char_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1086 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1087 Lisp_Char_Table *ct;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1088 struct chartab_range rainj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1089
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1090 CHECK_CHAR_TABLE (char_table);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1091 ct = XCHAR_TABLE (char_table);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1092 check_valid_char_table_value (value, ct->type, ERROR_ME);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1093 decode_char_table_range (range, &rainj);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1094 value = canonicalize_char_table_value (value, ct->type);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1095 put_char_table (char_table, &rainj, value);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1096 return Qnil;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1097 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1098
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1099 DEFUN ("remove-char-table", Fremove_char_table, 2, 2, 0, /*
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1100 Remove any value from chars in RANGE in CHAR-TABLE.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1101
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1102 RANGE specifies one or more characters to be affected and should be
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1103 one of the following:
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1104
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1105 -- t (all characters are affected)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1106 -- A charset (only allowed when Mule support is present)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1107 -- A vector of two elements: a two-octet charset and a row number
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1108 (only allowed when Mule support is present)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1109 -- A single character
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1110
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1111 With the values removed, the default value will be returned.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1112 */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1113 (range, char_table))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1114 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1115 struct chartab_range rainj;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1116
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1117 CHECK_CHAR_TABLE (char_table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1118 decode_char_table_range (range, &rainj);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1119 put_char_table (char_table, &rainj, Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1120 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1121 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1123 /* Map FN over the ASCII chars in CT. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1125 static int
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1126 map_over_charset_ascii_1 (Lisp_Char_Table *ct,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1127 int start, int stop,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1128 int (*fn) (struct chartab_range *range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1129 Lisp_Object table, Lisp_Object val,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1130 void *arg),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1131 void *arg)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1132 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1133 struct chartab_range rainj;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1134 int i, retval;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1135
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1136 rainj.type = CHARTAB_RANGE_CHAR;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1137
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1138 for (i = start, retval = 0; i <= stop && retval == 0; i++)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1139 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1140 rainj.ch = (Emchar) i;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1141 if (!UNBOUNDP (ct->ascii[i]))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1142 retval = (fn) (&rainj, wrap_char_table (ct), ct->ascii[i], arg);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1143 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1144
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1145 return retval;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1146 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1147
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1148
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1149 /* Map FN over the ASCII chars in CT. */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1150
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1151 static int
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1152 map_over_charset_ascii (Lisp_Char_Table *ct,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1153 int (*fn) (struct chartab_range *range,
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1154 Lisp_Object table, Lisp_Object val,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1155 void *arg),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1156 void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1157 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1158 return map_over_charset_ascii_1 (ct, 0,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1159 #ifdef MULE
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1160 127,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1161 #else
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1162 255,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1163 #endif
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1164 fn, arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1165 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1166
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1167 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1169 /* Map FN over the Control-1 chars in CT. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1170
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1171 static int
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1172 map_over_charset_control_1 (Lisp_Char_Table *ct,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1173 int (*fn) (struct chartab_range *range,
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1174 Lisp_Object table, Lisp_Object val,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1175 void *arg),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1176 void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1177 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1178 return map_over_charset_ascii_1 (ct, 128, 159, fn, arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1179 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1180
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1181 /* Map FN over the row ROW of two-byte charset CHARSET.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1182 There must be a separate value for that row in the char table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1183 CTE specifies the char table entry for CHARSET. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1185 static int
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1186 map_over_charset_row (Lisp_Char_Table *ct,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1187 Lisp_Char_Table_Entry *cte,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1188 Lisp_Object charset, int row,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1189 int (*fn) (struct chartab_range *range,
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1190 Lisp_Object table, Lisp_Object val,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1191 void *arg),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1192 void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1193 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1194 Lisp_Object val = cte->level2[row - 32];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1195
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1196 if (UNBOUNDP (val))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1197 return 0;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1198 else if (!CHAR_TABLE_ENTRYP (val))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1199 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1200 struct chartab_range rainj;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1201
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1202 rainj.type = CHARTAB_RANGE_ROW;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1203 rainj.charset = charset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1204 rainj.row = row;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1205 return (fn) (&rainj, wrap_char_table (ct), val, arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1206 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1207 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1208 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1209 struct chartab_range rainj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1210 int i, retval;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1211 int start, stop;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1212
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1213 get_charset_limits (charset, &start, &stop);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1214
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1215 cte = XCHAR_TABLE_ENTRY (val);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1217 rainj.type = CHARTAB_RANGE_CHAR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1218
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1219 for (i = start, retval = 0; i <= stop && retval == 0; i++)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1220 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1221 rainj.ch = make_emchar (charset, row, i);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1222 if (!UNBOUNDP (cte->level2[i - 32]))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1223 retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32],
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1224 arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1225 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1226 return retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1227 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1228 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1229
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1230
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1231 static int
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1232 map_over_other_charset (Lisp_Char_Table *ct, int lb,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1233 int (*fn) (struct chartab_range *range,
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1234 Lisp_Object table, Lisp_Object val,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1235 void *arg),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1236 void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1237 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1238 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE];
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1239 Lisp_Object charset = charset_by_leading_byte (lb);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1240
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1241 if (!CHARSETP (charset)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1242 || lb == LEADING_BYTE_ASCII
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1243 || lb == LEADING_BYTE_CONTROL_1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1244 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1245
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1246 if (UNBOUNDP (val))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1247 return 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1248 if (!CHAR_TABLE_ENTRYP (val))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1249 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1250 struct chartab_range rainj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1251
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1252 rainj.type = CHARTAB_RANGE_CHARSET;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1253 rainj.charset = charset;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1254 return (fn) (&rainj, wrap_char_table (ct), val, arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1255 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1256 {
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
1257 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1258 int start, stop;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1259 int i, retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1260
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1261 get_charset_limits (charset, &start, &stop);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1262 if (XCHARSET_DIMENSION (charset) == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1263 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1264 struct chartab_range rainj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1265 rainj.type = CHARTAB_RANGE_CHAR;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1266
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1267 for (i = start, retval = 0; i <= stop && retval == 0; i++)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1268 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1269 rainj.ch = make_emchar (charset, i, 0);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1270 if (!UNBOUNDP (cte->level2[i - 32]))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1271 retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32],
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1272 arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1273 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1274 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1275 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1276 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1277 for (i = start, retval = 0; i <= stop && retval == 0; i++)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1278 retval = map_over_charset_row (ct, cte, charset, i, fn, arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1279 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1280
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1281 return retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1282 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1283 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1285 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1286
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1287 /* Map FN (with client data ARG) over range RANGE in char table CT.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1288 Mapping stops the first time FN returns non-zero, and that value
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1289 becomes the return value of map_char_table().
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1290
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1291 #### This mapping code is way ugly. The FSF version, in contrast,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1292 is short and sweet, and much more recursive. There should be some way
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1293 of cleaning this up. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1294
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1295 int
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1296 map_char_table (Lisp_Object table,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1297 struct chartab_range *range,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1298 int (*fn) (struct chartab_range *range,
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1299 Lisp_Object table, Lisp_Object val, void *arg),
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1300 void *arg)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1301 {
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1302 Lisp_Char_Table *ct = XCHAR_TABLE (table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1303 switch (range->type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1304 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1305 case CHARTAB_RANGE_ALL:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1306 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1307 int retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1308
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1309 retval = map_over_charset_ascii (ct, fn, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1310 if (retval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1311 return retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1312 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1313 retval = map_over_charset_control_1 (ct, fn, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1314 if (retval)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1315 return retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1316 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1317 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1318 int start = MIN_LEADING_BYTE;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1319 int stop = start + NUM_LEADING_BYTES;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1320
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1321 for (i = start, retval = 0; i < stop && retval == 0; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1322 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1323 if (i != LEADING_BYTE_ASCII && i != LEADING_BYTE_CONTROL_1)
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1324 retval = map_over_other_charset (ct, i, fn, arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1325 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1326 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1327 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1328 return retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1329 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1330
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1331 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1332 case CHARTAB_RANGE_CHARSET:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1333 return map_over_other_charset (ct,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1334 XCHARSET_LEADING_BYTE (range->charset),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1335 fn, arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1337 case CHARTAB_RANGE_ROW:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1338 {
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1339 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) -
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
1340 MIN_LEADING_BYTE];
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1341
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1342 if (CHAR_TABLE_ENTRYP (val))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1343 return map_over_charset_row (ct, XCHAR_TABLE_ENTRY (val),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1344 range->charset, range->row, fn, arg);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1345 else if (!UNBOUNDP (val))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1346 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1347 struct chartab_range rainj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1349 rainj.type = CHARTAB_RANGE_ROW;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1350 rainj.charset = range->charset;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1351 rainj.row = range->row;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1352 return (fn) (&rainj, table, val, arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1353 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1354 else
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1355 return 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1356 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1357 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1359 case CHARTAB_RANGE_CHAR:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1360 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1361 Emchar ch = range->ch;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1362 Lisp_Object val = get_char_table (ch, table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1363 struct chartab_range rainj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1364
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1365 if (!UNBOUNDP (val))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1366 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1367 rainj.type = CHARTAB_RANGE_CHAR;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1368 rainj.ch = ch;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1369 return (fn) (&rainj, table, val, arg);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1370 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1371 else
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1372 return 0;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1373 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1374
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1375 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1376 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1377 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1378
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1379 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1380 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1381
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1382 struct slow_map_char_table_arg
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1383 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1384 Lisp_Object function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1385 Lisp_Object retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1386 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1388 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1389 slow_map_char_table_fun (struct chartab_range *range,
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1390 Lisp_Object table, Lisp_Object val, void *arg)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1391 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1392 struct slow_map_char_table_arg *closure =
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1393 (struct slow_map_char_table_arg *) arg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1394
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1395 closure->retval = call2 (closure->function, encode_char_table_range (range),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1396 val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1397 return !NILP (closure->retval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1398 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1399
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1400 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1401 Map FUNCTION over entries in CHAR-TABLE, calling it with two args,
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1402 each key and value in the table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1403
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1404 RANGE specifies a subrange to map over and is in the same format as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1405 the RANGE argument to `put-range-table'. If omitted or t, it defaults to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1406 the entire table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1407 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1408 (function, char_table, range))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1409 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1410 struct slow_map_char_table_arg slarg;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1411 struct gcpro gcpro1, gcpro2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1412 struct chartab_range rainj;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1413
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1414 CHECK_CHAR_TABLE (char_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1415 if (NILP (range))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1416 range = Qt;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1417 decode_char_table_range (range, &rainj);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1418 slarg.function = function;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1419 slarg.retval = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1420 GCPRO2 (slarg.function, slarg.retval);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1421 map_char_table (char_table, &rainj, slow_map_char_table_fun, &slarg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1422 UNGCPRO;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1423
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1424 return slarg.retval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1425 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1426
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1427
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1429 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1430 /* Char table read syntax */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1431 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1433 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1434 chartab_type_validate (Lisp_Object keyword, Lisp_Object value,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
1435 Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1436 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1437 /* #### should deal with ERRB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1438 symbol_to_char_table_type (value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1439 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1440 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1441
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1442 /* #### Document the print/read format; esp. what's this cons element? */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1443
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1444 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1445 chartab_data_validate (Lisp_Object keyword, Lisp_Object value,
578
190b164ddcac [xemacs-hg @ 2001-05-25 11:26:50 by ben]
ben
parents: 563
diff changeset
1446 Error_Behavior errb)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1447 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1448 Lisp_Object rest;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1449
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1450 /* #### should deal with ERRB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1451 EXTERNAL_LIST_LOOP (rest, value)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1452 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1453 Lisp_Object range = XCAR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1454 struct chartab_range dummy;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1455
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1456 rest = XCDR (rest);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1457 if (!CONSP (rest))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1458 signal_error (Qlist_formation_error, "Invalid list format", value);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1459 if (CONSP (range))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1460 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1461 if (!CONSP (XCDR (range))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1462 || !NILP (XCDR (XCDR (range))))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1463 sferror ("Invalid range format", range);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1464 decode_char_table_range (XCAR (range), &dummy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1465 decode_char_table_range (XCAR (XCDR (range)), &dummy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1466 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1467 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1468 decode_char_table_range (range, &dummy);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1469 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1470
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1471 return 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1472 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1473
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1474 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1475 chartab_instantiate (Lisp_Object data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1476 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1477 Lisp_Object chartab;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1478 Lisp_Object type = Qgeneric;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1479 Lisp_Object dataval = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1480
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1481 while (!NILP (data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1482 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1483 Lisp_Object keyw = Fcar (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1484 Lisp_Object valw;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1485
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1486 data = Fcdr (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1487 valw = Fcar (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1488 data = Fcdr (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1489 if (EQ (keyw, Qtype))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1490 type = valw;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1491 else if (EQ (keyw, Qdata))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1492 dataval = valw;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1493 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1494
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1495 chartab = Fmake_char_table (type);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1496
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1497 data = dataval;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1498 while (!NILP (data))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1499 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1500 Lisp_Object range = Fcar (data);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1501 Lisp_Object val = Fcar (Fcdr (data));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1502
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1503 data = Fcdr (Fcdr (data));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1504 if (CONSP (range))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1505 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1506 if (CHAR_OR_CHAR_INTP (XCAR (range)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1507 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1508 Emchar first = XCHAR_OR_CHAR_INT (Fcar (range));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1509 Emchar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1510 Emchar i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1511
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1512 for (i = first; i <= last; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1513 Fput_char_table (make_char (i), val, chartab);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1514 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1515 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1516 abort ();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1517 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1518 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1519 Fput_char_table (range, val, chartab);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1520 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1521
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1522 return chartab;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1523 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1524
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1525 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1526
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1528 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1529 /* Category Tables, specifically */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1530 /************************************************************************/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1532 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1533 Return t if OBJECT is a category table.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1534 A category table is a type of char table used for keeping track of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1535 categories. Categories are used for classifying characters for use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1536 in regexps -- you can refer to a category rather than having to use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1537 a complicated [] expression (and category lookups are significantly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1538 faster).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1539
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1540 There are 95 different categories available, one for each printable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1541 character (including space) in the ASCII charset. Each category
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1542 is designated by one such character, called a "category designator".
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1543 They are specified in a regexp using the syntax "\\cX", where X is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1544 a category designator.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1545
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1546 A category table specifies, for each character, the categories that
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1547 the character is in. Note that a character can be in more than one
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1548 category. More specifically, a category table maps from a character
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1549 to either the value nil (meaning the character is in no categories)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1550 or a 95-element bit vector, specifying for each of the 95 categories
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1551 whether the character is in that category.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1552
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1553 Special Lisp functions are provided that abstract this, so you do not
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1554 have to directly manipulate bit vectors.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1555 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1556 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1557 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1558 return (CHAR_TABLEP (object) &&
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1559 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ?
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1560 Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1561 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1562
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1563 static Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1564 check_category_table (Lisp_Object object, Lisp_Object default_)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1565 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1566 if (NILP (object))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1567 object = default_;
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1568 while (NILP (Fcategory_table_p (object)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1569 object = wrong_type_argument (Qcategory_table_p, object);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1570 return object;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1571 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1573 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1574 check_category_char (Emchar ch, Lisp_Object table,
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
1575 int designator, int not_p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1576 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1577 REGISTER Lisp_Object temp;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1578 if (NILP (Fcategory_table_p (table)))
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1579 wtaerror ("Expected category table", table);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1580 temp = get_char_table (ch, table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1581 if (NILP (temp))
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
1582 return not_p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1583
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1584 designator -= ' ';
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
1585 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1586 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1587
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1588 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1589 Return t if category of the character at POSITION includes DESIGNATOR.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1590 Optional third arg BUFFER specifies which buffer to use, and defaults
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1591 to the current buffer.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1592 Optional fourth arg CATEGORY-TABLE specifies the category table to
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1593 use, and defaults to BUFFER's category table.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1594 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1595 (position, designator, buffer, category_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1596 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1597 Lisp_Object ctbl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1598 Emchar ch;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
1599 int des;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1600 struct buffer *buf = decode_buffer (buffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1601
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1602 CHECK_INT (position);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1603 CHECK_CATEGORY_DESIGNATOR (designator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1604 des = XCHAR (designator);
788
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
1605 ctbl = check_category_table (category_table, buf->category_table);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1606 ch = BUF_FETCH_CHAR (buf, XINT (position));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1607 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1608 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1609
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1610 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /*
788
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
1611 Return non-nil if category of CHARACTER includes DESIGNATOR.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1612 Optional third arg CATEGORY-TABLE specifies the category table to use,
788
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
1613 and defaults to the current buffer's category table.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1614 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1615 (character, designator, category_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1616 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1617 Lisp_Object ctbl;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1618 Emchar ch;
647
b39c14581166 [xemacs-hg @ 2001-08-13 04:45:47 by ben]
ben
parents: 578
diff changeset
1619 int des;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1621 CHECK_CATEGORY_DESIGNATOR (designator);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1622 des = XCHAR (designator);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1623 CHECK_CHAR (character);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1624 ch = XCHAR (character);
788
026c5bf9c134 [xemacs-hg @ 2002-03-21 07:29:57 by ben]
ben
parents: 771
diff changeset
1625 ctbl = check_category_table (category_table, current_buffer->category_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1626 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1627 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1628
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1629 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1630 Return BUFFER's current category table.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1631 BUFFER defaults to the current buffer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1632 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1633 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1634 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1635 return decode_buffer (buffer, 0)->category_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1636 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1637
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1638 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1639 Return the standard category table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1640 This is the one used for new buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1641 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1642 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1643 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1644 return Vstandard_category_table;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1645 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1646
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1647 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1648 Return a new category table which is a copy of CATEGORY-TABLE.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1649 CATEGORY-TABLE defaults to the standard category table.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1650 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1651 (category_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1652 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1653 if (NILP (Vstandard_category_table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1654 return Fmake_char_table (Qcategory);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1655
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1656 category_table =
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1657 check_category_table (category_table, Vstandard_category_table);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1658 return Fcopy_char_table (category_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1659 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1660
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1661 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1662 Select CATEGORY-TABLE as the new category table for BUFFER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1663 BUFFER defaults to the current buffer if omitted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1664 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1665 (category_table, buffer))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1666 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1667 struct buffer *buf = decode_buffer (buffer, 0);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1668 category_table = check_category_table (category_table, Qnil);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1669 buf->category_table = category_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1670 /* Indicate that this buffer now has a specified category table. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1671 buf->local_var_flags |= XINT (buffer_local_flags.category_table);
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1672 return category_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1673 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1674
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1675 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1676 Return t if OBJECT is a category designator (a char in the range ' ' to '~').
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1677 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1678 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1679 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1680 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1681 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1682
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1683 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1684 Return t if OBJECT is a category table value.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1685 Valid values are nil or a bit vector of size 95.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1686 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1687 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1688 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1689 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1690 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1691
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1692
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1693 #define CATEGORYP(x) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1694 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1695
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1696 #define CATEGORY_SET(c) get_char_table (c, current_buffer->category_table)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1698 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1699 The faster version of `!NILP (Faref (category_set, category))'. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1700 #define CATEGORY_MEMBER(category, category_set) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1701 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1702
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1703 /* Return 1 if there is a word boundary between two word-constituent
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1704 characters C1 and C2 if they appear in this order, else return 0.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1705 Use the macro WORD_BOUNDARY_P instead of calling this function
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1706 directly. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1708 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1709 word_boundary_p (Emchar c1, Emchar c2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1710 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1711 Lisp_Object category_set1, category_set2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1712 Lisp_Object tail;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1713 int default_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1714
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1715 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1716 if (COMPOSITE_CHAR_P (c1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1717 c1 = cmpchar_component (c1, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1718 if (COMPOSITE_CHAR_P (c2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1719 c2 = cmpchar_component (c2, 0, 1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1720 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1721
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1722 if (EQ (emchar_charset (c1), emchar_charset (c2)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1723 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1724 tail = Vword_separating_categories;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1725 default_result = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1726 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1727 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1728 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1729 tail = Vword_combining_categories;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1730 default_result = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1731 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1732
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1733 category_set1 = CATEGORY_SET (c1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1734 if (NILP (category_set1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1735 return default_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1736 category_set2 = CATEGORY_SET (c2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1737 if (NILP (category_set2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1738 return default_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1739
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1740 for (; CONSP (tail); tail = XCONS (tail)->cdr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1741 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1742 Lisp_Object elt = XCONS(tail)->car;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1743
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1744 if (CONSP (elt)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1745 && CATEGORYP (XCONS (elt)->car)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1746 && CATEGORYP (XCONS (elt)->cdr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1747 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->car), category_set1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1748 && CATEGORY_MEMBER (XCHAR (XCONS (elt)->cdr), category_set2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1749 return !default_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1750 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1751 return default_result;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1752 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1753 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1755
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1756 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1757 syms_of_chartab (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1758 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1759 INIT_LRECORD_IMPLEMENTATION (char_table);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1760
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1761 #ifdef MULE
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1762 INIT_LRECORD_IMPLEMENTATION (char_table_entry);
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
1763
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1764 DEFSYMBOL (Qcategory_table_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1765 DEFSYMBOL (Qcategory_designator_p);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1766 DEFSYMBOL (Qcategory_table_value_p);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1767 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1768
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1769 DEFSYMBOL (Qchar_table);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
1770 DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1771
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1772 DEFSUBR (Fchar_table_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1773 DEFSUBR (Fchar_table_type_list);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1774 DEFSUBR (Fvalid_char_table_type_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1775 DEFSUBR (Fchar_table_type);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1776 DEFSUBR (Fchar_table_default);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1777 DEFSUBR (Fset_char_table_default);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1778 DEFSUBR (Freset_char_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1779 DEFSUBR (Fmake_char_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1780 DEFSUBR (Fcopy_char_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1781 DEFSUBR (Fget_char_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1782 DEFSUBR (Fget_range_char_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1783 DEFSUBR (Fvalid_char_table_value_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1784 DEFSUBR (Fcheck_valid_char_table_value);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1785 DEFSUBR (Fput_char_table);
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 801
diff changeset
1786 DEFSUBR (Fremove_char_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1787 DEFSUBR (Fmap_char_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1789 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1790 DEFSUBR (Fcategory_table_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1791 DEFSUBR (Fcategory_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1792 DEFSUBR (Fstandard_category_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1793 DEFSUBR (Fcopy_category_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1794 DEFSUBR (Fset_category_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1795 DEFSUBR (Fcheck_category_at);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1796 DEFSUBR (Fchar_in_category_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1797 DEFSUBR (Fcategory_designator_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1798 DEFSUBR (Fcategory_table_value_p);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1799 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1801 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1802
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1803 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1804 vars_of_chartab (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1805 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1806 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1807 Vall_syntax_tables = Qnil;
452
3d3049ae1304 Import from CVS: tag r21-2-41
cvs
parents: 444
diff changeset
1808 dump_add_weak_object_chain (&Vall_syntax_tables);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1809 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1811 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1812 structure_type_create_chartab (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1813 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1814 struct structure_type *st;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1815
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1816 st = define_structure_type (Qchar_table, 0, chartab_instantiate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1818 define_structure_type_keyword (st, Qtype, chartab_type_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1819 define_structure_type_keyword (st, Qdata, chartab_data_validate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1820 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1821
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1822 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1823 complex_vars_of_chartab (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1824 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1825 #ifdef MULE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1826 /* Set this now, so first buffer creation can refer to it. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1827 /* Make it nil before calling copy-category-table
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1828 so that copy-category-table will know not to try to copy from garbage */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1829 Vstandard_category_table = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1830 Vstandard_category_table = Fcopy_category_table (Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1831 staticpro (&Vstandard_category_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1832
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1833 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1834 List of pair (cons) of categories to determine word boundary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1835
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1836 Emacs treats a sequence of word constituent characters as a single
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1837 word (i.e. finds no word boundary between them) iff they belongs to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1838 the same charset. But, exceptions are allowed in the following cases.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1839
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1840 \(1) The case that characters are in different charsets is controlled
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1841 by the variable `word-combining-categories'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1842
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1843 Emacs finds no word boundary between characters of different charsets
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1844 if they have categories matching some element of this list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1845
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1846 More precisely, if an element of this list is a cons of category CAT1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1847 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1848 C2 which has CAT2, there's no word boundary between C1 and C2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1849
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1850 For instance, to tell that ASCII characters and Latin-1 characters can
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1851 form a single word, the element `(?l . ?l)' should be in this list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1852 because both characters have the category `l' (Latin characters).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1853
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
1854 \(2) The case that character are in the same charset is controlled by
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1855 the variable `word-separating-categories'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1856
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1857 Emacs find a word boundary between characters of the same charset
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1858 if they have categories matching some element of this list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1859
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1860 More precisely, if an element of this list is a cons of category CAT1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1861 and CAT2, and a multibyte character C1 which has CAT1 is followed by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1862 C2 which has CAT2, there's a word boundary between C1 and C2.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1863
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1864 For instance, to tell that there's a word boundary between Japanese
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1865 Hiragana and Japanese Kanji (both are in the same charset), the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1866 element `(?H . ?C) should be in this list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1867 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1869 Vword_combining_categories = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1870
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1871 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1872 List of pair (cons) of categories to determine word boundary.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1873 See the documentation of the variable `word-combining-categories'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1874 */ );
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1875
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1876 Vword_separating_categories = Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1877 #endif /* MULE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1878 }