annotate src/casetab.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 a5954632b187
children 804517e16990
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* XEmacs routines to deal with case tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1987, 1992, 1993, 1994 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 Copyright (C) 1995 Sun Microsystems, Inc.
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
4 Copyright (C) 2002 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
23 /* Synched up with: FSF 19.28. Between FSF 19.28 and 19.30, casetab.c
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 was rewritten to use junky FSF char tables. Meanwhile I rewrote it
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
25 to use more logical char tables. --ben */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
27 /* Written by Howard Gayle. */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 /* Modified for Mule by Ben Wing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
31 /* The four tables in a case table are downcase, upcase, canon, and eqv.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
32 Each is a char-table. Their workings are rather non-obvious.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
33
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
34 (1) `downcase' is the only obvious table: Map a character to its
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
35 lowercase equivalent.
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
36
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
37 (2) `upcase' does *NOT* map a character to its uppercase equivalent,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
38 despite its name. Rather, it maps lowercase characters to their
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
39 uppercase equivalent, and uppercase characters to *ANYTHING BUT* their
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
40 uppercase equivalent (currently, their lowercase equivalent), and
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
41 characters without case to themselves. It is used to determine if a
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
42 character "has no case" (no uppercase or lowercase mapping). #### This
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
43 is way bogus. Just use the obvious implementation of uppercase mapping
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
44 and of NOCASE_P.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
45
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
46 (3) `canon' maps each character to a "canonical" lowercase, such that if
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
47 two different uppercase characters map to the same lowercase character,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
48 or vice versa, both characters will have the same entry in the canon
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
49 table.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
50
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
51 (4) `equiv' lists the "equivalence classes" defined by `canon'. Imagine
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
52 that all characters are divided into groups having the same `canon'
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
53 entry; these groups are called "equivalence classes" and `equiv' lists
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
54 them by linking the characters in each equivalence class together in a
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
55 circular list.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
56
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
57 `canon' is used when doing case-insensitive comparisons. `equiv' is
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
58 used in the Boyer-Moore search code.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
59 */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 #include "buffer.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 #include "opaque.h"
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
65 #include "chartab.h"
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
66 #include "casetab.h"
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
68 Lisp_Object Qcase_tablep, Qdowncase, Qupcase;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
69 Lisp_Object Vstandard_case_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
71 Lisp_Object case_table_char (Lisp_Object ch, Lisp_Object table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
73 #define STRING256_P(obj) ((STRINGP (obj) && string_char_length (obj) == 256))
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
74
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
75 static Lisp_Object
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
76 mark_case_table (Lisp_Object obj)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
77 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
78 Lisp_Case_Table *ct = XCASE_TABLE (obj);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
79
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
80 mark_object (CASE_TABLE_DOWNCASE (ct));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
81 mark_object (CASE_TABLE_UPCASE (ct));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
82 mark_object (CASE_TABLE_CANON (ct));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
83 mark_object (CASE_TABLE_EQV (ct));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
84 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
85 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
86
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
87 static void
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
88 print_case_table (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
89 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
90 Lisp_Case_Table *ct = XCASE_TABLE (obj);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
91 if (print_readably)
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
92 printing_unreadable_object ("#<case-table 0x%x>", ct->header.uid);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
93 write_fmt_string_lisp
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
94 (printcharfun, "#<case-table downcase=%s upcase=%s canon=%s eqv=%s ", 4,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
95 CASE_TABLE_DOWNCASE (ct), CASE_TABLE_UPCASE (ct),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
96 CASE_TABLE_CANON (ct), CASE_TABLE_EQV (ct));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
97 write_fmt_string (printcharfun, "0x%x>", ct->header.uid);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
98 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
99
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
100 static const struct lrecord_description case_table_description [] = {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
101 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, downcase_table) },
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
102 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, upcase_table) },
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
103 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_canon_table) },
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
104 { XD_LISP_OBJECT, offsetof (Lisp_Case_Table, case_eqv_table) },
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
105 { XD_END }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
106 };
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
107
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
108 DEFINE_LRECORD_IMPLEMENTATION ("case-table", case_table,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
109 mark_case_table, print_case_table, 0,
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
110 0, 0, case_table_description, Lisp_Case_Table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
111
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
112 static Lisp_Object
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
113 allocate_case_table (int init_tables)
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
114 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
115 Lisp_Case_Table *ct =
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
116 alloc_lcrecord_type (Lisp_Case_Table, &lrecord_case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
117
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
118 if (init_tables)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
119 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
120 SET_CASE_TABLE_DOWNCASE (ct, MAKE_TRT_TABLE ());
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
121 SET_CASE_TABLE_UPCASE (ct, MAKE_TRT_TABLE ());
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
122 SET_CASE_TABLE_CANON (ct, MAKE_TRT_TABLE ());
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
123 SET_CASE_TABLE_EQV (ct, MAKE_TRT_TABLE ());
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
124 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
125 else
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
126 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
127 SET_CASE_TABLE_DOWNCASE (ct, Qnil);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
128 SET_CASE_TABLE_UPCASE (ct, Qnil);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
129 SET_CASE_TABLE_CANON (ct, Qnil);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
130 SET_CASE_TABLE_EQV (ct, Qnil);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
131 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
132 return wrap_case_table (ct);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
133 }
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
134
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
135 DEFUN ("make-case-table", Fmake_case_table, 0, 0, 0, /*
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
136 Create a new, empty case table.
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
137 */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
138 ())
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
139 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
140 return allocate_case_table (1);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
141 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 DEFUN ("case-table-p", Fcase_table_p, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
144 Return t if OBJECT is a case table.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 See `set-case-table' for more information on these data structures.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
147 (object))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
149 if (CASE_TABLEP (object))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
150 return Qt;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
151 else
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
152 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
153 Lisp_Object down, up, canon, eqv;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
154 if (!CONSP (object))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
155 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
156 down = XCAR (object); object = XCDR (object);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
157 if (!CONSP (object))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
158 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
159 up = XCAR (object); object = XCDR (object);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
160 if (!CONSP (object))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
161 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
162 canon = XCAR (object); object = XCDR (object);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
163 if (!CONSP (object))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
164 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
165 eqv = XCAR (object);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
167 return ((STRING256_P (down)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
168 && (NILP (up) || STRING256_P (up))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
169 && ((NILP (canon) && NILP (eqv))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
170 || STRING256_P (canon))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
171 && (NILP (eqv) || STRING256_P (eqv)))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
172 ? Qt : Qnil);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
173
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
174 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 static Lisp_Object
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
178 check_case_table (Lisp_Object object)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
180 /* This function can GC */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
181 while (NILP (Fcase_table_p (object)))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
182 object = wrong_type_argument (Qcase_tablep, object);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
183 return object;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
186 Lisp_Object
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
187 case_table_char (Lisp_Object ch, Lisp_Object table)
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
188 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
189 Lisp_Object ct_char;
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
190 ct_char = get_char_table (XCHAR (ch), table);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
191 if (NILP (ct_char))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
192 return ch;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
193 else
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
194 return ct_char;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
195 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
196
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
197 DEFUN ("get-case-table", Fget_case_table, 3, 3, 0, /*
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
198 Return CHAR-CASE version of CHARACTER in CASE-TABLE.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
199
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
200 CHAR-CASE is either `downcase' or `upcase'.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
201 */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
202 (char_case, character, case_table))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
203 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
204 CHECK_CHAR (character);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
205 CHECK_CASE_TABLE (case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
206 if (EQ (char_case, Qdowncase))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
207 return case_table_char (character, XCASE_TABLE_DOWNCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
208 else if (EQ (char_case, Qupcase))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
209 return case_table_char (character, XCASE_TABLE_UPCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
210 else
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
211 invalid_constant ("Char case must be downcase or upcase", char_case);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
212
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
213 return Qnil; /* Not reached. */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
214 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
215
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
216 DEFUN ("put-case-table", Fput_case_table, 4, 4, 0, /*
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
217 Set CHAR-CASE version of CHARACTER to be VALUE in CASE-TABLE.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
218
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
219 CHAR-CASE is either `downcase' or `upcase'.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
220 See also `put-case-table-pair'.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
221 */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
222 (char_case, character, value, case_table))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
223 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
224 CHECK_CHAR (character);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
225 CHECK_CHAR (value);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
226
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
227 if (EQ (char_case, Qdowncase))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
228 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
229 Fput_char_table (character, value, XCASE_TABLE_DOWNCASE (case_table));
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
230 /* This one is not at all intuitive. See comment at top of file. */
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
231 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
232 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
233 else if (EQ (char_case, Qupcase))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
234 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
235 Fput_char_table (character, value, XCASE_TABLE_UPCASE (case_table));
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
236 Fput_char_table (character, character,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
237 XCASE_TABLE_DOWNCASE (case_table));
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
238 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
239 else
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
240 invalid_constant ("CHAR-CASE must be downcase or upcase", char_case);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
241
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
242 XCASE_TABLE (case_table)->dirty = 1;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
243 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
244 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
245
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
246 DEFUN ("put-case-table-pair", Fput_case_table_pair, 3, 3, 0, /*
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
247 Make UC and LC a pair of inter-case-converting letters in CASE-TABLE.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
248 UC is an uppercase character and LC is a downcase character.
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
249 */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
250 (uc, lc, case_table))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
251 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
252 CHECK_CHAR (uc);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
253 CHECK_CHAR (lc);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
254 CHECK_CASE_TABLE (case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
255
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
256 Fput_char_table (lc, lc, XCASE_TABLE_DOWNCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
257 Fput_char_table (uc, lc, XCASE_TABLE_UPCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
258 Fput_char_table (uc, lc, XCASE_TABLE_DOWNCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
259 Fput_char_table (lc, uc, XCASE_TABLE_UPCASE (case_table));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
260
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
261 XCASE_TABLE (case_table)->dirty = 1;
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
262 return Qnil;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
263 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
264
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
265 DEFUN ("copy-case-table", Fcopy_case_table, 1, 1, 0, /*
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
266 Return a new case table which is a copy of CASE-TABLE
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
267 */
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
268 (case_table))
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
269 {
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
270 Lisp_Object new_obj;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
271 CHECK_CASE_TABLE (case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
272
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
273 new_obj = allocate_case_table (0);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
274 XSET_CASE_TABLE_DOWNCASE
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
275 (new_obj, Fcopy_char_table (XCASE_TABLE_DOWNCASE (case_table)));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
276 XSET_CASE_TABLE_UPCASE
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
277 (new_obj, Fcopy_char_table (XCASE_TABLE_UPCASE (case_table)));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
278 XSET_CASE_TABLE_CANON
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
279 (new_obj, Fcopy_char_table (XCASE_TABLE_CANON (case_table)));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
280 XSET_CASE_TABLE_EQV
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
281 (new_obj, Fcopy_char_table (XCASE_TABLE_EQV (case_table)));
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
282 return new_obj;
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
283 }
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
284
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
285 static int
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
286 compute_canon_mapper (struct chartab_range *range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
287 Lisp_Object table, Lisp_Object val, void *arg)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
288 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
289 Lisp_Object casetab = VOID_TO_LISP (arg);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
290 if (range->type == CHARTAB_RANGE_CHAR)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
291 SET_TRT_TABLE_OF (XCASE_TABLE_CANON (casetab), range->ch,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
292 TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (casetab),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
293 TRT_TABLE_OF (XCASE_TABLE_UPCASE (casetab),
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
294 XCHAR (val))));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
295
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
296 return 0;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
297 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
298
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
299 static int
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
300 initialize_identity_mapper (struct chartab_range *range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
301 Lisp_Object table, Lisp_Object val, void *arg)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
302 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
303 Lisp_Object trt = VOID_TO_LISP (arg);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
304 if (range->type == CHARTAB_RANGE_CHAR)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
305 SET_TRT_TABLE_OF (trt, range->ch, range->ch);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
306
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
307 return 0;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
308 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
309
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
310 static int
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
311 compute_up_or_eqv_mapper (struct chartab_range *range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
312 Lisp_Object table, Lisp_Object val, void *arg)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
313 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
314 Lisp_Object inverse = VOID_TO_LISP (arg);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
315 Emchar toch = XCHAR (val);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
316
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
317 if (range->type == CHARTAB_RANGE_CHAR && range->ch != toch)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
318 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
319 Emchar c = TRT_TABLE_OF (inverse, toch);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
320 SET_TRT_TABLE_OF (inverse, toch, range->ch);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
321 SET_TRT_TABLE_OF (inverse, range->ch, c);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
322 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
323
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
324 return 0;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
325 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
326
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
327 /* Recomputing the canonical and equivalency tables from scratch is a
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
328 lengthy process, and doing them incrementally is extremely difficult or
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
329 perhaps impossible -- and certainly not worth it. To avoid lots of
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
330 excessive recomputation when lots of stuff is incrementally added, we
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
331 just store a dirty flag and then recompute when a value from the canon
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
332 or eqv tables is actually needed. */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
333
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
334 void
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
335 recompute_case_table (Lisp_Object casetab)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
336 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
337 struct chartab_range range;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
338
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
339 range.type = CHARTAB_RANGE_ALL;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
340 /* Turn off dirty flag first so we don't get infinite recursion when
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
341 retrieving the values below! */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
342 XCASE_TABLE (casetab)->dirty = 0;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
343 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
344 compute_canon_mapper, LISP_TO_VOID (casetab));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
345 map_char_table (XCASE_TABLE_CANON (casetab), &range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
346 initialize_identity_mapper,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
347 LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
348 map_char_table (XCASE_TABLE_CANON (casetab), &range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
349 compute_up_or_eqv_mapper,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
350 LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
351 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
352
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 DEFUN ("current-case-table", Fcurrent_case_table, 0, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 Return the case table of BUFFER, which defaults to the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 (buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358 struct buffer *buf = decode_buffer (buffer, 0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
360 return buf->case_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
361 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 DEFUN ("standard-case-table", Fstandard_case_table, 0, 0, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 Return the standard case table.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 This is the one used for new buffers.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 ())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
369 return Vstandard_case_table;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
372 static void
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
373 convert_old_style_syntax_string (Lisp_Object table, Lisp_Object string)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
374 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
375 Emchar i;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
376
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
377 for (i = 0; i < 256; i++)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
378 SET_TRT_TABLE_OF (table, i, string_emchar (string, i));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
379 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
380
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
381 static Lisp_Object
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
382 set_case_table (Lisp_Object table, int standard)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
383 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
384 /* This function can GC */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
385 struct buffer *buf =
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
386 standard ? XBUFFER (Vbuffer_defaults) : current_buffer;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
387
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
388 check_case_table (table);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
389
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
390 if (CASE_TABLEP (table))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
391 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
392 if (standard)
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
393 Vstandard_case_table = table;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
394
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
395 buf->case_table = table;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
396 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
397 else
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
398 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
399 /* For backward compatibility. */
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
400 Lisp_Object down, up, canon, eqv, tail = table;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
401 Lisp_Object casetab =
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
402 standard ? Vstandard_case_table : buf->case_table;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
403 struct chartab_range range;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
404
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
405 range.type = CHARTAB_RANGE_ALL;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
406
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
407 Freset_char_table (XCASE_TABLE_DOWNCASE (casetab));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
408 Freset_char_table (XCASE_TABLE_UPCASE (casetab));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
409 Freset_char_table (XCASE_TABLE_CANON (casetab));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
410 Freset_char_table (XCASE_TABLE_EQV (casetab));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
411
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
412 down = XCAR (tail); tail = XCDR (tail);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
413 up = XCAR (tail); tail = XCDR (tail);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
414 canon = XCAR (tail); tail = XCDR (tail);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
415 eqv = XCAR (tail);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
416
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
417 convert_old_style_syntax_string (XCASE_TABLE_DOWNCASE (casetab), down);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
418
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
419 if (NILP (up))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
420 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
421 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
422 initialize_identity_mapper,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
423 LISP_TO_VOID (XCASE_TABLE_UPCASE (casetab)));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
424 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
425 compute_up_or_eqv_mapper,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
426 LISP_TO_VOID (XCASE_TABLE_UPCASE (casetab)));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
427 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
428 else
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
429 convert_old_style_syntax_string (XCASE_TABLE_UPCASE (casetab), up);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
430
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
431 if (NILP (canon))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
432 map_char_table (XCASE_TABLE_DOWNCASE (casetab), &range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
433 compute_canon_mapper, LISP_TO_VOID (casetab));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
434 else
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
435 convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), canon);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
436
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
437 if (NILP (eqv))
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
438 {
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
439 map_char_table (XCASE_TABLE_CANON (casetab), &range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
440 initialize_identity_mapper,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
441 LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
442 map_char_table (XCASE_TABLE_CANON (casetab), &range,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
443 compute_up_or_eqv_mapper,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
444 LISP_TO_VOID (XCASE_TABLE_EQV (casetab)));
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
445 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
446 else
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
447 convert_old_style_syntax_string (XCASE_TABLE_CANON (casetab), eqv);
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
448 }
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
449
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
450 return buf->case_table;
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
451 }
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 DEFUN ("set-case-table", Fset_case_table, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
454 Select CASE-TABLE as the new case table for the current buffer.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
455 A case table is a case-table object or list
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
456 (DOWNCASE UPCASE CANONICALIZE EQUIVALENCES)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 where each element is either nil or a string of length 256.
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
458 The latter is provided for backward-compatibility.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 DOWNCASE maps each character to its lower-case equivalent.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 UPCASE maps each character to its upper-case equivalent;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 if lower and upper case characters are in 1-1 correspondence,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 you may use nil and the upcase table will be deduced from DOWNCASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 CANONICALIZE maps each character to a canonical equivalent;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 any two characters that are related by case-conversion have the same
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 canonical equivalent character; it may be nil, in which case it is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 deduced from DOWNCASE and UPCASE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 EQUIVALENCES is a map that cyclicly permutes each equivalence class
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (of characters with the same canonical equivalent); it may be nil,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 in which case it is deduced from CANONICALIZE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
471 See also `get-case-table', `put-case-table' and `put-case-table-pair'.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
473 (case_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
475 /* This function can GC */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
476 return set_case_table (case_table, 0);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 DEFUN ("set-standard-case-table", Fset_standard_case_table, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
480 Select CASE-TABLE as the new standard case table for new buffers.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 See `set-case-table' for more info on case tables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
483 (case_table))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
485 /* This function can GC */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
486 return set_case_table (case_table, 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 syms_of_casetab (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 {
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
493 INIT_LRECORD_IMPLEMENTATION (case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
494
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
495 DEFSYMBOL_MULTIWORD_PREDICATE (Qcase_tablep);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
496 DEFSYMBOL (Qdowncase);
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 446
diff changeset
497 DEFSYMBOL (Qupcase);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
499 DEFSUBR (Fmake_case_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 DEFSUBR (Fcase_table_p);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
501 DEFSUBR (Fget_case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
502 DEFSUBR (Fput_case_table);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
503 DEFSUBR (Fput_case_table_pair);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 DEFSUBR (Fcurrent_case_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 DEFSUBR (Fstandard_case_table);
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
506 DEFSUBR (Fcopy_case_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 DEFSUBR (Fset_case_table);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 DEFSUBR (Fset_standard_case_table);
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 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 complex_vars_of_casetab (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 REGISTER Emchar i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 444
diff changeset
516 staticpro (&Vstandard_case_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
518 Vstandard_case_table = allocate_case_table (1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 for (i = 0; i < 256; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 unsigned char lowered = tolower (i);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
524 SET_TRT_TABLE_OF (XCASE_TABLE_DOWNCASE (Vstandard_case_table), i,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
525 lowered);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 for (i = 0; i < 256; i++)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 unsigned char flipped = (isupper (i) ? tolower (i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 : (islower (i) ? toupper (i) : i));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
533 SET_TRT_TABLE_OF (XCASE_TABLE_UPCASE (Vstandard_case_table), i,
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
534 flipped);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 }
826
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
536
6728e641994e [xemacs-hg @ 2002-05-05 11:30:15 by ben]
ben
parents: 800
diff changeset
537 recompute_case_table (Vstandard_case_table);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 }