Mercurial > hg > xemacs-beta
annotate src/chartab.c @ 5353:38e24b8be4ea
Improve the lexical scoping in #'block, #'return-from.
lisp/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (byte-compile-initial-macro-environment):
Shadow `block', `return-from' here, we implement them differently
when byte-compiling.
* bytecomp.el (byte-compile-active-blocks): New.
* bytecomp.el (byte-compile-block-1): New.
* bytecomp.el (byte-compile-return-from-1): New.
* bytecomp.el (return-from-1): New.
* bytecomp.el (block-1): New.
These are two aliases that exist to have their own associated
byte-compile functions, which functions implement `block' and
`return-from'.
* cl-extra.el (cl-macroexpand-all):
Fix a bug here when macros in the environment have been compiled.
* cl-macs.el (block):
* cl-macs.el (return):
* cl-macs.el (return-from):
Be more careful about lexical scope in these macros.
* cl.el:
* cl.el ('cl-block-wrapper): Removed.
* cl.el ('cl-block-throw): Removed.
These aren't needed in code generated by this XEmacs. They
shouldn't be needed in code generated by XEmacs 21.4, but if it
turns out the packages do need them, we can put them back.
2011-01-30 Mike Sperber <mike@xemacs.org>
* font-lock.el (font-lock-fontify-pending-extents): Don't fail if
`font-lock-mode' is unset, which can happen in the middle of
`revert-buffer'.
2011-01-23 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete):
* cl-macs.el (delq):
* cl-macs.el (remove):
* cl-macs.el (remq):
Don't use the compiler macro if these functions were given the
wrong number of arguments, as happens in lisp-tests.el.
* cl-seq.el (remove, remq): Removed.
I added these to subr.el, and forgot to remove them from here.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-setq, byte-compile-set):
Remove kludge allowing keywords' values to be set, all the code
that does that is gone.
* cl-compat.el (elt-satisfies-test-p):
* faces.el (set-face-parent):
* faces.el (face-doc-string):
* gtk-font-menu.el:
* gtk-font-menu.el (gtk-reset-device-font-menus):
* msw-font-menu.el:
* msw-font-menu.el (mswindows-reset-device-font-menus):
* package-get.el (package-get-installedp):
* select.el (select-convert-from-image-data):
* sound.el:
* sound.el (load-sound-file):
* x-font-menu.el (x-reset-device-font-menus-core):
Don't quote keywords, they're self-quoting, and the
win from backward-compatibility is sufficiently small now that the
style problem overrides it.
2011-01-22 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (block, return-from): Require that NAME be a symbol
in these macros, as always documented in the #'block docstring and
as required by Common Lisp.
* descr-text.el (unidata-initialize-unihan-database):
Correct the use of non-symbols in #'block and #'return-from in
this function.
2011-01-15 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (concatenate): Accept more complicated TYPEs in this
function, handing the sequences over to #'coerce if we don't
understand them here.
* cl-macs.el (inline): Don't proclaim #'concatenate as inline, its
compiler macro is more useful than doing that.
2011-01-11 Aidan Kehoe <kehoea@parhasard.net>
* subr.el (delete, delq, remove, remq): Move #'remove, #'remq
here, they don't belong in cl-seq.el; move #'delete, #'delq here
from fns.c, implement them in terms of #'delete*, allowing support
for sequences generally.
* update-elc.el (do-autoload-commands): Use #'delete*, not #'delq
here, now the latter's no longer dumped.
* cl-macs.el (delete, delq): Add compiler macros transforming
#'delete and #'delq to #'delete* calls.
2011-01-10 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box): Correct a misplaced parenthesis
here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se !
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* dialog.el (make-dialog-box):
* list-mode.el (display-completion-list):
These functions used to use cl-parsing-keywords; change them to
use defun* instead, fixing the build. (Not sure what led to me
not including this change in d1b17a33450b!)
2011-01-02 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (define-star-compiler-macros):
Make sure the form has ITEM and LIST specified before attempting
to change to calls with explicit tests; necessary for some tests
in lisp-tests.el to compile correctly.
(stable-union, stable-intersection): Add compiler macros for these
functions, in the same way we do for most of the other functions
in cl-seq.el.
2011-01-01 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (dolist, dotimes, do-symbols, macrolet)
(symbol-macrolet):
Define these macros with defmacro* instead of parsing the argument
list by hand, for the sake of style and readability; use backquote
where appropriate, instead of calling #'list and and friends, for
the same reason.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* x-misc.el (device-x-display):
Provide this function, documented in the Lispref for years, but
not existing previously. Thank you Julian Bradfield, thank you
Jeff Mincy.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* simple.el (assoc-ignore-case): Remove a duplicate definition of
this function (it's already in subr.el).
* iso8859-1.el (char-width):
On non-Mule, make this function equivalent to that produced by
(constantly 1), but preserve its docstring.
* subr.el (subst-char-in-string): Define this in terms of
#'substitute, #'nsubstitute.
(string-width): Define this using #'reduce and #'char-width.
(char-width): Give this a simpler definition, it makes far more
sense to check for mule at load time and redefine, as we do in
iso8859-1.el.
(store-substring): Implement this in terms of #'replace, now
#'replace is cheap.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* update-elc.el (lisp-files-needed-for-byte-compilation)
(lisp-files-needing-early-byte-compilation):
cl-macs belongs in the former, not the latter, it is as
fundamental as bytecomp.el.
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl.el:
Provde the Common Lisp program-error, type-error as error
symbols. This doesn't nearly go far enough for anyone using the
Common Lisp errors.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (delete-duplicates):
If the form has an incorrect number of arguments, don't attempt a
compiler macroexpansion.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-safe-expr-p):
Forms that start with the symbol lambda are also safe.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
For these functions' compiler macros, the optimisation is safe
even if the first and the last arguments have side effects, since
they're only used the once.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (inline-side-effect-free-compiler-macros):
Unroll a loop here at macro-expansion time, so these compiler
macros are compiled. Use #'eql instead of #'eq in a couple of
places for better style.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (notany, notevery): Avoid some dynamic scope
stupidity with local variable names in these functions, when they
weren't prefixed with cl-; go into some more detail in the doc
strings.
2010-12-29 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns): #'remove, #'remq are
free of side-effects.
(side-effect-and-error-free-fns):
Drop dot, dot-marker from the list.
2010-11-17 Aidan Kehoe <kehoea@parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
2010-11-14 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
symbol. That was necessary to override a bug in bytecomp.el where
#'eql was confused with #'eq, which bug we no longer have.
If neither expression is constant, don't attempt to handle the
expression in this compiler macro, leave it to byte-compile-eql,
which produces better code anyway.
* bytecomp.el (eq): #'eql is not the function associated with the
byte-eq byte code.
(byte-compile-eql): Add an explicit compile method for this
function, for cases where the cl-macs compiler macro hasn't
reduced it to #'eq or #'equal.
2010-10-25 Aidan Kehoe <kehoea@parhasard.net>
Add compiler macros and compilation sanity-checking for various
functions that take keywords.
* byte-optimize.el (side-effect-free-fns): #'symbol-value is
side-effect free and not error free.
* bytecomp.el (byte-compile-normal-call): Check keyword argument
lists for sanity; store information about the positions where
keyword arguments start using the new byte-compile-keyword-start
property.
* cl-macs.el (cl-const-expr-val): Take a new optional argument,
cl-not-constant, defaulting to nil, in this function; return it if
the expression is not constant.
(cl-non-fixnum-number-p): Make this into a separate function, we
want to pass it to #'every.
(eql): Use it.
(define-star-compiler-macros): Use the same code to generate the
member*, assoc* and rassoc* compiler macros; special-case some
code in #'add-to-list in subr.el.
(remove, remq): Add compiler macros for these two functions, in
preparation for #'remove being in C.
(define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to
(remove ... :if-not) at compile time, which will be a real win
once the latter is in C.
(define-substitute-if-compiler-macros)
(define-subst-if-compiler-macros): Similarly for these functions.
(delete-duplicates): Change this compiler macro to use
#'plists-equal; if we don't have information about the type of
SEQUENCE at compile time, don't bother attempting to inline the
call, the function will be in C soon enough.
(equalp): Remove an old commented-out compiler macro for this, if
we want to see it it's in version control.
(subst-char-in-string): Transform this to a call to nsubstitute or
nsubstitute, if that is appropriate.
* cl.el (ldiff): Don't call setf here, this makes for a load-time
dependency problem in cl-macs.el
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* term/vt100.el:
Refer to XEmacs, not GNU Emacs, in permissions.
* term/bg-mouse.el:
* term/sup-mouse.el:
Put copyright notice in canonical "Copyright DATE AUTHOR" form.
Refer to XEmacs, not GNU Emacs, in permissions.
* site-load.el:
Add permission boilerplate.
* mule/canna-leim.el:
* alist.el:
Refer to XEmacs, not APEL/this program, in permissions.
* mule/canna-leim.el:
Remove my copyright, I've assigned it to the FSF.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* gtk.el:
* gtk-widget-accessors.el:
* gtk-package.el:
* gtk-marshal.el:
* gtk-compose.el:
* gnome.el:
Add copyright notice based on internal evidence.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* easymenu.el: Add reference to COPYING to permission notice.
* gutter.el:
* gutter-items.el:
* menubar-items.el:
Fix typo "Xmacs" in permissions notice.
2010-06-14 Stephen J. Turnbull <stephen@xemacs.org>
* auto-save.el:
* font.el:
* fontconfig.el:
* mule/kinsoku.el:
Add "part of XEmacs" text to permission notice.
2010-10-14 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (side-effect-free-fns):
* cl-macs.el (remf, getf):
* cl-extra.el (tailp, cl-set-getf, cl-do-remf):
* cl.el (ldiff, endp):
Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp;
add circularity checking for the first two.
#'cl-set-getf and #'cl-do-remf were Lisp implementations of
#'plist-put and #'plist-remprop; change the names to aliases,
changes the macros that use them to using #'plist-put and
#'plist-remprop directly.
2010-10-12 Aidan Kehoe <kehoea@parhasard.net>
* abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table):
Create both these abbrev tables using the usual
#'define-abbrev-table calls, rather than attempting to
special-case them.
* cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is
being loaded interpreted. Previously other, later files would
redundantly call (load "cl-macs") when interpreted, it's more
reasonable to do it here, once.
* cmdloop.el (read-quoted-char-radix): Use defcustom here, we
don't have any dump-order dependencies that would prevent that.
* custom.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling, rely on cl-extra.el in the
former case and the appropriate entry in bytecomp-load-hook in the
latter. Get rid of custom-declare-variable-list, we have no
dump-time dependencies that would require it.
* faces.el (eval-when-compile): Don't load cl-macs when
interpreted or when byte-compiling.
* packages.el: Remove some inaccurate comments.
* post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not
here, now the order of preloaded-file-list has been changed to
make it available.
* subr.el (custom-declare-variable-list): Remove. No need for it.
Also remove a stub define-abbrev-table from this file, given the
current order of preloaded-file-list there's no need for it.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are
also constant.
(byte-compile-initial-macro-environment): In #'the, if FORM is
constant and does not match TYPE, warn at byte-compile time.
2010-10-10 Aidan Kehoe <kehoea@parhasard.net>
* backquote.el (bq-vector-contents, bq-list*): Remove; the former
is equivalent to (append VECTOR nil), the latter to (list* ...).
(bq-process-2): Use (append VECTOR nil) instead of using
#'bq-vector-contents to convert to a list.
(bq-process-1): Now we use list* instead of bq-list
* subr.el (list*): Moved from cl.el, since it is now required to
be available the first time a backquoted form is encountered.
* cl.el (list*): Move to subr.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* test-harness.el (Check-Message):
Add an omitted comma here, thank you the buildbot.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* hash-table.el (hash-table-key-list, hash-table-value-list)
(hash-table-key-value-alist, hash-table-key-value-plist):
Remove some useless #'nreverse calls in these files; our hash
tables have no order, it's not helpful to pretend they do.
* behavior.el (read-behavior):
Do the same in this file, in some code evidently copied from
hash-table.el.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* info.el (Info-insert-dir):
* format.el (format-deannotate-region):
* files.el (cd, save-buffers-kill-emacs):
Use #'some, #'every and related functions for applying boolean
operations to lists, instead of rolling our own ones that cons and
don't short-circuit.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-initial-macro-environment):
* cl-macs.el (the):
Rephrase the docstring, make its implementation when compiling
files a little nicer.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* descr-text.el (unidata-initialize-unicodedata-database)
(unidata-initialize-unihan-database, describe-char-unicode-data)
(describe-char-unicode-data):
Wrap calls to the database functions with (with-fboundp ...),
avoiding byte compile warnings on builds without support for the
database functions.
(describe-char): (reduce #'max ...), not (apply #'max ...), no
need to cons needlessly.
(describe-char): Remove a redundant lambda wrapping
#'extent-properties.
(describe-char-unicode-data): Call #'nsubst when replacing "" with
nil in the result of #'split-string, instead of consing inside
mapcar.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* x-faces.el (x-available-font-sizes):
* specifier.el (let-specifier):
* package-ui.el (pui-add-required-packages):
* msw-faces.el (mswindows-available-font-sizes):
* modeline.el (modeline-minor-mode-menu):
* minibuf.el (minibuf-directory-files):
Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with
the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (= < > <= >=):
When these functions are handed more than two arguments, and those
arguments have no side effects, transform to a series of two
argument calls, avoiding funcall in the byte-compiled code.
* mule/mule-cmds.el (finish-set-language-environment):
Take advantage of this change in a function called 256 times at
startup.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-function-form, byte-compile-quote)
(byte-compile-quote-form):
Warn at compile time, and error at runtime, if a (quote ...) or a
(function ...) form attempts to quote more than one object.
2010-09-16 Aidan Kehoe <kehoea@parhasard.net>
* byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc
(mapcar ...)) to (mapcan ...); warn about use of the first idiom.
* update-elc.el (do-autoload-commands):
* packages.el (packages-find-package-library-path):
* frame.el (frame-list):
* extents.el (extent-descendants):
* etags.el (buffer-tag-table-files):
* dumped-lisp.el (preloaded-file-list):
* device.el (device-list):
* bytecomp-runtime.el (proclaim-inline, proclaim-notinline)
Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files.
* bytecomp-runtime.el (eval-when-compile, eval-and-compile):
In passing, mention that these macros also evaluate the body when
interpreted.
tests/ChangeLog addition:
2011-02-07 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Test lexical scope for `block', `return-from'; add a
Known-Bug-Expect-Failure for a contorted example that fails when
byte-compiled.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Mon, 07 Feb 2011 12:01:24 +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 } |