annotate src/casetab.c @ 853:2b6fa2618f76

[xemacs-hg @ 2002-05-28 08:44:22 by ben] merge my stderr-proc ws make-docfile.c: Fix places where we forget to check for EOF. code-init.el: Don't use CRLF conversion by default on process output. CMD.EXE and friends work both ways but Cygwin programs don't like the CRs. code-process.el, multicast.el, process.el: Removed. Improvements to call-process-internal: -- allows a buffer to be specified for input and stderr output -- use it on all systems -- implement C-g as documented -- clean up and comment call-process-region uses new call-process facilities; no temp file. remove duplicate funs in process.el. comment exactly how coding systems work and fix various problems. open-multicast-group now does similar coding-system frobbing to open-network-stream. dumped-lisp.el, faces.el, msw-faces.el: Fix some hidden errors due to code not being defined at the right time. xemacs.mak: Add -DSTRICT. ================================================================ ALLOW SEPARATION OF STDOUT AND STDERR IN PROCESSES ================================================================ Standard output and standard error can be processed separately in a process. Each can have its own buffer, its own mark in that buffer, and its filter function. You can specify a separate buffer for stderr in `start-process' to get things started, or use the new primitives: set-process-stderr-buffer process-stderr-buffer process-stderr-mark set-process-stderr-filter process-stderr-filter Also, process-send-region takes a 4th optional arg, a buffer. Currently always uses a pipe() under Unix to read the error output. (#### Would a PTY be better?) sysdep.h, sysproc.h, unexfreebsd.c, unexsunos4.c, nt.c, emacs.c, callproc.c, symsinit.h, sysdep.c, Makefile.in.in, process-unix.c: Delete callproc.c. Move child_setup() to process-unix.c. wait_for_termination() now only needed on a few really old systems. console-msw.h, event-Xt.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.h, process-nt.c, process-unix.c, process.c, process.h, procimpl.h: Rewrite the process methods to handle a separate channel for error input. Create Lstreams for reading in the error channel. Many process methods need change. In general the changes are fairly clear as they involve duplicating what's used for reading the normal stdout and changing for stderr -- although tedious, as such changes are required throughout the entire process code. Rewrote the code that reads process output to do two loops, one for stdout and one for stderr. gpmevent.c, tooltalk.c: set_process_filter takes an argument for stderr. ================================================================ NEW ERROR-TRAPPING MECHANISM ================================================================ Totally rewrite error trapping code to be unified and support more features. Basic function is call_trapping_problems(), which lets you specify, by means of flags, what sorts of problems you want trapped. these can include -- quit -- errors -- throws past the function -- creation of "display objects" (e.g. buffers) -- deletion of already-existing "display objects" (e.g. buffers) -- modification of already-existing buffers -- entering the debugger -- gc -- errors->warnings (ala suspended errors) etc. All other error funs rewritten in terms of this one. Various older mechanisms removed or rewritten. window.c, insdel.c, console.c, buffer.c, device.c, frame.c: When creating a display object, added call to note_object_created(), for use with trapping_problems mechanism. When deleting, call check_allowed_operation() and note_object deleted(). The trapping-problems code records the objects created since the call-trapping-problems began. Those objects can be deleted, but none others (i.e. previously existing ones). bytecode.c, cmdloop.c: internal_catch takes another arg. eval.c: Add long comments describing the "five lists" used to maintain state (backtrace, gcpro, specbind, etc.) in the Lisp engine. backtrace.h, eval.c: Implement trapping-problems mechanism, eliminate old mechanisms or redo in terms of new one. frame.c, gutter.c: Flush out the concept of "critical display section", defined by the in_display() var. Use an internal_bind() to get it reset, rather than just doing it at end, because there may be a non-local exit. event-msw.c, event-stream.c, console-msw.h, device.c, dialog-msw.c, frame.c, frame.h, intl.c, toolbar.c, menubar-msw.c, redisplay.c, alloc.c, menubar-x.c: Make use of new trapping-errors stuff and rewrite code based on old mechanisms. glyphs-widget.c, redisplay.h: Protect calling Lisp in redisplay. insdel.c: Protect hooks against deleting existing buffers. frame-msw.c: Use EQ, not EQUAL in hash tables whose keys are just numbers. Otherwise we run into stickiness in redisplay because internal_equal() can QUIT. ================================================================ SIGNAL, C-G CHANGES ================================================================ Here we change the way that C-g interacts with event reading. The idea is that a C-g occurring while we're reading a user event should be read as C-g, but elsewhere should be a QUIT. The former code did all sorts of bizarreness -- requiring that no QUIT occurs anywhere in event-reading code (impossible to enforce given the stuff called or Lisp code invoked), and having some weird system involving enqueue/dequeue of a C-g and interaction with Vquit_flag -- and it didn't work. Now, we simply enclose all code where we want C-g read as an event with {begin/end}_dont_check_for_quit(). This completely turns off the mechanism that checks (and may remove or alter) C-g in the read-ahead queues, so we just get the C-g normal. Signal.c documents this very carefully. cmdloop.c: Correct use of dont_check_for_quit to new scheme, remove old out-of-date comments. event-stream.c: Fix C-g handling to actually work. device-x.c: Disable quit checking when err out. signal.c: Cleanup. Add large descriptive comment. process-unix.c, process-nt.c, sysdep.c: Use QUIT instead of REALLY_QUIT. It's not necessary to use REALLY_QUIT and just confuses the issue. lisp.h: Comment quit handlers. ================================================================ CONS CHANGES ================================================================ free_cons() now takes a Lisp_Object not the result of XCONS(). car and cdr have been renamed so that they don't get used directly; go through XCAR(), XCDR() instead. alloc.c, dired.c, editfns.c, emodules.c, fns.c, glyphs-msw.c, glyphs-x.c, glyphs.c, keymap.c, minibuf.c, search.c, eval.c, lread.c, lisp.h: Correct free_cons calling convention: now takes Lisp_Object, not Lisp_Cons chartab.c: Eliminate direct use of ->car, ->cdr, should be black box. callint.c: Rewrote using EXTERNAL_LIST_LOOP to avoid use of Lisp_Cons. ================================================================ USE INTERNAL-BIND-* ================================================================ eval.c: Cleanups of these funs. alloc.c, fileio.c, undo.c, specifier.c, text.c, profile.c, lread.c, redisplay.c, menubar-x.c, macros.c: Rewrote to use internal_bind_int() and internal_bind_lisp_object() in place of whatever varied and cumbersome mechanisms were formerly there. ================================================================ SPECBIND SANITY ================================================================ backtrace.h: - Improved comments backtrace.h, bytecode.c, eval.c: Add new mechanism check_specbind_stack_sanity() for sanity checking code each time the catchlist or specbind stack change. Removed older prototype of same mechanism. ================================================================ MISC ================================================================ lisp.h, insdel.c, window.c, device.c, console.c, buffer.c: Fleshed out authorship. device-msw.c: Correct bad Unicode-ization. print.c: Be more careful when not initialized or in fatal error handling. search.c: Eliminate running_asynch_code, an FSF holdover. alloc.c: Added comments about gc-cons-threshold. dialog-x.c: Use begin_gc_forbidden() around code to build up a widget value tree, like in menubar-x.c. gui.c: Use Qunbound not Qnil as the default for gethash. lisp-disunion.h, lisp-union.h: Added warnings on use of VOID_TO_LISP(). lisp.h: Use ERROR_CHECK_STRUCTURES to turn on ERROR_CHECK_TRAPPING_PROBLEMS and ERROR_CHECK_TYPECHECK lisp.h: Add assert_with_message. lisp.h: Add macros for gcproing entire arrays. (You could do this before but it required manual twiddling the gcpro structure.) lisp.h: Add prototypes for new functions defined elsewhere.
author ben
date Tue, 28 May 2002 08:45:36 +0000
parents 6728e641994e
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 }