Mercurial > hg > xemacs-beta
annotate src/chartab.c @ 5366:f00192e1cd49
Examining the result of #'length: `eql', not `=', it's better style & cheaper
2011-03-08 Aidan Kehoe <kehoea@parhasard.net>
* buff-menu.el (list-buffers-noselect):
* byte-optimize.el (byte-optimize-identity):
* byte-optimize.el (byte-optimize-if):
* byte-optimize.el (byte-optimize-nth):
* byte-optimize.el (byte-optimize-nthcdr):
* bytecomp.el (byte-compile-warn-wrong-args):
* bytecomp.el (byte-compile-two-args-19->20):
* bytecomp.el (byte-compile-list):
* bytecomp.el (byte-compile-beginning-of-line):
* bytecomp.el (byte-compile-set):
* bytecomp.el (byte-compile-set-default):
* bytecomp.el (byte-compile-values):
* bytecomp.el (byte-compile-values-list):
* bytecomp.el (byte-compile-integerp):
* bytecomp.el (byte-compile-multiple-value-list-internal):
* bytecomp.el (byte-compile-throw):
* cl-macs.el (cl-do-arglist):
* cl-macs.el (cl-parse-loop-clause):
* cl-macs.el (multiple-value-bind):
* cl-macs.el (multiple-value-setq):
* cl-macs.el (get-setf-method):
* cmdloop.el (command-error):
* cmdloop.el (y-or-n-p-minibuf):
* cmdloop.el (yes-or-no-p-minibuf):
* coding.el (unencodable-char-position):
* cus-edit.el (custom-face-prompt):
* cus-edit.el (custom-buffer-create-internal):
* cus-edit.el (widget-face-action):
* cus-edit.el (custom-group-value-create):
* descr-text.el (describe-char-unicode-data):
* dialog-gtk.el (popup-builtin-question-dialog):
* dragdrop.el (experimental-dragdrop-drop-log-function):
* dragdrop.el (experimental-dragdrop-drop-mime-default):
* easymenu.el (easy-menu-add):
* easymenu.el (easy-menu-remove):
* faces.el (read-face-name):
* faces.el (set-face-stipple):
* files.el (file-name-non-special):
* font.el (font-combine-fonts):
* font.el (font-set-face-font):
* font.el (font-parse-rgb-components):
* font.el (font-rgb-color-p):
* font.el (font-color-rgb-components):
* gnuserv.el (gnuserv-edit-files):
* help.el (key-or-menu-binding):
* help.el (function-documentation-1):
* help.el (function-documentation):
* info.el (info):
* isearch-mode.el (isearch-exit):
* isearch-mode.el (isearch-edit-string):
* isearch-mode.el (isearch-*-char):
* isearch-mode.el (isearch-complete1):
* ldap.el (ldap-encode-country-string):
* ldap.el (ldap-decode-string):
* minibuf.el (read-file-name-internal-1):
* minibuf.el (read-non-nil-coding-system):
* minibuf.el (get-user-response):
* mouse.el (drag-window-divider):
* mule/ccl.el:
* mule/ccl.el (ccl-compile-if):
* mule/ccl.el (ccl-compile-break):
* mule/ccl.el (ccl-compile-repeat):
* mule/ccl.el (ccl-compile-write-repeat):
* mule/ccl.el (ccl-compile-call):
* mule/ccl.el (ccl-compile-end):
* mule/ccl.el (ccl-compile-read-multibyte-character):
* mule/ccl.el (ccl-compile-write-multibyte-character):
* mule/ccl.el (ccl-compile-translate-character):
* mule/ccl.el (ccl-compile-mule-to-unicode):
* mule/ccl.el (ccl-compile-unicode-to-mule):
* mule/ccl.el (ccl-compile-lookup-integer):
* mule/ccl.el (ccl-compile-lookup-character):
* mule/ccl.el (ccl-compile-map-multiple):
* mule/ccl.el (ccl-compile-map-single):
* mule/devan-util.el (devanagari-compose-to-one-glyph):
* mule/devan-util.el (devanagari-composition-component):
* mule/mule-cmds.el (finish-set-language-environment):
* mule/viet-util.el:
* mule/viet-util.el (viet-encode-viscii-char):
* multicast.el (open-multicast-group):
* newcomment.el (comment-quote-nested):
* newcomment.el (comment-region):
* newcomment.el (comment-dwim):
* regexp-opt.el (regexp-opt-group):
* replace.el (map-query-replace-regexp):
* specifier.el (derive-device-type-from-tag-set):
* subr.el (skip-chars-quote):
* test-harness.el (test-harness-from-buffer):
* test-harness.el (batch-test-emacs):
* wid-edit.el (widget-choice-action):
* wid-edit.el (widget-symbol-prompt-internal):
* wid-edit.el (widget-color-action):
* window-xemacs.el (push-window-configuration):
* window-xemacs.el (pop-window-configuration):
* window.el (quit-window):
* x-compose.el (electric-diacritic):
It's better style, and cheaper (often one assembler instruction
vs. a C funcall in the byte code), to use `eql' instead of `='
when it's clear what numerical type a given result will be. Change
much of our code to do this, with the help of a byte-compiler
change (not comitted) that looked for calls to #'length (which
always returns an integer) in its args.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Tue, 08 Mar 2011 23:41:52 +0000 |
| parents | 31be2a3d121d |
| children | 6506fcb40fcf |
| rev | line source |
|---|---|
| 428 | 1 /* XEmacs routines to deal with char tables. |
| 2 Copyright (C) 1992, 1995 Free Software Foundation, Inc. | |
| 3 Copyright (C) 1995 Sun Microsystems, Inc. | |
| 1296 | 4 Copyright (C) 1995, 1996, 2002, 2003 Ben Wing. |
| 428 | 5 Copyright (C) 1995, 1997, 1999 Electrotechnical Laboratory, JAPAN. |
| 6 Licensed to the Free Software Foundation. | |
| 7 | |
| 8 This file is part of XEmacs. | |
| 9 | |
| 10 XEmacs is free software; you can redistribute it and/or modify it | |
| 11 under the terms of the GNU General Public License as published by the | |
| 12 Free Software Foundation; either version 2, or (at your option) any | |
| 13 later version. | |
| 14 | |
| 15 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 16 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 17 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 18 for more details. | |
| 19 | |
| 20 You should have received a copy of the GNU General Public License | |
| 21 along with XEmacs; see the file COPYING. If not, write to | |
| 22 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 23 Boston, MA 02111-1307, USA. */ | |
| 24 | |
| 25 /* Synched up with: Mule 2.3. Not synched with FSF. | |
| 26 | |
| 27 This file was written independently of the FSF implementation, | |
| 28 and is not compatible. */ | |
| 29 | |
| 30 /* Authorship: | |
| 31 | |
| 32 Ben Wing: wrote, for 19.13 (Mule). Some category table stuff | |
| 33 loosely based on the original Mule. | |
| 34 Jareth Hein: fixed a couple of bugs in the implementation, and | |
| 35 added regex support for categories with check_category_at | |
| 36 */ | |
| 37 | |
| 38 #include <config.h> | |
| 39 #include "lisp.h" | |
| 40 | |
| 41 #include "buffer.h" | |
| 42 #include "chartab.h" | |
| 43 #include "syntax.h" | |
| 44 | |
|
5320
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
45 Lisp_Object Qchar_tablep, Qchar_table; |
| 428 | 46 |
| 47 Lisp_Object Vall_syntax_tables; | |
| 48 | |
| 49 #ifdef MULE | |
| 50 Lisp_Object Qcategory_table_p; | |
| 51 Lisp_Object Qcategory_designator_p; | |
| 52 Lisp_Object Qcategory_table_value_p; | |
| 53 | |
| 54 Lisp_Object Vstandard_category_table; | |
| 55 | |
| 56 /* Variables to determine word boundary. */ | |
| 57 Lisp_Object Vword_combining_categories, Vword_separating_categories; | |
| 58 #endif /* MULE */ | |
| 59 | |
| 826 | 60 static int check_valid_char_table_value (Lisp_Object value, |
| 61 enum char_table_type type, | |
| 62 Error_Behavior errb); | |
| 63 | |
| 428 | 64 |
| 65 /* A char table maps from ranges of characters to values. | |
| 66 | |
| 67 Implementing a general data structure that maps from arbitrary | |
| 68 ranges of numbers to values is tricky to do efficiently. As it | |
| 69 happens, it should suffice (and is usually more convenient, anyway) | |
| 70 when dealing with characters to restrict the sorts of ranges that | |
| 71 can be assigned values, as follows: | |
| 72 | |
| 73 1) All characters. | |
| 74 2) All characters in a charset. | |
| 75 3) All characters in a particular row of a charset, where a "row" | |
| 76 means all characters with the same first byte. | |
| 77 4) A particular character in a charset. | |
| 78 | |
| 79 We use char tables to generalize the 256-element vectors now | |
| 80 littering the Emacs code. | |
| 81 | |
| 82 Possible uses (all should be converted at some point): | |
| 83 | |
| 84 1) category tables | |
| 85 2) syntax tables | |
| 86 3) display tables | |
| 87 4) case tables | |
| 88 5) keyboard-translate-table? | |
| 89 | |
| 90 We provide an | |
| 91 abstract type to generalize the Emacs vectors and Mule | |
| 92 vectors-of-vectors goo. | |
| 93 */ | |
| 94 | |
| 95 /************************************************************************/ | |
| 96 /* Char Table object */ | |
| 97 /************************************************************************/ | |
| 98 | |
| 99 #ifdef MULE | |
| 100 | |
| 101 static Lisp_Object | |
| 102 mark_char_table_entry (Lisp_Object obj) | |
| 103 { | |
| 440 | 104 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); |
| 428 | 105 int i; |
| 106 | |
| 107 for (i = 0; i < 96; i++) | |
| 108 { | |
| 109 mark_object (cte->level2[i]); | |
| 110 } | |
| 111 return Qnil; | |
| 112 } | |
| 113 | |
| 114 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
115 char_table_entry_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
116 int foldcase) |
| 428 | 117 { |
| 440 | 118 Lisp_Char_Table_Entry *cte1 = XCHAR_TABLE_ENTRY (obj1); |
| 119 Lisp_Char_Table_Entry *cte2 = XCHAR_TABLE_ENTRY (obj2); | |
| 428 | 120 int i; |
| 121 | |
| 122 for (i = 0; i < 96; i++) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
123 if (!internal_equal_0 (cte1->level2[i], cte2->level2[i], depth + 1, |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
124 foldcase)) |
| 428 | 125 return 0; |
| 126 | |
| 127 return 1; | |
| 128 } | |
| 129 | |
| 665 | 130 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
131 char_table_entry_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 428 | 132 { |
| 440 | 133 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); |
| 428 | 134 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
135 return internal_array_hash (cte->level2, 96, depth + 1, equalp); |
| 428 | 136 } |
| 137 | |
| 1204 | 138 static const struct memory_description char_table_entry_description[] = { |
| 440 | 139 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table_Entry, level2), 96 }, |
| 428 | 140 { XD_END } |
| 141 }; | |
| 142 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
143 DEFINE_DUMPABLE_LISP_OBJECT ("char-table-entry", char_table_entry, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5120
diff
changeset
|
144 mark_char_table_entry, internal_object_printer, |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
145 0, char_table_entry_equal, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
146 char_table_entry_hash, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
147 char_table_entry_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
148 Lisp_Char_Table_Entry); |
| 934 | 149 |
| 428 | 150 #endif /* MULE */ |
| 151 | |
| 152 static Lisp_Object | |
| 153 mark_char_table (Lisp_Object obj) | |
| 154 { | |
| 440 | 155 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 428 | 156 int i; |
| 157 | |
| 158 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
| 159 mark_object (ct->ascii[i]); | |
| 160 #ifdef MULE | |
| 161 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 162 mark_object (ct->level1[i]); | |
| 163 #endif | |
| 793 | 164 mark_object (ct->parent); |
| 165 mark_object (ct->default_); | |
| 428 | 166 return ct->mirror_table; |
| 167 } | |
| 168 | |
| 169 /* WARNING: All functions of this nature need to be written extremely | |
| 170 carefully to avoid crashes during GC. Cf. prune_specifiers() | |
| 171 and prune_weak_hash_tables(). */ | |
| 172 | |
| 173 void | |
| 174 prune_syntax_tables (void) | |
| 175 { | |
| 176 Lisp_Object rest, prev = Qnil; | |
| 177 | |
| 178 for (rest = Vall_syntax_tables; | |
| 179 !NILP (rest); | |
| 180 rest = XCHAR_TABLE (rest)->next_table) | |
| 181 { | |
| 182 if (! marked_p (rest)) | |
| 183 { | |
| 184 /* This table is garbage. Remove it from the list. */ | |
| 185 if (NILP (prev)) | |
| 186 Vall_syntax_tables = XCHAR_TABLE (rest)->next_table; | |
| 187 else | |
| 188 XCHAR_TABLE (prev)->next_table = | |
| 189 XCHAR_TABLE (rest)->next_table; | |
| 190 } | |
| 191 } | |
| 192 } | |
| 193 | |
| 194 static Lisp_Object | |
| 195 char_table_type_to_symbol (enum char_table_type type) | |
| 196 { | |
| 197 switch (type) | |
| 198 { | |
| 2500 | 199 default: ABORT(); |
| 428 | 200 case CHAR_TABLE_TYPE_GENERIC: return Qgeneric; |
| 201 case CHAR_TABLE_TYPE_SYNTAX: return Qsyntax; | |
| 202 case CHAR_TABLE_TYPE_DISPLAY: return Qdisplay; | |
| 203 case CHAR_TABLE_TYPE_CHAR: return Qchar; | |
| 204 #ifdef MULE | |
| 205 case CHAR_TABLE_TYPE_CATEGORY: return Qcategory; | |
| 206 #endif | |
| 207 } | |
| 208 } | |
| 209 | |
| 210 static enum char_table_type | |
| 211 symbol_to_char_table_type (Lisp_Object symbol) | |
| 212 { | |
| 213 CHECK_SYMBOL (symbol); | |
| 214 | |
| 215 if (EQ (symbol, Qgeneric)) return CHAR_TABLE_TYPE_GENERIC; | |
| 216 if (EQ (symbol, Qsyntax)) return CHAR_TABLE_TYPE_SYNTAX; | |
| 217 if (EQ (symbol, Qdisplay)) return CHAR_TABLE_TYPE_DISPLAY; | |
| 218 if (EQ (symbol, Qchar)) return CHAR_TABLE_TYPE_CHAR; | |
| 219 #ifdef MULE | |
| 220 if (EQ (symbol, Qcategory)) return CHAR_TABLE_TYPE_CATEGORY; | |
| 221 #endif | |
| 222 | |
| 563 | 223 invalid_constant ("Unrecognized char table type", symbol); |
| 1204 | 224 RETURN_NOT_REACHED (CHAR_TABLE_TYPE_GENERIC); |
| 428 | 225 } |
| 226 | |
| 227 static void | |
| 826 | 228 decode_char_table_range (Lisp_Object range, struct chartab_range *outrange) |
| 428 | 229 { |
| 4932 | 230 xzero (*outrange); |
| 826 | 231 if (EQ (range, Qt)) |
| 232 outrange->type = CHARTAB_RANGE_ALL; | |
| 233 else if (CHAR_OR_CHAR_INTP (range)) | |
| 234 { | |
| 235 outrange->type = CHARTAB_RANGE_CHAR; | |
| 236 outrange->ch = XCHAR_OR_CHAR_INT (range); | |
| 237 } | |
| 238 #ifndef MULE | |
| 428 | 239 else |
| 826 | 240 sferror ("Range must be t or a character", range); |
| 241 #else /* MULE */ | |
| 242 else if (VECTORP (range)) | |
| 243 { | |
| 244 Lisp_Vector *vec = XVECTOR (range); | |
| 245 Lisp_Object *elts = vector_data (vec); | |
| 246 if (vector_length (vec) != 2) | |
| 247 sferror ("Length of charset row vector must be 2", | |
| 248 range); | |
| 249 outrange->type = CHARTAB_RANGE_ROW; | |
| 250 outrange->charset = Fget_charset (elts[0]); | |
| 251 CHECK_INT (elts[1]); | |
| 252 outrange->row = XINT (elts[1]); | |
| 253 switch (XCHARSET_TYPE (outrange->charset)) | |
| 254 { | |
| 255 case CHARSET_TYPE_94: | |
| 256 case CHARSET_TYPE_96: | |
| 257 sferror ("Charset in row vector must be multi-byte", | |
| 258 outrange->charset); | |
| 259 case CHARSET_TYPE_94X94: | |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5259
diff
changeset
|
260 check_integer_range (make_int (outrange->row), make_int (33), |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5259
diff
changeset
|
261 make_int (126)); |
| 826 | 262 break; |
| 263 case CHARSET_TYPE_96X96: | |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5259
diff
changeset
|
264 check_integer_range (make_int (outrange->row), make_int (32), |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5259
diff
changeset
|
265 make_int (127)); |
| 826 | 266 break; |
| 267 default: | |
| 2500 | 268 ABORT (); |
| 826 | 269 } |
| 270 } | |
| 271 else | |
| 272 { | |
| 273 if (!CHARSETP (range) && !SYMBOLP (range)) | |
| 274 sferror | |
| 275 ("Char table range must be t, charset, char, or vector", range); | |
| 276 outrange->type = CHARTAB_RANGE_CHARSET; | |
| 277 outrange->charset = Fget_charset (range); | |
| 278 } | |
| 279 #endif /* MULE */ | |
| 428 | 280 } |
| 281 | |
| 826 | 282 static Lisp_Object |
| 283 encode_char_table_range (struct chartab_range *range) | |
| 428 | 284 { |
| 826 | 285 switch (range->type) |
| 428 | 286 { |
| 826 | 287 case CHARTAB_RANGE_ALL: |
| 288 return Qt; | |
| 289 | |
| 290 #ifdef MULE | |
| 291 case CHARTAB_RANGE_CHARSET: | |
| 292 return XCHARSET_NAME (Fget_charset (range->charset)); | |
| 428 | 293 |
| 826 | 294 case CHARTAB_RANGE_ROW: |
| 295 return vector2 (XCHARSET_NAME (Fget_charset (range->charset)), | |
| 296 make_int (range->row)); | |
| 297 #endif | |
| 298 case CHARTAB_RANGE_CHAR: | |
| 299 return make_char (range->ch); | |
| 300 default: | |
| 2500 | 301 ABORT (); |
| 428 | 302 } |
| 826 | 303 return Qnil; /* not reached */ |
| 428 | 304 } |
| 305 | |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
306 static Lisp_Object |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
307 char_table_default_for_type (enum char_table_type type) |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
308 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
309 switch (type) |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
310 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
311 case CHAR_TABLE_TYPE_CHAR: |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
312 return make_char (0); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
313 break; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
314 case CHAR_TABLE_TYPE_DISPLAY: |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
315 case CHAR_TABLE_TYPE_GENERIC: |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
316 #ifdef MULE |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
317 case CHAR_TABLE_TYPE_CATEGORY: |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
318 #endif /* MULE */ |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
319 return Qnil; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
320 break; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
321 |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
322 case CHAR_TABLE_TYPE_SYNTAX: |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
323 return make_integer (Sinherit); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
324 break; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
325 } |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
326 ABORT(); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
327 return Qzero; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
328 } |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
329 |
| 826 | 330 struct ptemap |
| 428 | 331 { |
| 826 | 332 Lisp_Object printcharfun; |
| 333 int first; | |
| 334 }; | |
| 428 | 335 |
| 826 | 336 static int |
| 2286 | 337 print_table_entry (struct chartab_range *range, Lisp_Object UNUSED (table), |
| 826 | 338 Lisp_Object val, void *arg) |
| 339 { | |
| 340 struct ptemap *a = (struct ptemap *) arg; | |
| 341 struct gcpro gcpro1; | |
| 342 Lisp_Object lisprange; | |
| 343 if (!a->first) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
344 write_ascstring (a->printcharfun, " "); |
| 826 | 345 a->first = 0; |
| 346 lisprange = encode_char_table_range (range); | |
| 347 GCPRO1 (lisprange); | |
|
4580
1d11ecca9cd0
Print char table values correctly.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4469
diff
changeset
|
348 write_fmt_string_lisp (a->printcharfun, "%s %S", 2, lisprange, val); |
| 826 | 349 UNGCPRO; |
| 350 return 0; | |
| 428 | 351 } |
| 352 | |
| 353 static void | |
| 2286 | 354 print_char_table (Lisp_Object obj, Lisp_Object printcharfun, |
| 355 int UNUSED (escapeflag)) | |
| 428 | 356 { |
| 440 | 357 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 826 | 358 struct chartab_range range; |
| 359 struct ptemap arg; | |
| 360 | |
| 361 range.type = CHARTAB_RANGE_ALL; | |
| 362 arg.printcharfun = printcharfun; | |
| 363 arg.first = 1; | |
| 428 | 364 |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
365 write_fmt_string_lisp (printcharfun, |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
366 "#s(char-table :type %s", 1, |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
367 char_table_type_to_symbol (ct->type)); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
368 if (!(EQ (ct->default_, char_table_default_for_type (ct->type)))) |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
369 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
370 write_fmt_string_lisp (printcharfun, " :default %S", 1, ct->default_); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
371 } |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
372 |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
373 write_ascstring (printcharfun, " :data ("); |
| 826 | 374 map_char_table (obj, &range, print_table_entry, &arg); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4932
diff
changeset
|
375 write_ascstring (printcharfun, "))"); |
| 428 | 376 |
| 826 | 377 /* #### need to print and read the default; but that will allow the |
| 378 default to be modified, which we don't (yet) support -- but FSF does */ | |
| 428 | 379 } |
| 380 | |
| 381 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
382 char_table_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
| 428 | 383 { |
| 440 | 384 Lisp_Char_Table *ct1 = XCHAR_TABLE (obj1); |
| 385 Lisp_Char_Table *ct2 = XCHAR_TABLE (obj2); | |
| 428 | 386 int i; |
| 387 | |
| 388 if (CHAR_TABLE_TYPE (ct1) != CHAR_TABLE_TYPE (ct2)) | |
| 389 return 0; | |
| 390 | |
| 391 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
392 if (!internal_equal_0 (ct1->ascii[i], ct2->ascii[i], depth + 1, foldcase)) |
| 428 | 393 return 0; |
| 394 | |
| 395 #ifdef MULE | |
| 396 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
397 if (!internal_equal_0 (ct1->level1[i], ct2->level1[i], depth + 1, foldcase)) |
| 428 | 398 return 0; |
| 399 #endif /* MULE */ | |
| 400 | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4580
diff
changeset
|
401 return internal_equal_0 (ct1->default_, ct2->default_, depth + 1, foldcase); |
| 428 | 402 } |
| 403 | |
| 665 | 404 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
405 char_table_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 428 | 406 { |
| 440 | 407 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 665 | 408 Hashcode hashval = internal_array_hash (ct->ascii, NUM_ASCII_CHARS, |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
409 depth + 1, equalp); |
| 428 | 410 #ifdef MULE |
| 411 hashval = HASH2 (hashval, | |
| 826 | 412 internal_array_hash (ct->level1, NUM_LEADING_BYTES, |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
413 depth + 1, equalp)); |
| 428 | 414 #endif /* MULE */ |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5127
diff
changeset
|
415 return HASH2 (hashval, internal_hash (ct->default_, depth + 1, equalp)); |
| 428 | 416 } |
| 417 | |
| 1204 | 418 static const struct memory_description char_table_description[] = { |
| 440 | 419 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, ascii), NUM_ASCII_CHARS }, |
| 428 | 420 #ifdef MULE |
| 440 | 421 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Char_Table, level1), NUM_LEADING_BYTES }, |
| 428 | 422 #endif |
| 793 | 423 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, parent) }, |
| 424 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, default_) }, | |
| 440 | 425 { XD_LISP_OBJECT, offsetof (Lisp_Char_Table, mirror_table) }, |
| 426 { XD_LO_LINK, offsetof (Lisp_Char_Table, next_table) }, | |
| 428 | 427 { XD_END } |
| 428 }; | |
| 429 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
430 DEFINE_DUMPABLE_LISP_OBJECT ("char-table", char_table, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
431 mark_char_table, print_char_table, 0, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
432 char_table_equal, char_table_hash, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
433 char_table_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
434 Lisp_Char_Table); |
| 428 | 435 |
| 436 DEFUN ("char-table-p", Fchar_table_p, 1, 1, 0, /* | |
| 437 Return non-nil if OBJECT is a char table. | |
| 438 */ | |
| 439 (object)) | |
| 440 { | |
| 441 return CHAR_TABLEP (object) ? Qt : Qnil; | |
| 442 } | |
| 443 | |
| 444 DEFUN ("char-table-type-list", Fchar_table_type_list, 0, 0, 0, /* | |
| 445 Return a list of the recognized char table types. | |
| 800 | 446 See `make-char-table'. |
| 428 | 447 */ |
| 448 ()) | |
| 449 { | |
| 450 #ifdef MULE | |
| 451 return list5 (Qchar, Qcategory, Qdisplay, Qgeneric, Qsyntax); | |
| 452 #else | |
| 453 return list4 (Qchar, Qdisplay, Qgeneric, Qsyntax); | |
| 454 #endif | |
| 455 } | |
| 456 | |
| 457 DEFUN ("valid-char-table-type-p", Fvalid_char_table_type_p, 1, 1, 0, /* | |
| 458 Return t if TYPE if a recognized char table type. | |
| 800 | 459 See `make-char-table'. |
| 428 | 460 */ |
| 461 (type)) | |
| 462 { | |
| 463 return (EQ (type, Qchar) || | |
| 464 #ifdef MULE | |
| 465 EQ (type, Qcategory) || | |
| 466 #endif | |
| 467 EQ (type, Qdisplay) || | |
| 468 EQ (type, Qgeneric) || | |
| 469 EQ (type, Qsyntax)) ? Qt : Qnil; | |
| 470 } | |
| 471 | |
| 472 DEFUN ("char-table-type", Fchar_table_type, 1, 1, 0, /* | |
| 444 | 473 Return the type of CHAR-TABLE. |
| 800 | 474 See `make-char-table'. |
| 428 | 475 */ |
| 444 | 476 (char_table)) |
| 428 | 477 { |
| 444 | 478 CHECK_CHAR_TABLE (char_table); |
| 479 return char_table_type_to_symbol (XCHAR_TABLE (char_table)->type); | |
| 428 | 480 } |
| 481 | |
| 1296 | 482 static void |
| 483 set_char_table_dirty (Lisp_Object table) | |
| 484 { | |
| 485 assert (!XCHAR_TABLE (table)->mirror_table_p); | |
| 486 XCHAR_TABLE (XCHAR_TABLE (table)->mirror_table)->dirty = 1; | |
| 487 } | |
| 488 | |
| 428 | 489 void |
| 826 | 490 set_char_table_default (Lisp_Object table, Lisp_Object value) |
| 491 { | |
| 492 Lisp_Char_Table *ct = XCHAR_TABLE (table); | |
| 493 ct->default_ = value; | |
| 494 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 1296 | 495 set_char_table_dirty (table); |
| 826 | 496 } |
| 497 | |
| 498 static void | |
| 440 | 499 fill_char_table (Lisp_Char_Table *ct, Lisp_Object value) |
| 428 | 500 { |
| 501 int i; | |
| 502 | |
| 503 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
| 504 ct->ascii[i] = value; | |
| 505 #ifdef MULE | |
| 506 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 1296 | 507 { |
| 1330 | 508 /* Don't get stymied when initting the table, or when trying to |
| 509 free a pdump object. */ | |
| 1296 | 510 if (!EQ (ct->level1[i], Qnull_pointer) && |
| 1330 | 511 CHAR_TABLE_ENTRYP (ct->level1[i]) && |
| 512 !OBJECT_DUMPED_P (ct->level1[1])) | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
513 free_normal_lisp_object (ct->level1[i]); |
| 1296 | 514 ct->level1[i] = value; |
| 515 } | |
| 428 | 516 #endif /* MULE */ |
| 517 | |
| 518 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 1296 | 519 set_char_table_dirty (wrap_char_table (ct)); |
| 428 | 520 } |
| 521 | |
| 522 DEFUN ("reset-char-table", Freset_char_table, 1, 1, 0, /* | |
| 444 | 523 Reset CHAR-TABLE to its default state. |
| 428 | 524 */ |
| 444 | 525 (char_table)) |
| 428 | 526 { |
| 440 | 527 Lisp_Char_Table *ct; |
| 428 | 528 |
| 444 | 529 CHECK_CHAR_TABLE (char_table); |
| 530 ct = XCHAR_TABLE (char_table); | |
| 428 | 531 |
| 826 | 532 /* Avoid doubly updating the syntax table by setting the default ourselves, |
| 533 since set_char_table_default() also updates. */ | |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
534 ct->default_ = char_table_default_for_type (ct->type); |
| 826 | 535 fill_char_table (ct, Qunbound); |
| 536 | |
| 428 | 537 return Qnil; |
| 538 } | |
| 539 | |
| 540 DEFUN ("make-char-table", Fmake_char_table, 1, 1, 0, /* | |
| 541 Return a new, empty char table of type TYPE. | |
| 800 | 542 |
| 543 A char table is a table that maps characters (or ranges of characters) | |
| 544 to values. Char tables are specialized for characters, only allowing | |
| 545 particular sorts of ranges to be assigned values. Although this | |
| 546 loses in generality, it makes for extremely fast (constant-time) | |
| 547 lookups, and thus is feasible for applications that do an extremely | |
| 548 large number of lookups (e.g. scanning a buffer for a character in | |
| 549 a particular syntax, where a lookup in the syntax table must occur | |
| 550 once per character). | |
| 551 | |
| 552 When Mule support exists, the types of ranges that can be assigned | |
| 553 values are | |
| 554 | |
| 2714 | 555 -- all characters (represented by t) |
| 800 | 556 -- an entire charset |
| 2714 | 557 -- a single row in a two-octet charset (represented by a vector of two |
| 558 elements: a two-octet charset and a row number; the row must be an | |
| 559 integer, not a character) | |
| 800 | 560 -- a single character |
| 561 | |
| 562 When Mule support is not present, the types of ranges that can be | |
| 563 assigned values are | |
| 564 | |
| 2714 | 565 -- all characters (represented by t) |
| 800 | 566 -- a single character |
| 567 | |
| 568 To create a char table, use `make-char-table'. | |
| 569 To modify a char table, use `put-char-table' or `remove-char-table'. | |
| 570 To retrieve the value for a particular character, use `get-char-table'. | |
| 826 | 571 See also `map-char-table', `reset-char-table', `copy-char-table', |
| 800 | 572 `char-table-p', `valid-char-table-type-p', `char-table-type-list', |
| 573 `valid-char-table-value-p', and `check-char-table-value'. | |
| 574 | |
| 575 Each char table type is used for a different purpose and allows different | |
| 576 sorts of values. The different char table types are | |
| 577 | |
| 578 `category' | |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
579 Used for category tables, which specify the regexp categories that a |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
580 character is in. The valid values are nil or a bit vector of 95 |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
581 elements, and values default to nil. Higher-level Lisp functions |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
582 are provided for working with category tables. Currently categories |
| 800 | 583 and category tables only exist when Mule support is present. |
| 584 `char' | |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
585 A generalized char table, for mapping from one character to another. |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
586 Used for case tables, syntax matching tables, |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
587 `keyboard-translate-table', etc. The valid values are characters, |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
588 and the default result given by `get-char-table' if a value hasn't |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
589 been set for a given character or for a range that includes it, is |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
590 ?\x00. |
| 800 | 591 `generic' |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
592 An even more generalized char table, for mapping from a character to |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
593 anything. The default result given by `get-char-table' is nil. |
| 800 | 594 `display' |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
595 Used for display tables, which specify how a particular character is |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
596 to appear when displayed. #### Not yet implemented; currently, the |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
597 display table code uses generic char tables, and it's not clear that |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
598 implementing this char table type would be useful. |
| 800 | 599 `syntax' |
| 600 Used for syntax tables, which specify the syntax of a particular | |
| 601 character. Higher-level Lisp functions are provided for | |
|
4469
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
602 working with syntax tables. The valid values are integers, and the |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
603 default result given by `get-char-table' is the syntax code for |
|
c661944aa259
Fill out docstrings for #'translate-region, #'make-char-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3881
diff
changeset
|
604 `inherit'. |
| 428 | 605 */ |
| 606 (type)) | |
| 607 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
608 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
609 Lisp_Char_Table *ct = XCHAR_TABLE (obj); |
| 428 | 610 enum char_table_type ty = symbol_to_char_table_type (type); |
| 611 | |
| 612 ct->type = ty; | |
| 613 if (ty == CHAR_TABLE_TYPE_SYNTAX) | |
| 614 { | |
| 826 | 615 /* Qgeneric not Qsyntax because a syntax table has a mirror table |
| 616 and we don't want infinite recursion */ | |
| 428 | 617 ct->mirror_table = Fmake_char_table (Qgeneric); |
| 3145 | 618 set_char_table_default (ct->mirror_table, make_int (Sword)); |
| 1296 | 619 XCHAR_TABLE (ct->mirror_table)->mirror_table_p = 1; |
| 620 XCHAR_TABLE (ct->mirror_table)->mirror_table = obj; | |
| 428 | 621 } |
| 622 else | |
| 623 ct->mirror_table = Qnil; | |
| 624 ct->next_table = Qnil; | |
| 793 | 625 ct->parent = Qnil; |
| 626 ct->default_ = Qnil; | |
| 428 | 627 if (ty == CHAR_TABLE_TYPE_SYNTAX) |
| 628 { | |
| 629 ct->next_table = Vall_syntax_tables; | |
| 630 Vall_syntax_tables = obj; | |
| 631 } | |
| 632 Freset_char_table (obj); | |
| 633 return obj; | |
| 634 } | |
| 635 | |
| 636 #ifdef MULE | |
| 637 | |
| 638 static Lisp_Object | |
| 639 make_char_table_entry (Lisp_Object initval) | |
| 640 { | |
| 641 int i; | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
642 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table_entry); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
643 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (obj); |
| 428 | 644 |
| 645 for (i = 0; i < 96; i++) | |
| 646 cte->level2[i] = initval; | |
| 647 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
648 return obj; |
| 428 | 649 } |
| 650 | |
| 651 static Lisp_Object | |
| 652 copy_char_table_entry (Lisp_Object entry) | |
| 653 { | |
| 440 | 654 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (entry); |
| 428 | 655 int i; |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
656 Lisp_Object obj = ALLOC_NORMAL_LISP_OBJECT (char_table_entry); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
657 Lisp_Char_Table_Entry *ctenew = XCHAR_TABLE_ENTRY (obj); |
| 428 | 658 |
| 659 for (i = 0; i < 96; i++) | |
| 660 { | |
| 3025 | 661 Lisp_Object new_ = cte->level2[i]; |
| 662 if (CHAR_TABLE_ENTRYP (new_)) | |
| 663 ctenew->level2[i] = copy_char_table_entry (new_); | |
| 428 | 664 else |
| 3025 | 665 ctenew->level2[i] = new_; |
| 428 | 666 } |
| 667 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
668 return obj; |
| 428 | 669 } |
| 670 | |
| 671 #endif /* MULE */ | |
| 672 | |
| 673 DEFUN ("copy-char-table", Fcopy_char_table, 1, 1, 0, /* | |
| 444 | 674 Return a new char table which is a copy of CHAR-TABLE. |
| 428 | 675 It will contain the same values for the same characters and ranges |
| 444 | 676 as CHAR-TABLE. The values will not themselves be copied. |
| 428 | 677 */ |
| 444 | 678 (char_table)) |
| 428 | 679 { |
| 440 | 680 Lisp_Char_Table *ct, *ctnew; |
| 428 | 681 Lisp_Object obj; |
| 682 int i; | |
| 683 | |
| 444 | 684 CHECK_CHAR_TABLE (char_table); |
| 685 ct = XCHAR_TABLE (char_table); | |
| 3879 | 686 assert(!ct->mirror_table_p); |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
687 obj = ALLOC_NORMAL_LISP_OBJECT (char_table); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
688 ctnew = XCHAR_TABLE (obj); |
| 428 | 689 ctnew->type = ct->type; |
| 793 | 690 ctnew->parent = ct->parent; |
| 691 ctnew->default_ = ct->default_; | |
| 3879 | 692 ctnew->mirror_table_p = 0; |
| 428 | 693 |
| 694 for (i = 0; i < NUM_ASCII_CHARS; i++) | |
| 695 { | |
| 3025 | 696 Lisp_Object new_ = ct->ascii[i]; |
| 428 | 697 #ifdef MULE |
| 3025 | 698 assert (! (CHAR_TABLE_ENTRYP (new_))); |
| 428 | 699 #endif /* MULE */ |
| 3025 | 700 ctnew->ascii[i] = new_; |
| 428 | 701 } |
| 702 | |
| 703 #ifdef MULE | |
| 704 | |
| 705 for (i = 0; i < NUM_LEADING_BYTES; i++) | |
| 706 { | |
| 3025 | 707 Lisp_Object new_ = ct->level1[i]; |
| 708 if (CHAR_TABLE_ENTRYP (new_)) | |
| 709 ctnew->level1[i] = copy_char_table_entry (new_); | |
| 428 | 710 else |
| 3025 | 711 ctnew->level1[i] = new_; |
| 428 | 712 } |
| 713 | |
| 714 #endif /* MULE */ | |
| 715 | |
| 3881 | 716 if (!EQ (ct->mirror_table, Qnil)) |
| 1296 | 717 { |
| 3879 | 718 ctnew->mirror_table = Fmake_char_table (Qgeneric); |
| 719 set_char_table_default (ctnew->mirror_table, make_int (Sword)); | |
| 1296 | 720 XCHAR_TABLE (ctnew->mirror_table)->mirror_table = obj; |
| 3879 | 721 XCHAR_TABLE (ctnew->mirror_table)->mirror_table_p = 1; |
| 722 XCHAR_TABLE (ctnew->mirror_table)->dirty = 1; | |
| 1296 | 723 } |
| 428 | 724 else |
| 3879 | 725 ctnew->mirror_table = Qnil; |
| 726 | |
| 428 | 727 ctnew->next_table = Qnil; |
| 728 if (ctnew->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 729 { | |
| 730 ctnew->next_table = Vall_syntax_tables; | |
| 731 Vall_syntax_tables = obj; | |
| 732 } | |
| 733 return obj; | |
| 734 } | |
| 735 | |
| 736 #ifdef MULE | |
| 737 | |
| 826 | 738 /* called from get_char_table(). */ |
| 428 | 739 Lisp_Object |
| 440 | 740 get_non_ascii_char_table_value (Lisp_Char_Table *ct, int leading_byte, |
| 867 | 741 Ichar c) |
| 428 | 742 { |
| 743 Lisp_Object val; | |
| 826 | 744 Lisp_Object charset = charset_by_leading_byte (leading_byte); |
| 428 | 745 int byte1, byte2; |
| 746 | |
| 867 | 747 BREAKUP_ICHAR_1_UNSAFE (c, charset, byte1, byte2); |
| 428 | 748 val = ct->level1[leading_byte - MIN_LEADING_BYTE]; |
| 749 if (CHAR_TABLE_ENTRYP (val)) | |
| 750 { | |
| 440 | 751 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); |
| 428 | 752 val = cte->level2[byte1 - 32]; |
| 753 if (CHAR_TABLE_ENTRYP (val)) | |
| 754 { | |
| 755 cte = XCHAR_TABLE_ENTRY (val); | |
| 756 assert (byte2 >= 32); | |
| 757 val = cte->level2[byte2 - 32]; | |
| 758 assert (!CHAR_TABLE_ENTRYP (val)); | |
| 759 } | |
| 760 } | |
| 761 | |
| 762 return val; | |
| 763 } | |
| 764 | |
| 765 #endif /* MULE */ | |
| 766 | |
| 826 | 767 DEFUN ("char-table-default", Fchar_table_default, 1, 1, 0, /* |
| 768 Return the default value for CHAR-TABLE. When an entry for a character | |
| 769 does not exist, the default is returned. | |
| 770 */ | |
| 771 (char_table)) | |
| 428 | 772 { |
| 826 | 773 CHECK_CHAR_TABLE (char_table); |
| 774 return XCHAR_TABLE (char_table)->default_; | |
| 428 | 775 } |
| 776 | |
| 826 | 777 DEFUN ("set-char-table-default", Fset_char_table_default, 2, 2, 0, /* |
| 778 Set the default value for CHAR-TABLE to DEFAULT. | |
| 779 Currently, the default value for syntax tables cannot be changed. | |
| 780 (This policy might change in the future.) | |
| 781 */ | |
| 782 (char_table, default_)) | |
| 783 { | |
| 784 CHECK_CHAR_TABLE (char_table); | |
| 785 if (XCHAR_TABLE_TYPE (char_table) == CHAR_TABLE_TYPE_SYNTAX) | |
| 786 invalid_change ("Can't change default for syntax tables", char_table); | |
| 787 check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (char_table), | |
| 788 ERROR_ME); | |
| 789 set_char_table_default (char_table, default_); | |
| 790 return Qnil; | |
| 791 } | |
| 428 | 792 |
| 793 DEFUN ("get-char-table", Fget_char_table, 2, 2, 0, /* | |
| 444 | 794 Find value for CHARACTER in CHAR-TABLE. |
| 428 | 795 */ |
| 444 | 796 (character, char_table)) |
| 428 | 797 { |
| 444 | 798 CHECK_CHAR_TABLE (char_table); |
| 799 CHECK_CHAR_COERCE_INT (character); | |
| 428 | 800 |
| 826 | 801 return get_char_table (XCHAR (character), char_table); |
| 802 } | |
| 803 | |
| 804 static int | |
| 2286 | 805 copy_mapper (struct chartab_range *range, Lisp_Object UNUSED (table), |
| 826 | 806 Lisp_Object val, void *arg) |
| 807 { | |
| 5013 | 808 put_char_table (GET_LISP_FROM_VOID (arg), range, val); |
| 826 | 809 return 0; |
| 810 } | |
| 811 | |
| 812 void | |
| 813 copy_char_table_range (Lisp_Object from, Lisp_Object to, | |
| 814 struct chartab_range *range) | |
| 815 { | |
| 5013 | 816 map_char_table (from, range, copy_mapper, STORE_LISP_IN_VOID (to)); |
| 826 | 817 } |
| 818 | |
| 1296 | 819 static Lisp_Object |
| 820 get_range_char_table_1 (struct chartab_range *range, Lisp_Object table, | |
| 821 Lisp_Object multi) | |
| 826 | 822 { |
| 823 Lisp_Char_Table *ct = XCHAR_TABLE (table); | |
| 824 Lisp_Object retval = Qnil; | |
| 825 | |
| 826 switch (range->type) | |
| 827 { | |
| 828 case CHARTAB_RANGE_CHAR: | |
| 829 return get_char_table (range->ch, table); | |
| 830 | |
| 831 case CHARTAB_RANGE_ALL: | |
| 832 { | |
| 833 int i; | |
| 834 retval = ct->ascii[0]; | |
| 835 | |
| 836 for (i = 1; i < NUM_ASCII_CHARS; i++) | |
| 837 if (!EQ (retval, ct->ascii[i])) | |
| 838 return multi; | |
| 839 | |
| 840 #ifdef MULE | |
| 841 for (i = MIN_LEADING_BYTE; i < MIN_LEADING_BYTE + NUM_LEADING_BYTES; | |
| 842 i++) | |
| 843 { | |
| 844 if (!CHARSETP (charset_by_leading_byte (i)) | |
| 845 || i == LEADING_BYTE_ASCII | |
| 846 || i == LEADING_BYTE_CONTROL_1) | |
| 847 continue; | |
| 848 if (!EQ (retval, ct->level1[i - MIN_LEADING_BYTE])) | |
| 849 return multi; | |
| 850 } | |
| 851 #endif /* MULE */ | |
| 852 | |
| 853 break; | |
| 854 } | |
| 855 | |
| 856 #ifdef MULE | |
| 857 case CHARTAB_RANGE_CHARSET: | |
| 858 if (EQ (range->charset, Vcharset_ascii)) | |
| 859 { | |
| 860 int i; | |
| 861 retval = ct->ascii[0]; | |
| 862 | |
| 863 for (i = 1; i < 128; i++) | |
| 864 if (!EQ (retval, ct->ascii[i])) | |
| 865 return multi; | |
| 866 break; | |
| 867 } | |
| 868 | |
| 869 if (EQ (range->charset, Vcharset_control_1)) | |
| 870 { | |
| 871 int i; | |
| 872 retval = ct->ascii[128]; | |
| 873 | |
| 874 for (i = 129; i < 160; i++) | |
| 875 if (!EQ (retval, ct->ascii[i])) | |
| 876 return multi; | |
| 877 break; | |
| 878 } | |
| 879 | |
| 880 { | |
| 881 retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - | |
| 882 MIN_LEADING_BYTE]; | |
| 883 if (CHAR_TABLE_ENTRYP (retval)) | |
| 884 return multi; | |
| 885 break; | |
| 886 } | |
| 887 | |
| 888 case CHARTAB_RANGE_ROW: | |
| 889 { | |
| 890 retval = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - | |
| 891 MIN_LEADING_BYTE]; | |
| 892 if (!CHAR_TABLE_ENTRYP (retval)) | |
| 893 break; | |
| 894 retval = XCHAR_TABLE_ENTRY (retval)->level2[range->row - 32]; | |
| 895 if (CHAR_TABLE_ENTRYP (retval)) | |
| 896 return multi; | |
| 897 break; | |
| 898 } | |
| 899 #endif /* not MULE */ | |
| 900 | |
| 901 default: | |
| 2500 | 902 ABORT (); |
| 826 | 903 } |
| 904 | |
| 905 if (UNBOUNDP (retval)) | |
| 906 return ct->default_; | |
| 907 return retval; | |
| 428 | 908 } |
| 909 | |
| 1296 | 910 Lisp_Object |
| 911 get_range_char_table (struct chartab_range *range, Lisp_Object table, | |
| 912 Lisp_Object multi) | |
| 913 { | |
| 914 if (range->type == CHARTAB_RANGE_CHAR) | |
| 915 return get_char_table (range->ch, table); | |
| 916 else | |
| 917 return get_range_char_table_1 (range, table, multi); | |
| 918 } | |
| 919 | |
| 920 #ifdef ERROR_CHECK_TYPES | |
| 921 | |
| 922 /* Only exists so as not to trip an assert in get_char_table(). */ | |
| 923 Lisp_Object | |
| 924 updating_mirror_get_range_char_table (struct chartab_range *range, | |
| 925 Lisp_Object table, | |
| 926 Lisp_Object multi) | |
| 927 { | |
| 928 if (range->type == CHARTAB_RANGE_CHAR) | |
| 929 return get_char_table_1 (range->ch, table); | |
| 930 else | |
| 931 return get_range_char_table_1 (range, table, multi); | |
| 932 } | |
| 933 | |
| 934 #endif /* ERROR_CHECK_TYPES */ | |
| 935 | |
| 428 | 936 DEFUN ("get-range-char-table", Fget_range_char_table, 2, 3, 0, /* |
| 2714 | 937 Find value for RANGE in CHAR-TABLE. |
| 428 | 938 If there is more than one value, return MULTI (defaults to nil). |
| 2714 | 939 |
| 940 Valid values for RANGE are single characters, charsets, a row in a | |
| 941 two-octet charset, and all characters. See `put-char-table'. | |
| 428 | 942 */ |
| 444 | 943 (range, char_table, multi)) |
| 428 | 944 { |
| 945 struct chartab_range rainj; | |
| 946 | |
| 947 if (CHAR_OR_CHAR_INTP (range)) | |
| 444 | 948 return Fget_char_table (range, char_table); |
| 949 CHECK_CHAR_TABLE (char_table); | |
| 428 | 950 |
| 951 decode_char_table_range (range, &rainj); | |
| 826 | 952 return get_range_char_table (&rainj, char_table, multi); |
| 428 | 953 } |
| 826 | 954 |
| 428 | 955 static int |
| 956 check_valid_char_table_value (Lisp_Object value, enum char_table_type type, | |
| 578 | 957 Error_Behavior errb) |
| 428 | 958 { |
| 959 switch (type) | |
| 960 { | |
| 961 case CHAR_TABLE_TYPE_SYNTAX: | |
| 962 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 963 return INTP (value) || (CONSP (value) && INTP (XCAR (value)) | |
| 964 && CHAR_OR_CHAR_INTP (XCDR (value))); | |
| 965 if (CONSP (value)) | |
| 966 { | |
| 967 Lisp_Object cdr = XCDR (value); | |
| 968 CHECK_INT (XCAR (value)); | |
| 969 CHECK_CHAR_COERCE_INT (cdr); | |
| 970 } | |
| 971 else | |
| 972 CHECK_INT (value); | |
| 973 break; | |
| 974 | |
| 975 #ifdef MULE | |
| 976 case CHAR_TABLE_TYPE_CATEGORY: | |
| 977 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 978 return CATEGORY_TABLE_VALUEP (value); | |
| 979 CHECK_CATEGORY_TABLE_VALUE (value); | |
| 980 break; | |
| 981 #endif /* MULE */ | |
| 982 | |
| 983 case CHAR_TABLE_TYPE_GENERIC: | |
| 984 return 1; | |
| 985 | |
| 986 case CHAR_TABLE_TYPE_DISPLAY: | |
| 987 /* #### fix this */ | |
| 563 | 988 maybe_signal_error (Qunimplemented, |
| 989 "Display char tables not yet implemented", | |
| 990 value, Qchar_table, errb); | |
| 428 | 991 return 0; |
| 992 | |
| 993 case CHAR_TABLE_TYPE_CHAR: | |
| 994 if (!ERRB_EQ (errb, ERROR_ME)) | |
| 995 return CHAR_OR_CHAR_INTP (value); | |
| 996 CHECK_CHAR_COERCE_INT (value); | |
| 997 break; | |
| 998 | |
| 999 default: | |
| 2500 | 1000 ABORT (); |
| 428 | 1001 } |
| 1002 | |
| 801 | 1003 return 0; /* not (usually) reached */ |
| 428 | 1004 } |
| 1005 | |
| 1006 static Lisp_Object | |
| 1007 canonicalize_char_table_value (Lisp_Object value, enum char_table_type type) | |
| 1008 { | |
| 1009 switch (type) | |
| 1010 { | |
| 1011 case CHAR_TABLE_TYPE_SYNTAX: | |
| 1012 if (CONSP (value)) | |
| 1013 { | |
| 1014 Lisp_Object car = XCAR (value); | |
| 1015 Lisp_Object cdr = XCDR (value); | |
| 1016 CHECK_CHAR_COERCE_INT (cdr); | |
| 1017 return Fcons (car, cdr); | |
| 1018 } | |
| 1019 break; | |
| 1020 case CHAR_TABLE_TYPE_CHAR: | |
| 1021 CHECK_CHAR_COERCE_INT (value); | |
| 1022 break; | |
| 1023 default: | |
| 1024 break; | |
| 1025 } | |
| 1026 return value; | |
| 1027 } | |
| 1028 | |
| 1029 DEFUN ("valid-char-table-value-p", Fvalid_char_table_value_p, 2, 2, 0, /* | |
| 1030 Return non-nil if VALUE is a valid value for CHAR-TABLE-TYPE. | |
| 1031 */ | |
| 1032 (value, char_table_type)) | |
| 1033 { | |
| 1034 enum char_table_type type = symbol_to_char_table_type (char_table_type); | |
| 1035 | |
| 1036 return check_valid_char_table_value (value, type, ERROR_ME_NOT) ? Qt : Qnil; | |
| 1037 } | |
| 1038 | |
| 1039 DEFUN ("check-valid-char-table-value", Fcheck_valid_char_table_value, 2, 2, 0, /* | |
| 1040 Signal an error if VALUE is not a valid value for CHAR-TABLE-TYPE. | |
| 1041 */ | |
| 1042 (value, char_table_type)) | |
| 1043 { | |
| 1044 enum char_table_type type = symbol_to_char_table_type (char_table_type); | |
| 1045 | |
| 1046 check_valid_char_table_value (value, type, ERROR_ME); | |
| 1047 return Qnil; | |
| 1048 } | |
| 1049 | |
| 826 | 1050 /* Assign VAL to all characters in RANGE in char table TABLE. */ |
| 428 | 1051 |
| 1052 void | |
| 826 | 1053 put_char_table (Lisp_Object table, struct chartab_range *range, |
| 428 | 1054 Lisp_Object val) |
| 1055 { | |
| 826 | 1056 Lisp_Char_Table *ct = XCHAR_TABLE (table); |
| 1057 | |
| 428 | 1058 switch (range->type) |
| 1059 { | |
| 1060 case CHARTAB_RANGE_ALL: | |
| 1061 fill_char_table (ct, val); | |
| 1296 | 1062 return; /* fill_char_table() recorded the table as dirty. */ |
| 428 | 1063 |
| 1064 #ifdef MULE | |
| 1065 case CHARTAB_RANGE_CHARSET: | |
| 1066 if (EQ (range->charset, Vcharset_ascii)) | |
| 1067 { | |
| 1068 int i; | |
| 1069 for (i = 0; i < 128; i++) | |
| 1070 ct->ascii[i] = val; | |
| 1071 } | |
| 1072 else if (EQ (range->charset, Vcharset_control_1)) | |
| 1073 { | |
| 1074 int i; | |
| 1075 for (i = 128; i < 160; i++) | |
| 1076 ct->ascii[i] = val; | |
| 1077 } | |
| 1078 else | |
| 1079 { | |
| 1080 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; | |
| 1330 | 1081 if (CHAR_TABLE_ENTRYP (ct->level1[lb]) && |
| 1082 !OBJECT_DUMPED_P (ct->level1[lb])) | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
1083 free_normal_lisp_object (ct->level1[lb]); |
| 428 | 1084 ct->level1[lb] = val; |
| 1085 } | |
| 1086 break; | |
| 1087 | |
| 1088 case CHARTAB_RANGE_ROW: | |
| 1089 { | |
| 440 | 1090 Lisp_Char_Table_Entry *cte; |
| 428 | 1091 int lb = XCHARSET_LEADING_BYTE (range->charset) - MIN_LEADING_BYTE; |
| 1092 /* make sure that there is a separate entry for the row. */ | |
| 1093 if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) | |
| 1094 ct->level1[lb] = make_char_table_entry (ct->level1[lb]); | |
| 1095 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); | |
| 1096 cte->level2[range->row - 32] = val; | |
| 1097 } | |
| 1098 break; | |
| 1099 #endif /* MULE */ | |
| 1100 | |
| 1101 case CHARTAB_RANGE_CHAR: | |
| 1102 #ifdef MULE | |
| 1103 { | |
| 1104 Lisp_Object charset; | |
| 1105 int byte1, byte2; | |
| 1106 | |
| 867 | 1107 BREAKUP_ICHAR (range->ch, charset, byte1, byte2); |
| 428 | 1108 if (EQ (charset, Vcharset_ascii)) |
| 1109 ct->ascii[byte1] = val; | |
| 1110 else if (EQ (charset, Vcharset_control_1)) | |
| 1111 ct->ascii[byte1 + 128] = val; | |
| 1112 else | |
| 1113 { | |
| 440 | 1114 Lisp_Char_Table_Entry *cte; |
| 428 | 1115 int lb = XCHARSET_LEADING_BYTE (charset) - MIN_LEADING_BYTE; |
| 1116 /* make sure that there is a separate entry for the row. */ | |
| 1117 if (!CHAR_TABLE_ENTRYP (ct->level1[lb])) | |
| 1118 ct->level1[lb] = make_char_table_entry (ct->level1[lb]); | |
| 1119 cte = XCHAR_TABLE_ENTRY (ct->level1[lb]); | |
| 1120 /* now CTE is a char table entry for the charset; | |
| 1121 each entry is for a single row (or character of | |
| 1122 a one-octet charset). */ | |
| 1123 if (XCHARSET_DIMENSION (charset) == 1) | |
| 1124 cte->level2[byte1 - 32] = val; | |
| 1125 else | |
| 1126 { | |
| 1127 /* assigning to one character in a two-octet charset. */ | |
| 1128 /* make sure that the charset row contains a separate | |
| 1129 entry for each character. */ | |
| 1130 if (!CHAR_TABLE_ENTRYP (cte->level2[byte1 - 32])) | |
| 1131 cte->level2[byte1 - 32] = | |
| 1132 make_char_table_entry (cte->level2[byte1 - 32]); | |
| 1133 cte = XCHAR_TABLE_ENTRY (cte->level2[byte1 - 32]); | |
| 1134 cte->level2[byte2 - 32] = val; | |
| 1135 } | |
| 1136 } | |
| 1137 } | |
| 1138 #else /* not MULE */ | |
| 1139 ct->ascii[(unsigned char) (range->ch)] = val; | |
| 1140 break; | |
| 1141 #endif /* not MULE */ | |
| 1142 } | |
| 1143 | |
| 1144 if (ct->type == CHAR_TABLE_TYPE_SYNTAX) | |
| 1296 | 1145 set_char_table_dirty (wrap_char_table (ct)); |
| 428 | 1146 } |
| 1147 | |
| 1148 DEFUN ("put-char-table", Fput_char_table, 3, 3, 0, /* | |
| 444 | 1149 Set the value for chars in RANGE to be VALUE in CHAR-TABLE. |
| 428 | 1150 |
| 1151 RANGE specifies one or more characters to be affected and should be | |
| 1152 one of the following: | |
| 1153 | |
| 1154 -- t (all characters are affected) | |
| 1155 -- A charset (only allowed when Mule support is present) | |
| 2714 | 1156 -- A vector of two elements: a two-octet charset and a row number; the row |
| 1157 must be an integer, not a character (only allowed when Mule support is | |
| 1158 present) | |
| 428 | 1159 -- A single character |
| 1160 | |
| 444 | 1161 VALUE must be a value appropriate for the type of CHAR-TABLE. |
| 800 | 1162 See `make-char-table'. |
| 428 | 1163 */ |
| 444 | 1164 (range, value, char_table)) |
| 428 | 1165 { |
| 440 | 1166 Lisp_Char_Table *ct; |
| 428 | 1167 struct chartab_range rainj; |
| 1168 | |
| 444 | 1169 CHECK_CHAR_TABLE (char_table); |
| 1170 ct = XCHAR_TABLE (char_table); | |
| 1171 check_valid_char_table_value (value, ct->type, ERROR_ME); | |
| 428 | 1172 decode_char_table_range (range, &rainj); |
| 444 | 1173 value = canonicalize_char_table_value (value, ct->type); |
| 826 | 1174 put_char_table (char_table, &rainj, value); |
| 1175 return Qnil; | |
| 1176 } | |
| 1177 | |
| 1178 DEFUN ("remove-char-table", Fremove_char_table, 2, 2, 0, /* | |
| 1179 Remove any value from chars in RANGE in CHAR-TABLE. | |
| 1180 | |
| 1181 RANGE specifies one or more characters to be affected and should be | |
| 1182 one of the following: | |
| 1183 | |
| 1184 -- t (all characters are affected) | |
| 1185 -- A charset (only allowed when Mule support is present) | |
| 1186 -- A vector of two elements: a two-octet charset and a row number | |
| 1187 (only allowed when Mule support is present) | |
| 1188 -- A single character | |
| 1189 | |
| 2726 | 1190 With all values removed, the default value will be returned by |
| 1191 `get-char-table' and `get-range-char-table'. | |
| 826 | 1192 */ |
| 1193 (range, char_table)) | |
| 1194 { | |
| 1195 struct chartab_range rainj; | |
| 1196 | |
| 1197 CHECK_CHAR_TABLE (char_table); | |
| 1198 decode_char_table_range (range, &rainj); | |
| 1199 put_char_table (char_table, &rainj, Qunbound); | |
| 428 | 1200 return Qnil; |
| 1201 } | |
| 1202 | |
| 1203 /* Map FN over the ASCII chars in CT. */ | |
| 1204 | |
| 1205 static int | |
| 826 | 1206 map_over_charset_ascii_1 (Lisp_Char_Table *ct, |
| 1207 int start, int stop, | |
| 1208 int (*fn) (struct chartab_range *range, | |
| 1209 Lisp_Object table, Lisp_Object val, | |
| 1210 void *arg), | |
| 1211 void *arg) | |
| 1212 { | |
| 1213 struct chartab_range rainj; | |
| 1214 int i, retval; | |
| 1215 | |
| 1216 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1217 | |
| 1218 for (i = start, retval = 0; i <= stop && retval == 0; i++) | |
| 1219 { | |
| 867 | 1220 rainj.ch = (Ichar) i; |
| 826 | 1221 if (!UNBOUNDP (ct->ascii[i])) |
| 1222 retval = (fn) (&rainj, wrap_char_table (ct), ct->ascii[i], arg); | |
| 1223 } | |
| 1224 | |
| 1225 return retval; | |
| 1226 } | |
| 1227 | |
| 1228 | |
| 1229 /* Map FN over the ASCII chars in CT. */ | |
| 1230 | |
| 1231 static int | |
| 440 | 1232 map_over_charset_ascii (Lisp_Char_Table *ct, |
| 428 | 1233 int (*fn) (struct chartab_range *range, |
| 826 | 1234 Lisp_Object table, Lisp_Object val, |
| 1235 void *arg), | |
| 428 | 1236 void *arg) |
| 1237 { | |
| 826 | 1238 return map_over_charset_ascii_1 (ct, 0, |
| 428 | 1239 #ifdef MULE |
| 826 | 1240 127, |
| 428 | 1241 #else |
| 826 | 1242 255, |
| 428 | 1243 #endif |
| 826 | 1244 fn, arg); |
| 428 | 1245 } |
| 1246 | |
| 1247 #ifdef MULE | |
| 1248 | |
| 1249 /* Map FN over the Control-1 chars in CT. */ | |
| 1250 | |
| 1251 static int | |
| 440 | 1252 map_over_charset_control_1 (Lisp_Char_Table *ct, |
| 428 | 1253 int (*fn) (struct chartab_range *range, |
| 826 | 1254 Lisp_Object table, Lisp_Object val, |
| 1255 void *arg), | |
| 428 | 1256 void *arg) |
| 1257 { | |
| 826 | 1258 return map_over_charset_ascii_1 (ct, 128, 159, fn, arg); |
| 428 | 1259 } |
| 1260 | |
| 1261 /* Map FN over the row ROW of two-byte charset CHARSET. | |
| 1262 There must be a separate value for that row in the char table. | |
| 1263 CTE specifies the char table entry for CHARSET. */ | |
| 1264 | |
| 1265 static int | |
| 826 | 1266 map_over_charset_row (Lisp_Char_Table *ct, |
| 1267 Lisp_Char_Table_Entry *cte, | |
| 428 | 1268 Lisp_Object charset, int row, |
| 1269 int (*fn) (struct chartab_range *range, | |
| 826 | 1270 Lisp_Object table, Lisp_Object val, |
| 1271 void *arg), | |
| 428 | 1272 void *arg) |
| 1273 { | |
| 1274 Lisp_Object val = cte->level2[row - 32]; | |
| 1275 | |
| 826 | 1276 if (UNBOUNDP (val)) |
| 1277 return 0; | |
| 1278 else if (!CHAR_TABLE_ENTRYP (val)) | |
| 428 | 1279 { |
| 1280 struct chartab_range rainj; | |
| 826 | 1281 |
| 428 | 1282 rainj.type = CHARTAB_RANGE_ROW; |
| 1283 rainj.charset = charset; | |
| 1284 rainj.row = row; | |
| 826 | 1285 return (fn) (&rainj, wrap_char_table (ct), val, arg); |
| 428 | 1286 } |
| 1287 else | |
| 1288 { | |
| 1289 struct chartab_range rainj; | |
| 1290 int i, retval; | |
| 826 | 1291 int start, stop; |
| 1292 | |
| 1293 get_charset_limits (charset, &start, &stop); | |
| 428 | 1294 |
| 1295 cte = XCHAR_TABLE_ENTRY (val); | |
| 1296 | |
| 1297 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1298 | |
| 826 | 1299 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
| 428 | 1300 { |
| 867 | 1301 rainj.ch = make_ichar (charset, row, i); |
| 826 | 1302 if (!UNBOUNDP (cte->level2[i - 32])) |
| 1303 retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32], | |
| 1304 arg); | |
| 428 | 1305 } |
| 1306 return retval; | |
| 1307 } | |
| 1308 } | |
| 1309 | |
| 1310 | |
| 1311 static int | |
| 440 | 1312 map_over_other_charset (Lisp_Char_Table *ct, int lb, |
| 428 | 1313 int (*fn) (struct chartab_range *range, |
| 826 | 1314 Lisp_Object table, Lisp_Object val, |
| 1315 void *arg), | |
| 428 | 1316 void *arg) |
| 1317 { | |
| 1318 Lisp_Object val = ct->level1[lb - MIN_LEADING_BYTE]; | |
| 826 | 1319 Lisp_Object charset = charset_by_leading_byte (lb); |
| 428 | 1320 |
| 1321 if (!CHARSETP (charset) | |
| 1322 || lb == LEADING_BYTE_ASCII | |
| 1323 || lb == LEADING_BYTE_CONTROL_1) | |
| 1324 return 0; | |
| 1325 | |
| 826 | 1326 if (UNBOUNDP (val)) |
| 1327 return 0; | |
| 428 | 1328 if (!CHAR_TABLE_ENTRYP (val)) |
| 1329 { | |
| 1330 struct chartab_range rainj; | |
| 1331 | |
| 1332 rainj.type = CHARTAB_RANGE_CHARSET; | |
| 1333 rainj.charset = charset; | |
| 826 | 1334 return (fn) (&rainj, wrap_char_table (ct), val, arg); |
| 428 | 1335 } |
| 1336 { | |
| 440 | 1337 Lisp_Char_Table_Entry *cte = XCHAR_TABLE_ENTRY (val); |
| 826 | 1338 int start, stop; |
| 428 | 1339 int i, retval; |
| 1340 | |
| 826 | 1341 get_charset_limits (charset, &start, &stop); |
| 428 | 1342 if (XCHARSET_DIMENSION (charset) == 1) |
| 1343 { | |
| 1344 struct chartab_range rainj; | |
| 1345 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1346 | |
| 826 | 1347 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
| 428 | 1348 { |
| 867 | 1349 rainj.ch = make_ichar (charset, i, 0); |
| 826 | 1350 if (!UNBOUNDP (cte->level2[i - 32])) |
| 1351 retval = (fn) (&rainj, wrap_char_table (ct), cte->level2[i - 32], | |
| 1352 arg); | |
| 428 | 1353 } |
| 1354 } | |
| 1355 else | |
| 1356 { | |
| 826 | 1357 for (i = start, retval = 0; i <= stop && retval == 0; i++) |
| 1358 retval = map_over_charset_row (ct, cte, charset, i, fn, arg); | |
| 428 | 1359 } |
| 1360 | |
| 1361 return retval; | |
| 1362 } | |
| 1363 } | |
| 1364 | |
| 1365 #endif /* MULE */ | |
| 1366 | |
| 1367 /* Map FN (with client data ARG) over range RANGE in char table CT. | |
| 1368 Mapping stops the first time FN returns non-zero, and that value | |
| 826 | 1369 becomes the return value of map_char_table(). |
| 1370 | |
| 1371 #### This mapping code is way ugly. The FSF version, in contrast, | |
| 1372 is short and sweet, and much more recursive. There should be some way | |
| 1373 of cleaning this up. */ | |
| 428 | 1374 |
| 1375 int | |
| 826 | 1376 map_char_table (Lisp_Object table, |
| 428 | 1377 struct chartab_range *range, |
| 1378 int (*fn) (struct chartab_range *range, | |
| 826 | 1379 Lisp_Object table, Lisp_Object val, void *arg), |
| 428 | 1380 void *arg) |
| 1381 { | |
| 826 | 1382 Lisp_Char_Table *ct = XCHAR_TABLE (table); |
| 428 | 1383 switch (range->type) |
| 1384 { | |
| 1385 case CHARTAB_RANGE_ALL: | |
| 1386 { | |
| 1387 int retval; | |
| 1388 | |
| 1389 retval = map_over_charset_ascii (ct, fn, arg); | |
| 1390 if (retval) | |
| 1391 return retval; | |
| 1392 #ifdef MULE | |
| 1393 retval = map_over_charset_control_1 (ct, fn, arg); | |
| 1394 if (retval) | |
| 1395 return retval; | |
| 1396 { | |
| 1397 int i; | |
| 1398 int start = MIN_LEADING_BYTE; | |
| 1399 int stop = start + NUM_LEADING_BYTES; | |
| 1400 | |
| 1401 for (i = start, retval = 0; i < stop && retval == 0; i++) | |
| 1402 { | |
| 771 | 1403 if (i != LEADING_BYTE_ASCII && i != LEADING_BYTE_CONTROL_1) |
| 1404 retval = map_over_other_charset (ct, i, fn, arg); | |
| 428 | 1405 } |
| 1406 } | |
| 1407 #endif /* MULE */ | |
| 1408 return retval; | |
| 1409 } | |
| 1410 | |
| 1411 #ifdef MULE | |
| 1412 case CHARTAB_RANGE_CHARSET: | |
| 1413 return map_over_other_charset (ct, | |
| 1414 XCHARSET_LEADING_BYTE (range->charset), | |
| 1415 fn, arg); | |
| 1416 | |
| 1417 case CHARTAB_RANGE_ROW: | |
| 1418 { | |
| 771 | 1419 Lisp_Object val = ct->level1[XCHARSET_LEADING_BYTE (range->charset) - |
| 1420 MIN_LEADING_BYTE]; | |
| 826 | 1421 |
| 1422 if (CHAR_TABLE_ENTRYP (val)) | |
| 1423 return map_over_charset_row (ct, XCHAR_TABLE_ENTRY (val), | |
| 1424 range->charset, range->row, fn, arg); | |
| 1425 else if (!UNBOUNDP (val)) | |
| 428 | 1426 { |
| 1427 struct chartab_range rainj; | |
| 1428 | |
| 1429 rainj.type = CHARTAB_RANGE_ROW; | |
| 1430 rainj.charset = range->charset; | |
| 1431 rainj.row = range->row; | |
| 826 | 1432 return (fn) (&rainj, table, val, arg); |
| 428 | 1433 } |
| 1434 else | |
| 826 | 1435 return 0; |
| 428 | 1436 } |
| 1437 #endif /* MULE */ | |
| 1438 | |
| 1439 case CHARTAB_RANGE_CHAR: | |
| 1440 { | |
| 867 | 1441 Ichar ch = range->ch; |
| 826 | 1442 Lisp_Object val = get_char_table (ch, table); |
| 428 | 1443 struct chartab_range rainj; |
| 1444 | |
| 826 | 1445 if (!UNBOUNDP (val)) |
| 1446 { | |
| 1447 rainj.type = CHARTAB_RANGE_CHAR; | |
| 1448 rainj.ch = ch; | |
| 1449 return (fn) (&rainj, table, val, arg); | |
| 1450 } | |
| 1451 else | |
| 1452 return 0; | |
| 428 | 1453 } |
| 1454 | |
| 1455 default: | |
| 2500 | 1456 ABORT (); |
| 428 | 1457 } |
| 1458 | |
| 1459 return 0; | |
| 1460 } | |
| 1461 | |
| 1462 struct slow_map_char_table_arg | |
| 1463 { | |
| 1464 Lisp_Object function; | |
| 1465 Lisp_Object retval; | |
| 1466 }; | |
| 1467 | |
| 1468 static int | |
| 1469 slow_map_char_table_fun (struct chartab_range *range, | |
| 2286 | 1470 Lisp_Object UNUSED (table), Lisp_Object val, |
| 1471 void *arg) | |
| 428 | 1472 { |
| 1473 struct slow_map_char_table_arg *closure = | |
| 1474 (struct slow_map_char_table_arg *) arg; | |
| 1475 | |
| 826 | 1476 closure->retval = call2 (closure->function, encode_char_table_range (range), |
| 1477 val); | |
| 428 | 1478 return !NILP (closure->retval); |
| 1479 } | |
| 1480 | |
| 1481 DEFUN ("map-char-table", Fmap_char_table, 2, 3, 0, /* | |
| 2726 | 1482 Map FUNCTION over CHAR-TABLE until it returns non-nil; return that value. |
| 1483 FUNCTION is called with two arguments, each key and entry in the table. | |
| 1484 | |
| 1485 RANGE specifies a subrange to map over. If omitted or t, it defaults to | |
| 1486 the entire table. | |
| 428 | 1487 |
| 2726 | 1488 Both RANGE and the keys passed to FUNCTION are in the same format as the |
| 1489 RANGE argument to `put-char-table'. N.B. This function does NOT map over | |
| 1490 all characters in RANGE, but over the subranges that have been assigned to. | |
| 1491 Thus this function is most suitable for searching a char-table, or for | |
| 1492 populating one char-table based on the contents of another. The current | |
| 1493 implementation does not coalesce ranges all of whose values are the same. | |
| 428 | 1494 */ |
| 444 | 1495 (function, char_table, range)) |
| 428 | 1496 { |
| 1497 struct slow_map_char_table_arg slarg; | |
| 1498 struct gcpro gcpro1, gcpro2; | |
| 1499 struct chartab_range rainj; | |
| 1500 | |
| 444 | 1501 CHECK_CHAR_TABLE (char_table); |
| 428 | 1502 if (NILP (range)) |
| 1503 range = Qt; | |
| 1504 decode_char_table_range (range, &rainj); | |
| 1505 slarg.function = function; | |
| 1506 slarg.retval = Qnil; | |
| 1507 GCPRO2 (slarg.function, slarg.retval); | |
| 826 | 1508 map_char_table (char_table, &rainj, slow_map_char_table_fun, &slarg); |
| 428 | 1509 UNGCPRO; |
| 1510 | |
| 1511 return slarg.retval; | |
| 1512 } | |
| 1513 | |
| 1514 | |
| 1515 | |
| 1516 /************************************************************************/ | |
| 1517 /* Char table read syntax */ | |
| 1518 /************************************************************************/ | |
| 1519 | |
| 1520 static int | |
| 2286 | 1521 chartab_type_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 1522 Error_Behavior UNUSED (errb)) | |
| 428 | 1523 { |
| 1524 /* #### should deal with ERRB */ | |
| 1525 symbol_to_char_table_type (value); | |
| 1526 return 1; | |
| 1527 } | |
| 1528 | |
| 826 | 1529 /* #### Document the print/read format; esp. what's this cons element? */ |
| 1530 | |
| 428 | 1531 static int |
| 2286 | 1532 chartab_data_validate (Lisp_Object UNUSED (keyword), Lisp_Object value, |
| 1533 Error_Behavior UNUSED (errb)) | |
| 428 | 1534 { |
| 1535 /* #### should deal with ERRB */ | |
| 2367 | 1536 EXTERNAL_PROPERTY_LIST_LOOP_3 (range, data, value) |
| 428 | 1537 { |
| 1538 struct chartab_range dummy; | |
| 1539 | |
| 1540 if (CONSP (range)) | |
| 1541 { | |
| 1542 if (!CONSP (XCDR (range)) | |
| 1543 || !NILP (XCDR (XCDR (range)))) | |
| 563 | 1544 sferror ("Invalid range format", range); |
| 428 | 1545 decode_char_table_range (XCAR (range), &dummy); |
| 1546 decode_char_table_range (XCAR (XCDR (range)), &dummy); | |
| 1547 } | |
| 1548 else | |
| 1549 decode_char_table_range (range, &dummy); | |
| 1550 } | |
| 1551 | |
| 1552 return 1; | |
| 1553 } | |
| 1554 | |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1555 static int |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1556 chartab_default_validate (Lisp_Object UNUSED (keyword), |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1557 Lisp_Object UNUSED (value), |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1558 Error_Behavior UNUSED (errb)) |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1559 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1560 /* We can't yet validate this, since we don't know what the type of the |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1561 char table is. We do the validation below in chartab_instantiate(). */ |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1562 return 1; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1563 } |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1564 |
| 428 | 1565 static Lisp_Object |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1566 chartab_instantiate (Lisp_Object plist) |
| 428 | 1567 { |
| 1568 Lisp_Object chartab; | |
| 1569 Lisp_Object type = Qgeneric; | |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1570 Lisp_Object dataval = Qnil, default_ = Qunbound; |
| 428 | 1571 |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1572 if (KEYWORDP (Fcar (plist))) |
| 428 | 1573 { |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1574 PROPERTY_LIST_LOOP_3 (key, value, plist) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1575 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1576 if (EQ (key, Q_data)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1577 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1578 dataval = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1579 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1580 else if (EQ (key, Q_type)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1581 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1582 type = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1583 } |
|
5320
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1584 else if (EQ (key, Q_default_)) |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1585 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1586 default_ = value; |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1587 } |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1588 else if (!KEYWORDP (key)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1589 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1590 signal_error |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1591 (Qinvalid_read_syntax, |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1592 "can't mix keyword and non-keyword structure syntax", |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1593 key); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1594 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1595 else |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1596 ABORT (); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1597 } |
| 428 | 1598 } |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1599 #ifdef NEED_TO_HANDLE_21_4_CODE |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1600 else |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1601 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1602 PROPERTY_LIST_LOOP_3 (key, value, plist) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1603 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1604 if (EQ (key, Qdata)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1605 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1606 dataval = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1607 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1608 else if (EQ (key, Qtype)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1609 { |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1610 type = value; |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1611 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1612 else if (KEYWORDP (key)) |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1613 signal_error |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1614 (Qinvalid_read_syntax, |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1615 "can't mix keyword and non-keyword structure syntax", |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1616 key); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1617 else |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1618 ABORT (); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1619 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1620 } |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1621 #endif /* NEED_TO_HANDLE_21_4_CODE */ |
| 428 | 1622 |
| 1623 chartab = Fmake_char_table (type); | |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1624 if (!UNBOUNDP (default_)) |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1625 { |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1626 check_valid_char_table_value (default_, XCHAR_TABLE_TYPE (chartab), |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1627 ERROR_ME); |
|
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1628 set_char_table_default (chartab, default_); |
|
5320
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1629 if (!NILP (XCHAR_TABLE (chartab)->mirror_table)) |
|
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1630 { |
|
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1631 set_char_table_default (XCHAR_TABLE (chartab)->mirror_table, |
|
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1632 default_); |
|
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1633 } |
|
5259
02c282ae97cb
Read and print char table defaults, chartab.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5222
diff
changeset
|
1634 } |
| 428 | 1635 |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1636 while (!NILP (dataval)) |
| 428 | 1637 { |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1638 Lisp_Object range = Fcar (dataval); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1639 Lisp_Object val = Fcar (Fcdr (dataval)); |
| 428 | 1640 |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1641 dataval = Fcdr (Fcdr (dataval)); |
| 428 | 1642 if (CONSP (range)) |
| 1643 { | |
| 1644 if (CHAR_OR_CHAR_INTP (XCAR (range))) | |
| 1645 { | |
| 867 | 1646 Ichar first = XCHAR_OR_CHAR_INT (Fcar (range)); |
| 1647 Ichar last = XCHAR_OR_CHAR_INT (Fcar (Fcdr (range))); | |
| 1648 Ichar i; | |
| 428 | 1649 |
| 1650 for (i = first; i <= last; i++) | |
| 1651 Fput_char_table (make_char (i), val, chartab); | |
| 1652 } | |
| 1653 else | |
| 2500 | 1654 ABORT (); |
| 428 | 1655 } |
| 1656 else | |
| 1657 Fput_char_table (range, val, chartab); | |
| 1658 } | |
| 1659 | |
| 1660 return chartab; | |
| 1661 } | |
| 1662 | |
| 1663 #ifdef MULE | |
| 1664 | |
| 1665 | |
| 1666 /************************************************************************/ | |
| 1667 /* Category Tables, specifically */ | |
| 1668 /************************************************************************/ | |
| 1669 | |
| 1670 DEFUN ("category-table-p", Fcategory_table_p, 1, 1, 0, /* | |
| 444 | 1671 Return t if OBJECT is a category table. |
| 428 | 1672 A category table is a type of char table used for keeping track of |
| 1673 categories. Categories are used for classifying characters for use | |
| 1674 in regexps -- you can refer to a category rather than having to use | |
| 1675 a complicated [] expression (and category lookups are significantly | |
| 1676 faster). | |
| 1677 | |
| 1678 There are 95 different categories available, one for each printable | |
| 1679 character (including space) in the ASCII charset. Each category | |
| 1680 is designated by one such character, called a "category designator". | |
| 1681 They are specified in a regexp using the syntax "\\cX", where X is | |
| 1682 a category designator. | |
| 1683 | |
| 1684 A category table specifies, for each character, the categories that | |
| 1685 the character is in. Note that a character can be in more than one | |
| 1686 category. More specifically, a category table maps from a character | |
| 1687 to either the value nil (meaning the character is in no categories) | |
| 1688 or a 95-element bit vector, specifying for each of the 95 categories | |
| 1689 whether the character is in that category. | |
| 1690 | |
| 1691 Special Lisp functions are provided that abstract this, so you do not | |
| 1692 have to directly manipulate bit vectors. | |
| 1693 */ | |
| 444 | 1694 (object)) |
| 428 | 1695 { |
| 444 | 1696 return (CHAR_TABLEP (object) && |
| 1697 XCHAR_TABLE_TYPE (object) == CHAR_TABLE_TYPE_CATEGORY) ? | |
| 428 | 1698 Qt : Qnil; |
| 1699 } | |
| 1700 | |
| 1701 static Lisp_Object | |
| 444 | 1702 check_category_table (Lisp_Object object, Lisp_Object default_) |
| 428 | 1703 { |
| 444 | 1704 if (NILP (object)) |
| 1705 object = default_; | |
| 1706 while (NILP (Fcategory_table_p (object))) | |
| 1707 object = wrong_type_argument (Qcategory_table_p, object); | |
| 1708 return object; | |
| 428 | 1709 } |
| 1710 | |
| 1711 int | |
| 867 | 1712 check_category_char (Ichar ch, Lisp_Object table, |
| 647 | 1713 int designator, int not_p) |
| 428 | 1714 { |
| 1715 REGISTER Lisp_Object temp; | |
| 1716 if (NILP (Fcategory_table_p (table))) | |
| 563 | 1717 wtaerror ("Expected category table", table); |
| 826 | 1718 temp = get_char_table (ch, table); |
| 428 | 1719 if (NILP (temp)) |
| 458 | 1720 return not_p; |
| 428 | 1721 |
| 1722 designator -= ' '; | |
| 458 | 1723 return bit_vector_bit (XBIT_VECTOR (temp), designator) ? !not_p : not_p; |
| 428 | 1724 } |
| 1725 | |
| 1726 DEFUN ("check-category-at", Fcheck_category_at, 2, 4, 0, /* | |
| 444 | 1727 Return t if category of the character at POSITION includes DESIGNATOR. |
| 1728 Optional third arg BUFFER specifies which buffer to use, and defaults | |
| 1729 to the current buffer. | |
| 1730 Optional fourth arg CATEGORY-TABLE specifies the category table to | |
| 1731 use, and defaults to BUFFER's category table. | |
| 428 | 1732 */ |
| 444 | 1733 (position, designator, buffer, category_table)) |
| 428 | 1734 { |
| 1735 Lisp_Object ctbl; | |
| 867 | 1736 Ichar ch; |
| 647 | 1737 int des; |
| 428 | 1738 struct buffer *buf = decode_buffer (buffer, 0); |
| 1739 | |
| 444 | 1740 CHECK_INT (position); |
| 428 | 1741 CHECK_CATEGORY_DESIGNATOR (designator); |
| 1742 des = XCHAR (designator); | |
| 788 | 1743 ctbl = check_category_table (category_table, buf->category_table); |
| 444 | 1744 ch = BUF_FETCH_CHAR (buf, XINT (position)); |
| 428 | 1745 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; |
| 1746 } | |
| 1747 | |
| 1748 DEFUN ("char-in-category-p", Fchar_in_category_p, 2, 3, 0, /* | |
| 788 | 1749 Return non-nil if category of CHARACTER includes DESIGNATOR. |
| 444 | 1750 Optional third arg CATEGORY-TABLE specifies the category table to use, |
| 788 | 1751 and defaults to the current buffer's category table. |
| 428 | 1752 */ |
| 444 | 1753 (character, designator, category_table)) |
| 428 | 1754 { |
| 1755 Lisp_Object ctbl; | |
| 867 | 1756 Ichar ch; |
| 647 | 1757 int des; |
| 428 | 1758 |
| 1759 CHECK_CATEGORY_DESIGNATOR (designator); | |
| 1760 des = XCHAR (designator); | |
| 444 | 1761 CHECK_CHAR (character); |
| 1762 ch = XCHAR (character); | |
| 788 | 1763 ctbl = check_category_table (category_table, current_buffer->category_table); |
| 428 | 1764 return check_category_char (ch, ctbl, des, 0) ? Qt : Qnil; |
| 1765 } | |
| 1766 | |
| 1767 DEFUN ("category-table", Fcategory_table, 0, 1, 0, /* | |
| 444 | 1768 Return BUFFER's current category table. |
| 1769 BUFFER defaults to the current buffer. | |
| 428 | 1770 */ |
| 1771 (buffer)) | |
| 1772 { | |
| 1773 return decode_buffer (buffer, 0)->category_table; | |
| 1774 } | |
| 1775 | |
| 1776 DEFUN ("standard-category-table", Fstandard_category_table, 0, 0, 0, /* | |
| 1777 Return the standard category table. | |
| 1778 This is the one used for new buffers. | |
| 1779 */ | |
| 1780 ()) | |
| 1781 { | |
| 1782 return Vstandard_category_table; | |
| 1783 } | |
| 1784 | |
| 1785 DEFUN ("copy-category-table", Fcopy_category_table, 0, 1, 0, /* | |
| 444 | 1786 Return a new category table which is a copy of CATEGORY-TABLE. |
| 1787 CATEGORY-TABLE defaults to the standard category table. | |
| 428 | 1788 */ |
| 444 | 1789 (category_table)) |
| 428 | 1790 { |
| 1791 if (NILP (Vstandard_category_table)) | |
| 1792 return Fmake_char_table (Qcategory); | |
| 1793 | |
| 444 | 1794 category_table = |
| 1795 check_category_table (category_table, Vstandard_category_table); | |
| 1796 return Fcopy_char_table (category_table); | |
| 428 | 1797 } |
| 1798 | |
| 1799 DEFUN ("set-category-table", Fset_category_table, 1, 2, 0, /* | |
| 444 | 1800 Select CATEGORY-TABLE as the new category table for BUFFER. |
| 428 | 1801 BUFFER defaults to the current buffer if omitted. |
| 1802 */ | |
| 444 | 1803 (category_table, buffer)) |
| 428 | 1804 { |
| 1805 struct buffer *buf = decode_buffer (buffer, 0); | |
| 444 | 1806 category_table = check_category_table (category_table, Qnil); |
| 1807 buf->category_table = category_table; | |
| 428 | 1808 /* Indicate that this buffer now has a specified category table. */ |
| 1809 buf->local_var_flags |= XINT (buffer_local_flags.category_table); | |
| 444 | 1810 return category_table; |
| 428 | 1811 } |
| 1812 | |
| 1813 DEFUN ("category-designator-p", Fcategory_designator_p, 1, 1, 0, /* | |
| 444 | 1814 Return t if OBJECT is a category designator (a char in the range ' ' to '~'). |
| 428 | 1815 */ |
| 444 | 1816 (object)) |
| 428 | 1817 { |
| 444 | 1818 return CATEGORY_DESIGNATORP (object) ? Qt : Qnil; |
| 428 | 1819 } |
| 1820 | |
| 1821 DEFUN ("category-table-value-p", Fcategory_table_value_p, 1, 1, 0, /* | |
| 444 | 1822 Return t if OBJECT is a category table value. |
| 428 | 1823 Valid values are nil or a bit vector of size 95. |
| 1824 */ | |
| 444 | 1825 (object)) |
| 428 | 1826 { |
| 444 | 1827 return CATEGORY_TABLE_VALUEP (object) ? Qt : Qnil; |
| 428 | 1828 } |
| 1829 | |
| 1830 | |
| 1831 #define CATEGORYP(x) \ | |
| 1832 (CHARP (x) && XCHAR (x) >= 0x20 && XCHAR (x) <= 0x7E) | |
| 1833 | |
| 826 | 1834 #define CATEGORY_SET(c) get_char_table (c, current_buffer->category_table) |
| 428 | 1835 |
| 1836 /* Return 1 if CATEGORY_SET contains CATEGORY, else return 0. | |
| 1837 The faster version of `!NILP (Faref (category_set, category))'. */ | |
| 1838 #define CATEGORY_MEMBER(category, category_set) \ | |
| 1839 (bit_vector_bit(XBIT_VECTOR (category_set), category - 32)) | |
| 1840 | |
| 1841 /* Return 1 if there is a word boundary between two word-constituent | |
| 1842 characters C1 and C2 if they appear in this order, else return 0. | |
| 1843 Use the macro WORD_BOUNDARY_P instead of calling this function | |
| 1844 directly. */ | |
| 1845 | |
| 1846 int | |
| 867 | 1847 word_boundary_p (Ichar c1, Ichar c2) |
| 428 | 1848 { |
| 1849 Lisp_Object category_set1, category_set2; | |
| 1850 Lisp_Object tail; | |
| 1851 int default_result; | |
| 1852 | |
| 1853 #if 0 | |
| 1854 if (COMPOSITE_CHAR_P (c1)) | |
| 1855 c1 = cmpchar_component (c1, 0, 1); | |
| 1856 if (COMPOSITE_CHAR_P (c2)) | |
| 1857 c2 = cmpchar_component (c2, 0, 1); | |
| 1858 #endif | |
| 1859 | |
| 867 | 1860 if (EQ (ichar_charset (c1), ichar_charset (c2))) |
| 428 | 1861 { |
| 1862 tail = Vword_separating_categories; | |
| 1863 default_result = 0; | |
| 1864 } | |
| 1865 else | |
| 1866 { | |
| 1867 tail = Vword_combining_categories; | |
| 1868 default_result = 1; | |
| 1869 } | |
| 1870 | |
| 1871 category_set1 = CATEGORY_SET (c1); | |
| 1872 if (NILP (category_set1)) | |
| 1873 return default_result; | |
| 1874 category_set2 = CATEGORY_SET (c2); | |
| 1875 if (NILP (category_set2)) | |
| 1876 return default_result; | |
| 1877 | |
| 853 | 1878 for (; CONSP (tail); tail = XCDR (tail)) |
| 428 | 1879 { |
| 853 | 1880 Lisp_Object elt = XCAR (tail); |
| 428 | 1881 |
| 1882 if (CONSP (elt) | |
| 853 | 1883 && CATEGORYP (XCAR (elt)) |
| 1884 && CATEGORYP (XCDR (elt)) | |
| 1885 && CATEGORY_MEMBER (XCHAR (XCAR (elt)), category_set1) | |
| 1886 && CATEGORY_MEMBER (XCHAR (XCDR (elt)), category_set2)) | |
| 428 | 1887 return !default_result; |
| 1888 } | |
| 1889 return default_result; | |
| 1890 } | |
| 1891 #endif /* MULE */ | |
| 1892 | |
| 1893 | |
| 1894 void | |
| 1895 syms_of_chartab (void) | |
| 1896 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1897 INIT_LISP_OBJECT (char_table); |
| 442 | 1898 |
| 428 | 1899 #ifdef MULE |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
1900 INIT_LISP_OBJECT (char_table_entry); |
| 442 | 1901 |
| 563 | 1902 DEFSYMBOL (Qcategory_table_p); |
| 1903 DEFSYMBOL (Qcategory_designator_p); | |
| 1904 DEFSYMBOL (Qcategory_table_value_p); | |
| 428 | 1905 #endif /* MULE */ |
| 1906 | |
| 563 | 1907 DEFSYMBOL (Qchar_table); |
| 1908 DEFSYMBOL_MULTIWORD_PREDICATE (Qchar_tablep); | |
| 428 | 1909 |
| 1910 DEFSUBR (Fchar_table_p); | |
| 1911 DEFSUBR (Fchar_table_type_list); | |
| 1912 DEFSUBR (Fvalid_char_table_type_p); | |
| 1913 DEFSUBR (Fchar_table_type); | |
| 826 | 1914 DEFSUBR (Fchar_table_default); |
| 1915 DEFSUBR (Fset_char_table_default); | |
| 428 | 1916 DEFSUBR (Freset_char_table); |
| 1917 DEFSUBR (Fmake_char_table); | |
| 1918 DEFSUBR (Fcopy_char_table); | |
| 1919 DEFSUBR (Fget_char_table); | |
| 1920 DEFSUBR (Fget_range_char_table); | |
| 1921 DEFSUBR (Fvalid_char_table_value_p); | |
| 1922 DEFSUBR (Fcheck_valid_char_table_value); | |
| 1923 DEFSUBR (Fput_char_table); | |
| 826 | 1924 DEFSUBR (Fremove_char_table); |
| 428 | 1925 DEFSUBR (Fmap_char_table); |
| 1926 | |
| 1927 #ifdef MULE | |
| 1928 DEFSUBR (Fcategory_table_p); | |
| 1929 DEFSUBR (Fcategory_table); | |
| 1930 DEFSUBR (Fstandard_category_table); | |
| 1931 DEFSUBR (Fcopy_category_table); | |
| 1932 DEFSUBR (Fset_category_table); | |
| 1933 DEFSUBR (Fcheck_category_at); | |
| 1934 DEFSUBR (Fchar_in_category_p); | |
| 1935 DEFSUBR (Fcategory_designator_p); | |
| 1936 DEFSUBR (Fcategory_table_value_p); | |
| 1937 #endif /* MULE */ | |
| 1938 | |
| 1939 } | |
| 1940 | |
| 1941 void | |
| 1942 vars_of_chartab (void) | |
| 1943 { | |
| 1944 /* DO NOT staticpro this. It works just like Vweak_hash_tables. */ | |
| 1945 Vall_syntax_tables = Qnil; | |
| 452 | 1946 dump_add_weak_object_chain (&Vall_syntax_tables); |
| 428 | 1947 } |
| 1948 | |
| 1949 void | |
| 1950 structure_type_create_chartab (void) | |
| 1951 { | |
| 1952 struct structure_type *st; | |
| 1953 | |
| 1954 st = define_structure_type (Qchar_table, 0, chartab_instantiate); | |
| 1955 | |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1956 #ifdef NEED_TO_HANDLE_21_4_CODE |
| 428 | 1957 define_structure_type_keyword (st, Qtype, chartab_type_validate); |
| 1958 define_structure_type_keyword (st, Qdata, chartab_data_validate); | |
|
5222
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1959 #endif /* NEED_TO_HANDLE_21_4_CODE */ |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1960 |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1961 define_structure_type_keyword (st, Q_type, chartab_type_validate); |
|
18c0b5909d16
Use keywords in structure syntax; new #define, NEED_TO_HANDLE_21_4_CODE 1
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
1962 define_structure_type_keyword (st, Q_data, chartab_data_validate); |
|
5320
31be2a3d121d
Move Qcount, Q_default, Q_test to general-slots.h; add SYMBOL_KEYWORD_GENERAL()
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
1963 define_structure_type_keyword (st, Q_default_, chartab_default_validate); |
| 428 | 1964 } |
| 1965 | |
| 1966 void | |
| 1967 complex_vars_of_chartab (void) | |
| 1968 { | |
| 1969 #ifdef MULE | |
| 1970 /* Set this now, so first buffer creation can refer to it. */ | |
| 1971 /* Make it nil before calling copy-category-table | |
| 1972 so that copy-category-table will know not to try to copy from garbage */ | |
| 1973 Vstandard_category_table = Qnil; | |
| 1974 Vstandard_category_table = Fcopy_category_table (Qnil); | |
| 1975 staticpro (&Vstandard_category_table); | |
| 1976 | |
| 1977 DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories /* | |
| 1978 List of pair (cons) of categories to determine word boundary. | |
| 1979 | |
| 1980 Emacs treats a sequence of word constituent characters as a single | |
| 1981 word (i.e. finds no word boundary between them) iff they belongs to | |
| 1982 the same charset. But, exceptions are allowed in the following cases. | |
| 1983 | |
| 444 | 1984 \(1) The case that characters are in different charsets is controlled |
| 428 | 1985 by the variable `word-combining-categories'. |
| 1986 | |
| 1987 Emacs finds no word boundary between characters of different charsets | |
| 1988 if they have categories matching some element of this list. | |
| 1989 | |
| 1990 More precisely, if an element of this list is a cons of category CAT1 | |
| 1991 and CAT2, and a multibyte character C1 which has CAT1 is followed by | |
| 1992 C2 which has CAT2, there's no word boundary between C1 and C2. | |
| 1993 | |
| 1994 For instance, to tell that ASCII characters and Latin-1 characters can | |
| 1995 form a single word, the element `(?l . ?l)' should be in this list | |
| 1996 because both characters have the category `l' (Latin characters). | |
| 1997 | |
| 444 | 1998 \(2) The case that character are in the same charset is controlled by |
| 428 | 1999 the variable `word-separating-categories'. |
| 2000 | |
| 2001 Emacs find a word boundary between characters of the same charset | |
| 2002 if they have categories matching some element of this list. | |
| 2003 | |
| 2004 More precisely, if an element of this list is a cons of category CAT1 | |
| 2005 and CAT2, and a multibyte character C1 which has CAT1 is followed by | |
| 2006 C2 which has CAT2, there's a word boundary between C1 and C2. | |
| 2007 | |
| 2008 For instance, to tell that there's a word boundary between Japanese | |
| 2009 Hiragana and Japanese Kanji (both are in the same charset), the | |
| 2010 element `(?H . ?C) should be in this list. | |
| 2011 */ ); | |
| 2012 | |
| 2013 Vword_combining_categories = Qnil; | |
| 2014 | |
| 2015 DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories /* | |
| 2016 List of pair (cons) of categories to determine word boundary. | |
| 2017 See the documentation of the variable `word-combining-categories'. | |
| 2018 */ ); | |
| 2019 | |
| 2020 Vword_separating_categories = Qnil; | |
| 2021 #endif /* MULE */ | |
| 2022 } |