summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorKarl Heuer <kwzh@gnu.org>1997-02-20 07:02:49 +0000
committerKarl Heuer <kwzh@gnu.org>1997-02-20 07:02:49 +0000
commit4ed4686978bd18292e2bb7b87a7b0e0407ecb3b1 (patch)
tree860ad83f81c8c630fe7051e3c5379ca8a9658f69 /src
parentadb572fb93ddfee88f9c5e9681434517fd241232 (diff)
downloademacs-4ed4686978bd18292e2bb7b87a7b0e0407ecb3b1.tar.gz
Initial revision
Diffstat (limited to 'src')
-rw-r--r--src/category.c665
-rw-r--r--src/category.h130
-rw-r--r--src/ccl.c1140
-rw-r--r--src/ccl.h53
-rw-r--r--src/charset.c1452
-rw-r--r--src/charset.h649
-rw-r--r--src/coding.c3520
-rw-r--r--src/coding.h409
-rw-r--r--src/fontset.c819
-rw-r--r--src/fontset.h201
10 files changed, 9038 insertions, 0 deletions
diff --git a/src/category.c b/src/category.c
new file mode 100644
index 00000000000..8bdaee9e5af
--- /dev/null
+++ b/src/category.c
@@ -0,0 +1,665 @@
+/* GNU Emacs routines to deal with category tables.
+ Ver.1.0
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+/* Here we handle three objects: category, category set, and category
+ table. Read comments in the file category.h to understand them. */
+
+#include <config.h>
+#include <ctype.h>
+#include "lisp.h"
+#include "buffer.h"
+#include "charset.h"
+#include "category.h"
+
+/* The version number of the latest category table. Each category
+ table has a unique version number. It is assigned a new number
+ also when it is modified. When a regular expression is compiled
+ into the struct re_pattern_buffer, the version number of the
+ category table (of the current buffer) at that moment is also
+ embedded in the structure.
+
+ For the moment, we are not using this feature. */
+static int category_table_version;
+
+Lisp_Object Qcategory_table, Qcategoryp, Qcategorysetp, Qcategory_table_p;
+
+/* Variables to determine word boundary. */
+Lisp_Object Vword_combining_categories, Vword_separating_categories;
+
+/* Temporary internal variable used in macro CHAR_HAS_CATEGORY. */
+Lisp_Object _temp_category_set;
+
+
+/* Category set staff. */
+
+DEFUN ("make-category-set", Fmake_category_set, Smake_category_set, 1, 1, 0,
+ "Return a newly created category-set which contains CATEGORIES.\n\
+CATEGORIES is a string of category mnemonics.")
+ (categories)
+ Lisp_Object categories;
+{
+ Lisp_Object val;
+ int len;
+
+ CHECK_STRING (categories, 0);
+ val = MAKE_CATEGORY_SET;
+
+ len = XSTRING (categories)->size;
+ while (--len >= 0)
+ {
+ Lisp_Object category = make_number (XSTRING (categories)->data[len]);
+
+ CHECK_CATEGORY (category, 0);
+ SET_CATEGORY_SET (val, category, Qt);
+ }
+ return val;
+}
+
+
+/* Category staff. */
+
+Lisp_Object check_category_table ();
+
+DEFUN ("define-category", Fdefine_category, Sdefine_category, 2, 3, 0,
+ "Define CHAR as a category which is described by DOCSTRING.\n\
+CHAR should be a visible letter of ` ' thru `~'.\n\
+DOCSTRING is a documentation string of the category.\n\
+The category is defined only in category table TABLE, which defaults to\n\
+ the current buffer's category table.")
+ (category, docstring, table)
+ Lisp_Object category, docstring, table;
+{
+ CHECK_CATEGORY (category, 0);
+ CHECK_STRING (docstring, 1);
+ table = check_category_table (table);
+
+ if (!NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
+ error ("Category `%c' is already defined", XFASTINT (category));
+ CATEGORY_DOCSTRING (table, XFASTINT (category)) = docstring;
+
+ return Qnil;
+}
+
+DEFUN ("category-docstring", Fcategory_docstring, Scategory_docstring, 1, 2, 0,
+ "Return a documentation string of CATEGORY.\n\
+Optional second arg specifies CATEGORY-TABLE,\n\
+ which defaults to the current buffer's category table.")
+ (category, table)
+ Lisp_Object category, table;
+{
+ Lisp_Object doc;
+
+ CHECK_CATEGORY (category, 0);
+ table = check_category_table (table);
+
+ return CATEGORY_DOCSTRING (table, XFASTINT (category));
+}
+
+DEFUN ("get-unused-category", Fget_unused_category, Sget_unused_category,
+ 0, 1, 0,
+ "Return a category which is not yet defined.\n\
+If total number of categories has reached the limit (95), return nil.\n\
+Optional argument specifies CATEGORY-TABLE,\n\
+ which defaults to the current buffer's category table.")
+ (table)
+ Lisp_Object table;
+{
+ int i;
+ Lisp_Object docstring_vector;
+
+ table = check_category_table (table);
+
+ for (i = ' '; i <= '~'; i++)
+ if (NILP (CATEGORY_DOCSTRING (table, i)))
+ return make_number (i);
+
+ return Qnil;
+}
+
+
+/* Category-table staff. */
+
+DEFUN ("category-table-p", Fcategory_table_p, Scategory_table_p, 1, 1, 0,
+ "Return t if ARG is a category table.")
+ (arg)
+ Lisp_Object arg;
+{
+ if (CHAR_TABLE_P (arg)
+ && EQ (XCHAR_TABLE (arg)->purpose, Qcategory_table)
+ && CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (arg)) == 2)
+ return Qt;
+ return Qnil;
+}
+
+/* If TABLE is nil, return the current category table. If TABLE is
+ not nil, check the validity of TABLE as a category table. If
+ valid, return TABLE itself, but if not valid, signal an error of
+ wrong-type-argument. */
+
+Lisp_Object
+check_category_table (table)
+ Lisp_Object table;
+{
+ register Lisp_Object tem;
+ if (NILP (table))
+ return current_buffer->category_table;
+ while (tem = Fcategory_table_p (table), NILP (tem))
+ table = wrong_type_argument (Qcategory_table_p, table);
+ return table;
+}
+
+DEFUN ("category-table", Fcategory_table, Scategory_table, 0, 0, 0,
+ "Return the current category table.\n\
+This is the one specified by the current buffer.")
+ ()
+{
+ return current_buffer->category_table;
+}
+
+DEFUN ("standard-category-table", Fstandard_category_table,
+ Sstandard_category_table, 0, 0, 0,
+ "Return the standard category table.\n\
+This is the one used for new buffers.")
+ ()
+{
+ return Vstandard_category_table;
+}
+
+/* Return a copy of category table TABLE. We can't simply use the
+ function copy-sequence because no contents should be shared between
+ the original and the copy.
+
+ If TOP is 1, we at first copy the tree structure of the table. */
+
+Lisp_Object
+copy_category_table (table, top)
+ Lisp_Object table;
+{
+ int i;
+
+ if (top)
+ table = Fcopy_sequence (table);
+ else if (!NILP (XCHAR_TABLE (table)->defalt))
+ XCHAR_TABLE (table)->defalt
+ = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
+
+ for (i = 0; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
+ {
+ Lisp_Object idx = make_number (i);
+ Lisp_Object val = Faref (table, idx);
+
+ if (NILP (val)) /* Do nothing because we can share nil. */
+ ;
+ else if (CATEGORY_SET_P (val))
+ Faset (table, idx, Fcopy_sequence (val));
+ else if (CHAR_TABLE_P (val))
+ Faset (table, idx, copy_category_table (val, 0));
+ else /* Invalid contents. */
+ Faset (table, idx, Qnil);
+ }
+
+ return table;
+}
+
+DEFUN ("copy-category-table", Fcopy_category_table, Scopy_category_table,
+ 0, 1, 0,
+ "Construct a new category table and return it.\n\
+It is a copy of the TABLE, which defaults to the standard category table.")
+ (table)
+ Lisp_Object table;
+{
+ if (!NILP (table))
+ check_category_table (table);
+ else
+ table = Vstandard_category_table;
+
+ return copy_category_table (table, 1);
+}
+
+DEFUN ("set-category-table", Fset_category_table, Sset_category_table, 1, 1, 0,
+ "Select a new category table for the current buffer.\n\
+One argument, a category table.")
+ (table)
+ Lisp_Object table;
+{
+ table = check_category_table (table);
+ current_buffer->category_table = table;
+ /* Indicate that this buffer now has a specified category table. */
+ current_buffer->local_var_flags
+ |= XFASTINT (buffer_local_flags.category_table);
+ return table;
+}
+
+
+DEFUN ("char-category-set", Fchar_category_set, Schar_category_set, 1, 1, 0,
+ "Return a category set of CHAR.")
+ (ch)
+ Lisp_Object ch;
+{
+ Lisp_Object val;
+ int charset;
+ unsigned char c1, c2;
+
+ CHECK_NUMBER (ch, 0);
+ return CATEGORY_SET (XFASTINT (ch));
+}
+
+DEFUN ("category-set-mnemonics", Fcategory_set_mnemonics,
+ Scategory_set_mnemonics, 1, 1, 0,
+ "Return a string of mnemonics of all categories in CATEGORY-SET.")
+ (category_set)
+ Lisp_Object category_set;
+{
+ int i, j;
+ char str[96];
+
+ CHECK_CATEGORY_SET (category_set, 0);
+
+ j = 0;
+ for (i = 32; i < 127; i++)
+ if (CATEGORY_MEMBER (i, category_set))
+ str[j++] = i;
+ str[j] = '\0';
+
+ return build_string (str);
+}
+
+/* Modify all category sets stored under category table TABLE so that
+ they contain (SET_VALUE is t) or don't contain (SET_VALUE is nil)
+ CATEGORY. */
+
+void
+modify_lower_category_set (table, category, set_value)
+ Lisp_Object table, category, set_value;
+{
+ Lisp_Object val;
+ int i;
+
+ if (NILP (XCHAR_TABLE (table)->defalt))
+ {
+ val = MAKE_CATEGORY_SET;
+ SET_CATEGORY_SET (val, category, set_value);
+ XCHAR_TABLE (table)->defalt = val;
+ }
+
+ for (i = 32; i < CHAR_TABLE_ORDINARY_SLOTS; i++)
+ {
+ val = XCHAR_TABLE (table)->contents[i];
+
+ if (CATEGORY_SET_P (val))
+ SET_CATEGORY_SET (val, category, set_value);
+ else if (CHAR_TABLE_P (val))
+ modify_lower_category_set (val, category, set_value);
+ }
+}
+
+void
+set_category_set (category_set, category, val)
+ Lisp_Object category_set, category, val;
+{
+ do {
+ int idx = XINT (category) / 8;
+ unsigned char bits = 1 << (XINT (category) % 8);
+
+ if (NILP (val))
+ XCATEGORY_SET (category_set)->data[idx] &= ~bits;
+ else
+ XCATEGORY_SET (category_set)->data[idx] |= bits;
+ } while (0);
+}
+
+DEFUN ("modify-category-entry", Fmodify_category_entry,
+ Smodify_category_entry, 2, 4, 0,
+ "Modify the category set of CHAR by adding CATEGORY to it.\n\
+The category is changed only for table TABLE, which defaults to\n\
+ the current buffer's category table.\n\
+If optional forth argument RESET is non NIL,\n\
+ CATEGORY is deleted from the category set instead of being added.")
+ (ch, category, table, reset)
+ Lisp_Object ch, category, table, reset;
+{
+ int c, charset, c1, c2;
+ Lisp_Object set_value; /* Actual value to be set in category sets. */
+ Lisp_Object val, category_set;
+
+ CHECK_NUMBER (ch, 0);
+ c = XINT (ch);
+ CHECK_CATEGORY (category, 1);
+ table = check_category_table (table);
+
+ if (NILP (CATEGORY_DOCSTRING (table, XFASTINT (category))))
+ error ("Undefined category: %c", XFASTINT (category));
+
+ set_value = NILP (reset) ? Qt : Qnil;
+
+ if (SINGLE_BYTE_CHAR_P (c))
+ {
+ val = XCHAR_TABLE (table)->contents[c];
+ if (!CATEGORY_SET_P (val))
+ XCHAR_TABLE (table)->contents[c] = (val = MAKE_CATEGORY_SET);
+ SET_CATEGORY_SET (val, category, set_value);
+ return Qnil;
+ }
+
+ if (COMPOSITE_CHAR_P (c))
+ c = cmpchar_component (c, 0);
+ SPLIT_NON_ASCII_CHAR (c, charset, c1, c2);
+
+ /* The top level table. */
+ val = XCHAR_TABLE (table)->contents[charset];
+ if (NILP (val))
+ {
+ category_set = MAKE_CATEGORY_SET;
+ XCHAR_TABLE (table)->contents[charset] = category_set;
+ }
+ else if (CATEGORY_SET_P (val))
+ category_set = val;
+
+ if (!c1)
+ {
+ /* Only a charset is specified. */
+ if (CHAR_TABLE_P (val))
+ /* All characters in CHARSET should be the same as for CATEGORY. */
+ modify_lower_category_set (val, category, set_value);
+ else
+ SET_CATEGORY_SET (category_set, category, set_value);
+ return Qnil;
+ }
+
+ /* The second level table. */
+ if (!CHAR_TABLE_P (val))
+ {
+ val = Fmake_char_table (Qnil, Qnil);
+ XCHAR_TABLE (table)->contents[charset] = val;
+ /* We must set default category set of CHARSET in `defalt' slot. */
+ XCHAR_TABLE (val)->defalt = category_set;
+ }
+ table = val;
+
+ val = XCHAR_TABLE (table)->contents[c1];
+ if (NILP (val))
+ {
+ category_set = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
+ XCHAR_TABLE (table)->contents[c1] = category_set;
+ }
+ else if (CATEGORY_SET_P (val))
+ category_set = val;
+
+ if (!c2)
+ {
+ if (CHAR_TABLE_P (val))
+ /* All characters in C1 group of CHARSET should be the same as
+ for CATEGORY. */
+ modify_lower_category_set (val, category, set_value);
+ else
+ SET_CATEGORY_SET (category_set, category, set_value);
+ return Qnil;
+ }
+
+ /* The third (bottom) level table. */
+ if (!CHAR_TABLE_P (val))
+ {
+ val = Fmake_char_table (Qnil, Qnil);
+ XCHAR_TABLE (table)->contents[c1] = val;
+ /* We must set default category set of CHARSET and C1 in
+ `defalt' slot. */
+ XCHAR_TABLE (val)->defalt = category_set;
+ }
+ table = val;
+
+ val = XCHAR_TABLE (table)->contents[c2];
+ if (NILP (val))
+ {
+ category_set = Fcopy_sequence (XCHAR_TABLE (table)->defalt);
+ XCHAR_TABLE (table)->contents[c2] = category_set;
+ }
+ else if (CATEGORY_SET_P (val))
+ category_set = val;
+ else
+ /* This should never happen. */
+ error ("Invalid category table");
+
+ SET_CATEGORY_SET (category_set, category, set_value);
+
+ return Qnil;
+}
+
+/* Dump category table to buffer in human-readable format */
+
+static void
+describe_category (value)
+ Lisp_Object value;
+{
+ Lisp_Object mnemonics;
+
+ Findent_to (make_number (16), make_number (1));
+
+ if (NILP (value))
+ {
+ insert_string ("default\n");
+ return;
+ }
+
+ if (!CATEGORY_SET_P (value))
+ {
+ insert_string ("invalid\n");
+ return;
+ }
+
+ mnemonics = Fcategory_set_mnemonics (value);
+ insert_from_string (mnemonics, 0, XSTRING (mnemonics)->size, 0);
+ insert_string ("\n");
+ return;
+}
+
+static Lisp_Object
+describe_category_1 (vector)
+ Lisp_Object vector;
+{
+ struct buffer *old = current_buffer;
+ set_buffer_internal (XBUFFER (Vstandard_output));
+ describe_vector (vector, Qnil, describe_category, 0, Qnil, Qnil);
+ {
+ int i;
+ Lisp_Object docs = XCHAR_TABLE (vector)->extras[0];
+ Lisp_Object elt;
+
+ if (!VECTORP (docs) || XVECTOR (docs)->size != 95)
+ {
+ insert_string ("Invalid first extra slot in this char table\n");
+ return Qnil;
+ }
+
+ insert_string ("Meanings of mnemonice characters are:\n");
+ for (i = 0; i < 95; i++)
+ {
+ elt = XVECTOR (docs)->contents[i];
+ if (NILP (elt))
+ continue;
+
+ insert_char (i + 32);
+ insert (": ", 2);
+ insert_from_string (elt, 0, XSTRING (elt)->size, 0);
+ insert ("\n", 1);
+ }
+ }
+
+ while (! NILP (XCHAR_TABLE (vector)->parent))
+ {
+ vector = XCHAR_TABLE (vector)->parent;
+ insert_string ("\nThe parent category table is:");
+ describe_vector (vector, Qnil, describe_category, 0, Qnil, Qnil);
+ }
+
+ call0 (intern ("help-mode"));
+ set_buffer_internal (old);
+ return Qnil;
+}
+
+DEFUN ("describe-category", Fdescribe_category, Sdescribe_category, 0, 0, "",
+ "Describe the category specifications in the category table.\n\
+The descriptions are inserted in a buffer, which is then displayed.")
+ ()
+{
+ internal_with_output_to_temp_buffer
+ ("*Help*", describe_category_1, current_buffer->category_table);
+
+ return Qnil;
+}
+
+/* Return 1 if there is a word boundary between two word-constituent
+ characters C1 and C2 if they appear in this order, else return 0.
+ Use the macro WORD_BOUNDARY_P instead of calling this function
+ directly. */
+
+int
+word_boundary_p (c1, c2)
+ int c1, c2;
+{
+ Lisp_Object category_set1, category_set2;
+ Lisp_Object tail;
+ int default_result;
+
+ if (CHAR_CHARSET (c1) == CHAR_CHARSET (c2))
+ {
+ tail = Vword_separating_categories;
+ default_result = 0;
+ }
+ else
+ {
+ tail = Vword_combining_categories;
+ default_result = 1;
+ }
+
+ category_set1 = CATEGORY_SET (c1);
+ if (NILP (category_set1))
+ return default_result;
+ category_set2 = CATEGORY_SET (c2);
+ if (NILP (category_set2))
+ return default_result;
+
+ for (; CONSP (tail); tail = XCONS (tail)->cdr)
+ {
+ Lisp_Object elt = XCONS(tail)->car;
+
+ if (CONSP (elt)
+ && CATEGORYP (XCONS (elt)->car)
+ && CATEGORYP (XCONS (elt)->cdr)
+ && CATEGORY_MEMBER (XCONS (elt)->car, category_set1)
+ && CATEGORY_MEMBER (XCONS (elt)->cdr, category_set2))
+ return !default_result;
+ }
+ return default_result;
+}
+
+
+init_category_once ()
+{
+ /* This has to be done here, before we call Fmake_char_table. */
+ Qcategory_table = intern ("category-table");
+ staticpro (&Qcategory_table);
+
+ /* Intern this now in case it isn't already done.
+ Setting this variable twice is harmless.
+ But don't staticpro it here--that is done in alloc.c. */
+ Qchar_table_extra_slots = intern ("char-table-extra-slots");
+
+ /* Now we are ready to set up this property, so we can
+ create category tables. */
+ Fput (Qcategory_table, Qchar_table_extra_slots, make_number (2));
+
+ Vstandard_category_table = Fmake_char_table (Qcategory_table, Qnil);
+ /* Set a category set which contains nothing to the default. */
+ XCHAR_TABLE (Vstandard_category_table)->defalt = MAKE_CATEGORY_SET;
+ Fset_char_table_extra_slot (Vstandard_category_table, 0,
+ Fmake_vector (make_number (95), Qnil));
+}
+
+syms_of_category ()
+{
+ Qcategoryp = intern ("categoryp");
+ staticpro (&Qcategoryp);
+ Qcategorysetp = intern ("categorysetp");
+ staticpro (&Qcategorysetp);
+ Qcategory_table_p = intern ("category-table-p");
+ staticpro (&Qcategory_table_p);
+
+ DEFVAR_LISP ("word-combining-categories", &Vword_combining_categories,
+ "List of pair (cons) of categories to determine word boundary.\n\
+\n\
+Emacs treats a sequence of word constituent characters as a single\n\
+word (i.e. finds no word boundary between them) iff they belongs to\n\
+the same charset. But, exceptions are allowed in the following cases.\n\
+\n\
+(1) The case that characters are in different charsets is controlled\n\
+by the variable `word-combining-categories'.\n\
+\n\
+Emacs finds no word boundary between characters of different charsets\n\
+if they have categories matching some element of this list.\n\
+\n\
+More precisely, if an element of this list is a cons of category CAT1\n\
+and CAT2, and a multibyte character C1 which has CAT1 is followed by\n\
+C2 which has CAT2, there's no word boundary between C1 and C2.\n\
+\n\
+For instance, to tell that ASCII characters and Latin-1 characters can\n\
+form a single word, the element `(?l . ?l)' should be in this list\n\
+because both characters have the category `l' (Latin characters).\n\
+\n\
+(2) The case that character are in the same charset is controlled by\n\
+the variable `word-separating-categories'.\n\
+\n\
+Emacs find a word boundary between characters of the same charset\n\
+if they have categories matching some element of this list.\n\
+\n\
+More precisely, if an element of this list is a cons of category CAT1\n\
+and CAT2, and a multibyte character C1 which has CAT1 is followed by\n\
+C2 which has CAT2, there's a word boundary between C1 and C2.\n\
+\n\
+For instance, to tell that there's a word boundary between Japanese\n\
+Hiragana and Japanese Kanji (both are in the same charset), the\n\
+element `(?H . ?C) should be in this list.");
+
+ Vword_combining_categories = Qnil;
+
+ DEFVAR_LISP ("word-separating-categories", &Vword_separating_categories,
+ "List of pair (cons) of categories to determine word boundary.\n\
+See the documentation of the variable `word-combining-categories'.");
+
+ Vword_separating_categories = Qnil;
+
+ defsubr (&Smake_category_set);
+ defsubr (&Sdefine_category);
+ defsubr (&Scategory_docstring);
+ defsubr (&Sget_unused_category);
+ defsubr (&Scategory_table_p);
+ defsubr (&Scategory_table);
+ defsubr (&Sstandard_category_table);
+ defsubr (&Scopy_category_table);
+ defsubr (&Sset_category_table);
+ defsubr (&Schar_category_set);
+ defsubr (&Scategory_set_mnemonics);
+ defsubr (&Smodify_category_entry);
+ defsubr (&Sdescribe_category);
+
+ category_table_version = 0;
+}
diff --git a/src/category.h b/src/category.h
new file mode 100644
index 00000000000..975e82b52f2
--- /dev/null
+++ b/src/category.h
@@ -0,0 +1,130 @@
+/* Declarations having to do with Emacs category tables.
+ Ver.1.0
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING. If not, write to
+the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+
+/* We introduce here three types of object: category, category set,
+ and category table.
+
+ A category is like syntax but differs in the following points:
+
+ o A category is represented by a mnemonic character of the range
+ ` '(32)..`~'(126) (printable ASCII characters).
+
+ o A category is not exclusive, i.e. a character has multiple
+ categories (category set). Of course, there's a case that a
+ category set is empty, i.e. the character has no category.
+
+ o In addition to the predefined categories, a user can define new
+ categories. Total number of categories is limited to 95.
+
+ A category set is a set of categories represented by Lisp
+ bool-vector of length 128 (only elements of 31th through 125th
+ are used).
+
+ A category table is like syntax-table, represented by a Lisp
+ char-table. The contents are category sets or nil. It has two
+ extra slots. for a vector of doc string of each category and a
+ version number.
+
+ The first extra slot is a vector of doc strings of categories, the
+ length is 95. The Nth element corresponding to the category N+32.
+
+ The second extra slot is a version number of the category table.
+ But, for the moment, we are not using this slot. */
+
+#define CATEGORYP(x) \
+ (INTEGERP ((x)) && XFASTINT ((x)) >= 0x20 && XFASTINT ((x)) <= 0x7E)
+
+#define CHECK_CATEGORY(x, i) \
+ do { \
+ if (!CATEGORYP ((x))) x = wrong_type_argument (Qcategoryp, (x)); \
+ } while (0)
+
+#define XCATEGORY_SET XBOOL_VECTOR
+
+#define CATEGORY_SET_P(x) \
+ (BOOL_VECTOR_P ((x)) && (EMACS_INT) (XBOOL_VECTOR ((x))->size) == 128)
+
+/* Return a new empty category set. */
+#define MAKE_CATEGORY_SET (Fmake_bool_vector (make_number (128), Qnil))
+
+/* Make CATEGORY_SET includes (if VAL is t) or excludes (if VAL is
+ nil) CATEGORY. */
+#define SET_CATEGORY_SET(category_set, category, val) \
+ (Faset (category_set, category, val))
+
+#define CHECK_CATEGORY_SET(x, i) \
+ do { \
+ if (!CATEGORY_SET_P ((x))) x = wrong_type_argument (Qcategorysetp, (x)); \
+ } while (0)
+
+/* Return 1 if CATEGORY_SET contains CATEGORY, else return 0.
+ The faster version of `!NILP (Faref (category_set, category))'. */
+#define CATEGORY_MEMBER(category, category_set) \
+ (!NILP (category_set) \
+ && (XCATEGORY_SET (category_set)->data[XFASTINT (category) / 8] \
+ & (1 << (XFASTINT (category) % 8))))
+
+/* Temporary internal variable used in macro CHAR_HAS_CATEGORY. */
+extern Lisp_Object _temp_category_set;
+
+/* Return 1 if category set of CH contains CATEGORY, elt return 0. */
+#define CHAR_HAS_CATEGORY(ch, category) \
+ (_temp_category_set = CATEGORY_SET (ch), \
+ CATEGORY_MEMBER (category, _temp_category_set))
+
+/* The standard category table is stored where it will automatically
+ be used in all new buffers. */
+#define Vstandard_category_table buffer_defaults.category_table
+
+/* Return the category set of character C in the current category table. */
+#ifdef __GNUC__
+#define CATEGORY_SET(c) \
+ ({ Lisp_Object table = current_buffer->category_table; \
+ Lisp_Object temp; \
+ if (c < CHAR_TABLE_ORDINARY_SLOTS) \
+ while (NILP (temp = XCHAR_TABLE (table)->contents[c]) \
+ && NILP (temp = XCHAR_TABLE (table)->defalt)) \
+ table = XCHAR_TABLE (table)->parent; \
+ else \
+ temp = Faref (table, c); \
+ temp; })
+#else
+#define CATEGORY_SET(c) Faref (current_buffer->category_table, c)
+#endif
+
+/* Return the doc string of CATEGORY in category table TABLE. */
+#define CATEGORY_DOCSTRING(table, category) \
+ XVECTOR (Fchar_table_extra_slot (table, 0))->contents[(category) - ' ']
+
+/* Return the version number of category table TABLE. Not used for
+ the moment. */
+#define CATEGORY_TABLE_VERSION (table) \
+ Fchar_table_extra_slot (table, 1)
+
+/* Return 1 if there is a word boundary between two word-constituent
+ characters C1 and C2 if they appear in this order, else return 0.
+ There is no word boundary between two word-constituent ASCII
+ characters. */
+#define WORD_BOUNDARY_P(c1, c2) \
+ (!(SINGLE_BYTE_CHAR_P (c1) && SINGLE_BYTE_CHAR_P (c2)) \
+ && word_boundary_p (c1, c2))
diff --git a/src/ccl.c b/src/ccl.c
new file mode 100644
index 00000000000..11c1ae500d6
--- /dev/null
+++ b/src/ccl.c
@@ -0,0 +1,1140 @@
+/* CCL (Code Conversion Language) interpreter.
+ Ver.1.0
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <stdio.h>
+
+#ifdef emacs
+
+#include <config.h>
+#include "lisp.h"
+#include "charset.h"
+#include "ccl.h"
+#include "coding.h"
+
+#else /* not emacs */
+
+#include "mulelib.h"
+
+#endif /* not emacs */
+
+/* Alist of fontname patterns vs corresponding CCL program. */
+Lisp_Object Vfont_ccl_encoder_alist;
+
+/* Vector of CCL program names vs corresponding program data. */
+Lisp_Object Vccl_program_table;
+
+/* CCL (Code Conversion Language) is a simple language which has
+ operations on one input buffer, one output buffer, and 7 registers.
+ The syntax of CCL is described in `ccl.el'. Emacs Lisp function
+ `ccl-compile' compiles a CCL program and produces a CCL code which
+ is a vector of integers. The structure of this vector is as
+ follows: The 1st element: buffer-magnification, a factor for the
+ size of output buffer compared with the size of input buffer. The
+ 2nd element: address of CCL code to be executed when encountered
+ with end of input stream. The 3rd and the remaining elements: CCL
+ codes. */
+
+/* Header of CCL compiled code */
+#define CCL_HEADER_BUF_MAG 0
+#define CCL_HEADER_EOF 1
+#define CCL_HEADER_MAIN 2
+
+/* CCL code is a sequence of 28-bit non-negative integers (i.e. the
+ MSB is always 0), each contains CCL command and/or arguments in the
+ following format:
+
+ |----------------- integer (28-bit) ------------------|
+ |------- 17-bit ------|- 3-bit --|- 3-bit --|- 5-bit -|
+ |--constant argument--|-register-|-register-|-command-|
+ ccccccccccccccccc RRR rrr XXXXX
+ or
+ |------- relative address -------|-register-|-command-|
+ cccccccccccccccccccc rrr XXXXX
+ or
+ |------------- constant or other args ----------------|
+ cccccccccccccccccccccccccccc
+
+ where, `cc...c' is a non-negative integer indicating constant value
+ (the left most `c' is always 0) or an absolute jump address, `RRR'
+ and `rrr' are CCL register number, `XXXXX' is one of the following
+ CCL commands. */
+
+/* CCL commands
+
+ Each comment fields shows one or more lines for command syntax and
+ the following lines for semantics of the command. In semantics, IC
+ stands for Instruction Counter. */
+
+#define CCL_SetRegister 0x00 /* Set register a register value:
+ 1:00000000000000000RRRrrrXXXXX
+ ------------------------------
+ reg[rrr] = reg[RRR];
+ */
+
+#define CCL_SetShortConst 0x01 /* Set register a short constant value:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ ------------------------------
+ reg[rrr] = CCCCCCCCCCCCCCCCCCC;
+ */
+
+#define CCL_SetConst 0x02 /* Set register a constant value:
+ 1:00000000000000000000rrrXXXXX
+ 2:CONSTANT
+ ------------------------------
+ reg[rrr] = CONSTANT;
+ IC++;
+ */
+
+#define CCL_SetArray 0x03 /* Set register an element of array:
+ 1:CCCCCCCCCCCCCCCCCRRRrrrXXXXX
+ 2:ELEMENT[0]
+ 3:ELEMENT[1]
+ ...
+ ------------------------------
+ if (0 <= reg[RRR] < CC..C)
+ reg[rrr] = ELEMENT[reg[RRR]];
+ IC += CC..C;
+ */
+
+#define CCL_Jump 0x04 /* Jump:
+ 1:A--D--D--R--E--S--S-000XXXXX
+ ------------------------------
+ IC += ADDRESS;
+ */
+
+/* Note: If CC..C is greater than 0, the second code is omitted. */
+
+#define CCL_JumpCond 0x05 /* Jump conditional:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ ------------------------------
+ if (!reg[rrr])
+ IC += ADDRESS;
+ */
+
+
+#define CCL_WriteRegisterJump 0x06 /* Write register and jump:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ ------------------------------
+ write (reg[rrr]);
+ IC += ADDRESS;
+ */
+
+#define CCL_WriteRegisterReadJump 0x07 /* Write register, read, and jump:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:A--D--D--R--E--S--S-rrrYYYYY
+ -----------------------------
+ write (reg[rrr]);
+ IC++;
+ read (reg[rrr]);
+ IC += ADDRESS;
+ */
+/* Note: If read is suspended, the resumed execution starts from the
+ second code (YYYYY == CCL_ReadJump). */
+
+#define CCL_WriteConstJump 0x08 /* Write constant and jump:
+ 1:A--D--D--R--E--S--S-000XXXXX
+ 2:CONST
+ ------------------------------
+ write (CONST);
+ IC += ADDRESS;
+ */
+
+#define CCL_WriteConstReadJump 0x09 /* Write constant, read, and jump:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:CONST
+ 3:A--D--D--R--E--S--S-rrrYYYYY
+ -----------------------------
+ write (CONST);
+ IC += 2;
+ read (reg[rrr]);
+ IC += ADDRESS;
+ */
+/* Note: If read is suspended, the resumed execution starts from the
+ second code (YYYYY == CCL_ReadJump). */
+
+#define CCL_WriteStringJump 0x0A /* Write string and jump:
+ 1:A--D--D--R--E--S--S-000XXXXX
+ 2:LENGTH
+ 3:0000STRIN[0]STRIN[1]STRIN[2]
+ ...
+ ------------------------------
+ write_string (STRING, LENGTH);
+ IC += ADDRESS;
+ */
+
+#define CCL_WriteArrayReadJump 0x0B /* Write an array element, read, and jump:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:LENGTH
+ 3:ELEMENET[0]
+ 4:ELEMENET[1]
+ ...
+ N:A--D--D--R--E--S--S-rrrYYYYY
+ ------------------------------
+ if (0 <= reg[rrr] < LENGTH)
+ write (ELEMENT[reg[rrr]]);
+ IC += LENGTH + 2; (... pointing at N+1)
+ read (reg[rrr]);
+ IC += ADDRESS;
+ */
+/* Note: If read is suspended, the resumed execution starts from the
+ Mth code (YYYYY == CCL_ReadJump). */
+
+#define CCL_ReadJump 0x0C /* Read and jump:
+ 1:A--D--D--R--E--S--S-rrrYYYYY
+ -----------------------------
+ read (reg[rrr]);
+ IC += ADDRESS;
+ */
+
+#define CCL_Branch 0x0D /* Jump by branch table:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ 2:A--D--D--R--E-S-S[0]000XXXXX
+ 3:A--D--D--R--E-S-S[1]000XXXXX
+ ...
+ ------------------------------
+ if (0 <= reg[rrr] < CC..C)
+ IC += ADDRESS[reg[rrr]];
+ else
+ IC += ADDRESS[CC..C];
+ */
+
+#define CCL_ReadRegister 0x0E /* Read bytes into registers:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ 2:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ ...
+ ------------------------------
+ while (CCC--)
+ read (reg[rrr]);
+ */
+
+#define CCL_WriteExprConst 0x0F /* write result of expression:
+ 1:00000OPERATION000RRR000XXXXX
+ 2:CONSTANT
+ ------------------------------
+ write (reg[RRR] OPERATION CONSTANT);
+ IC++;
+ */
+
+/* Note: If the Nth read is suspended, the resumed execution starts
+ from the Nth code. */
+
+#define CCL_ReadBranch 0x10 /* Read one byte into a register,
+ and jump by branch table:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ 2:A--D--D--R--E-S-S[0]000XXXXX
+ 3:A--D--D--R--E-S-S[1]000XXXXX
+ ...
+ ------------------------------
+ read (read[rrr]);
+ if (0 <= reg[rrr] < CC..C)
+ IC += ADDRESS[reg[rrr]];
+ else
+ IC += ADDRESS[CC..C];
+ */
+
+#define CCL_WriteRegister 0x11 /* Write registers:
+ 1:CCCCCCCCCCCCCCCCCCCrrrXXXXX
+ 2:CCCCCCCCCCCCCCCCCCCrrrXXXXX
+ ...
+ ------------------------------
+ while (CCC--)
+ write (reg[rrr]);
+ ...
+ */
+
+/* Note: If the Nth write is suspended, the resumed execution
+ starts from the Nth code. */
+
+#define CCL_WriteExprRegister 0x12 /* Write result of expression
+ 1:00000OPERATIONRrrRRR000XXXXX
+ ------------------------------
+ write (reg[RRR] OPERATION reg[Rrr]);
+ */
+
+#define CCL_Call 0x13 /* Write a constant:
+ 1:CCCCCCCCCCCCCCCCCCCC000XXXXX
+ ------------------------------
+ call (CC..C)
+ */
+
+#define CCL_WriteConstString 0x14 /* Write a constant or a string:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ [2:0000STRIN[0]STRIN[1]STRIN[2]]
+ [...]
+ -----------------------------
+ if (!rrr)
+ write (CC..C)
+ else
+ write_string (STRING, CC..C);
+ IC += (CC..C + 2) / 3;
+ */
+
+#define CCL_WriteArray 0x15 /* Write an element of array:
+ 1:CCCCCCCCCCCCCCCCCCCCrrrXXXXX
+ 2:ELEMENT[0]
+ 3:ELEMENT[1]
+ ...
+ ------------------------------
+ if (0 <= reg[rrr] < CC..C)
+ write (ELEMENT[reg[rrr]]);
+ IC += CC..C;
+ */
+
+#define CCL_End 0x16 /* Terminate:
+ 1:00000000000000000000000XXXXX
+ ------------------------------
+ terminate ();
+ */
+
+/* The following two codes execute an assignment arithmetic/logical
+ operation. The form of the operation is like REG OP= OPERAND. */
+
+#define CCL_ExprSelfConst 0x17 /* REG OP= constant:
+ 1:00000OPERATION000000rrrXXXXX
+ 2:CONSTANT
+ ------------------------------
+ reg[rrr] OPERATION= CONSTANT;
+ */
+
+#define CCL_ExprSelfReg 0x18 /* REG1 OP= REG2:
+ 1:00000OPERATION000RRRrrrXXXXX
+ ------------------------------
+ reg[rrr] OPERATION= reg[RRR];
+ */
+
+/* The following codes execute an arithmetic/logical operation. The
+ form of the operation is like REG_X = REG_Y OP OPERAND2. */
+
+#define CCL_SetExprConst 0x19 /* REG_X = REG_Y OP constant:
+ 1:00000OPERATION000RRRrrrXXXXX
+ 2:CONSTANT
+ ------------------------------
+ reg[rrr] = reg[RRR] OPERATION CONSTANT;
+ IC++;
+ */
+
+#define CCL_SetExprReg 0x1A /* REG1 = REG2 OP REG3:
+ 1:00000OPERATIONRrrRRRrrrXXXXX
+ ------------------------------
+ reg[rrr] = reg[RRR] OPERATION reg[Rrr];
+ */
+
+#define CCL_JumpCondExprConst 0x1B /* Jump conditional according to
+ an operation on constant:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:OPERATION
+ 3:CONSTANT
+ -----------------------------
+ reg[7] = reg[rrr] OPERATION CONSTANT;
+ if (!(reg[7]))
+ IC += ADDRESS;
+ else
+ IC += 2
+ */
+
+#define CCL_JumpCondExprReg 0x1C /* Jump conditional according to
+ an operation on register:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:OPERATION
+ 3:RRR
+ -----------------------------
+ reg[7] = reg[rrr] OPERATION reg[RRR];
+ if (!reg[7])
+ IC += ADDRESS;
+ else
+ IC += 2;
+ */
+
+#define CCL_ReadJumpCondExprConst 0x1D /* Read and jump conditional according
+ to an operation on constant:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:OPERATION
+ 3:CONSTANT
+ -----------------------------
+ read (reg[rrr]);
+ reg[7] = reg[rrr] OPERATION CONSTANT;
+ if (!reg[7])
+ IC += ADDRESS;
+ else
+ IC += 2;
+ */
+
+#define CCL_ReadJumpCondExprReg 0x1E /* Read and jump conditional according
+ to an operation on register:
+ 1:A--D--D--R--E--S--S-rrrXXXXX
+ 2:OPERATION
+ 3:RRR
+ -----------------------------
+ read (reg[rrr]);
+ reg[7] = reg[rrr] OPERATION reg[RRR];
+ if (!reg[7])
+ IC += ADDRESS;
+ else
+ IC += 2;
+ */
+
+#define CCL_Extention 0x1F /* Extended CCL code
+ 1:ExtendedCOMMNDRrrRRRrrrXXXXX
+ 2:ARGUEMENT
+ 3:...
+ ------------------------------
+ extended_command (rrr,RRR,Rrr,ARGS)
+ */
+
+
+/* CCL arithmetic/logical operators. */
+#define CCL_PLUS 0x00 /* X = Y + Z */
+#define CCL_MINUS 0x01 /* X = Y - Z */
+#define CCL_MUL 0x02 /* X = Y * Z */
+#define CCL_DIV 0x03 /* X = Y / Z */
+#define CCL_MOD 0x04 /* X = Y % Z */
+#define CCL_AND 0x05 /* X = Y & Z */
+#define CCL_OR 0x06 /* X = Y | Z */
+#define CCL_XOR 0x07 /* X = Y ^ Z */
+#define CCL_LSH 0x08 /* X = Y << Z */
+#define CCL_RSH 0x09 /* X = Y >> Z */
+#define CCL_LSH8 0x0A /* X = (Y << 8) | Z */
+#define CCL_RSH8 0x0B /* X = Y >> 8, r[7] = Y & 0xFF */
+#define CCL_DIVMOD 0x0C /* X = Y / Z, r[7] = Y % Z */
+#define CCL_LS 0x10 /* X = (X < Y) */
+#define CCL_GT 0x11 /* X = (X > Y) */
+#define CCL_EQ 0x12 /* X = (X == Y) */
+#define CCL_LE 0x13 /* X = (X <= Y) */
+#define CCL_GE 0x14 /* X = (X >= Y) */
+#define CCL_NE 0x15 /* X = (X != Y) */
+
+#define CCL_ENCODE_SJIS 0x16 /* X = HIGHER_BYTE (SJIS (Y, Z))
+ r[7] = LOWER_BYTE (SJIS (Y, Z) */
+#define CCL_DECODE_SJIS 0x17 /* X = HIGHER_BYTE (DE-SJIS (Y, Z))
+ r[7] = LOWER_BYTE (DE-SJIS (Y, Z)) */
+
+/* Macros for exit status of CCL program. */
+#define CCL_STAT_SUCCESS 0 /* Terminated successfully. */
+#define CCL_STAT_SUSPEND 1 /* Terminated because of empty input
+ buffer or full output buffer. */
+#define CCL_STAT_INVALID_CMD 2 /* Terminated because of invalid
+ command. */
+#define CCL_STAT_QUIT 3 /* Terminated because of quit. */
+
+/* Terminate CCL program successfully. */
+#define CCL_SUCCESS \
+ do { \
+ ccl->status = CCL_STAT_SUCCESS; \
+ ccl->ic = CCL_HEADER_MAIN; \
+ goto ccl_finish; \
+ } while (0)
+
+/* Suspend CCL program because of reading from empty input buffer or
+ writing to full output buffer. When this program is resumed, the
+ same I/O command is executed. */
+#define CCL_SUSPEND \
+ do { \
+ ic--; \
+ ccl->status = CCL_STAT_SUSPEND; \
+ goto ccl_finish; \
+ } while (0)
+
+/* Terminate CCL program because of invalid command. Should not occur
+ in the normal case. */
+#define CCL_INVALID_CMD \
+ do { \
+ ccl->status = CCL_STAT_INVALID_CMD; \
+ goto ccl_error_handler; \
+ } while (0)
+
+/* Encode one character CH to multibyte form and write to the current
+ output buffer. If CH is negative, write one byte -CH. */
+#define CCL_WRITE_CHAR(ch) \
+ do { \
+ if (!dst) \
+ CCL_INVALID_CMD; \
+ else \
+ { \
+ unsigned char work[4], *str; \
+ int len = CHAR_STRING (ch, work, str); \
+ if (dst + len <= dst_end) \
+ { \
+ bcopy (str, dst, len); \
+ dst += len; \
+ } \
+ else \
+ CCL_SUSPEND; \
+ } \
+ } while (0)
+
+/* Write a string at ccl_prog[IC] of length LEN to the current output
+ buffer. */
+#define CCL_WRITE_STRING(len) \
+ do { \
+ if (!dst) \
+ CCL_INVALID_CMD; \
+ else if (dst + len <= dst_end) \
+ for (i = 0; i < len; i++) \
+ *dst++ = ((XFASTINT (ccl_prog[ic + (i / 3)])) \
+ >> ((2 - (i % 3)) * 8)) & 0xFF; \
+ else \
+ CCL_SUSPEND; \
+ } while (0)
+
+/* Read one byte from the current input buffer into Rth register. */
+#define CCL_READ_CHAR(r) \
+ do { \
+ if (!src) \
+ CCL_INVALID_CMD; \
+ else if (src < src_end) \
+ r = *src++; \
+ else if (ccl->last_block) \
+ { \
+ ic = ccl->eof_ic; \
+ goto ccl_finish; \
+ } \
+ else \
+ CCL_SUSPEND; \
+ } while (0)
+
+
+/* Execute CCL code on SRC_BYTES length text at SOURCE. The resulting
+ text goes to a place pointed by DESTINATION, the length of which
+ should not exceed DST_BYTES. The bytes actually processed is
+ returned as *CONSUMED. The return value is the length of the
+ resulting text. As a side effect, the contents of CCL registers
+ are updated. If SOURCE or DESTINATION is NULL, only operations on
+ registers are permitted. */
+
+#ifdef CCL_DEBUG
+#define CCL_DEBUG_BACKTRACE_LEN 256
+int ccl_backtrace_table[CCL_BACKTRACE_TABLE];
+int ccl_backtrace_idx;
+#endif
+
+struct ccl_prog_stack
+ {
+ int *ccl_prog; /* Pointer to an array of CCL code. */
+ int ic; /* Instruction Counter. */
+ };
+
+ccl_driver (ccl, source, destination, src_bytes, dst_bytes, consumed)
+ struct ccl_program *ccl;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+{
+ register int *reg = ccl->reg;
+ register int ic = ccl->ic;
+ register int code, field1, field2;
+ register int *ccl_prog = ccl->prog;
+ unsigned char *src = source, *src_end = src + src_bytes;
+ unsigned char *dst = destination, *dst_end = dst + dst_bytes;
+ int jump_address;
+ int i, j, op;
+ int stack_idx = 0;
+ /* For the moment, we only support depth 256 of stack. */
+ struct ccl_prog_stack ccl_prog_stack_struct[256];
+
+ if (ic >= ccl->eof_ic)
+ ic = CCL_HEADER_MAIN;
+
+#ifdef CCL_DEBUG
+ ccl_backtrace_idx = 0;
+#endif
+
+ for (;;)
+ {
+#ifdef CCL_DEBUG
+ ccl_backtrace_table[ccl_backtrace_idx++] = ic;
+ if (ccl_backtrace_idx >= CCL_DEBUG_BACKTRACE_LEN)
+ ccl_backtrace_idx = 0;
+ ccl_backtrace_table[ccl_backtrace_idx] = 0;
+#endif
+
+ if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))
+ {
+ /* We can't just signal Qquit, instead break the loop as if
+ the whole data is processed. Don't reset Vquit_flag, it
+ must be handled later at a safer place. */
+ if (consumed)
+ src = source + src_bytes;
+ ccl->status = CCL_STAT_QUIT;
+ break;
+ }
+
+ code = XINT (ccl_prog[ic]); ic++;
+ field1 = code >> 8;
+ field2 = (code & 0xFF) >> 5;
+
+#define rrr field2
+#define RRR (field1 & 7)
+#define Rrr ((field1 >> 3) & 7)
+#define ADDR field1
+
+ switch (code & 0x1F)
+ {
+ case CCL_SetRegister: /* 00000000000000000RRRrrrXXXXX */
+ reg[rrr] = reg[RRR];
+ break;
+
+ case CCL_SetShortConst: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ reg[rrr] = field1;
+ break;
+
+ case CCL_SetConst: /* 00000000000000000000rrrXXXXX */
+ reg[rrr] = XINT (ccl_prog[ic]);
+ ic++;
+ break;
+
+ case CCL_SetArray: /* CCCCCCCCCCCCCCCCCCCCRRRrrrXXXXX */
+ i = reg[RRR];
+ j = field1 >> 3;
+ if ((unsigned int) i < j)
+ reg[rrr] = XINT (ccl_prog[ic + i]);
+ ic += j;
+ break;
+
+ case CCL_Jump: /* A--D--D--R--E--S--S-000XXXXX */
+ ic += ADDR;
+ break;
+
+ case CCL_JumpCond: /* A--D--D--R--E--S--S-rrrXXXXX */
+ if (!reg[rrr])
+ ic += ADDR;
+ break;
+
+ case CCL_WriteRegisterJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+ i = reg[rrr];
+ CCL_WRITE_CHAR (i);
+ ic += ADDR;
+ break;
+
+ case CCL_WriteRegisterReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+ i = reg[rrr];
+ CCL_WRITE_CHAR (i);
+ ic++;
+ CCL_READ_CHAR (reg[rrr]);
+ ic += ADDR - 1;
+ break;
+
+ case CCL_WriteConstJump: /* A--D--D--R--E--S--S-000XXXXX */
+ i = XINT (ccl_prog[ic]);
+ CCL_WRITE_CHAR (i);
+ ic += ADDR;
+ break;
+
+ case CCL_WriteConstReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+ i = XINT (ccl_prog[ic]);
+ CCL_WRITE_CHAR (i);
+ ic++;
+ CCL_READ_CHAR (reg[rrr]);
+ ic += ADDR - 1;
+ break;
+
+ case CCL_WriteStringJump: /* A--D--D--R--E--S--S-000XXXXX */
+ j = XINT (ccl_prog[ic]);
+ ic++;
+ CCL_WRITE_STRING (j);
+ ic += ADDR - 1;
+ break;
+
+ case CCL_WriteArrayReadJump: /* A--D--D--R--E--S--S-rrrXXXXX */
+ i = reg[rrr];
+ j = ccl_prog[ic++];
+ if ((unsigned int) i < j)
+ {
+ i = XINT (ccl_prog[ic + i]);
+ CCL_WRITE_CHAR (i);
+ }
+ ic += j + 1;
+ CCL_READ_CHAR (reg[rrr]);
+ ic += ADDR - (j + 2);
+ break;
+
+ case CCL_ReadJump: /* A--D--D--R--E--S--S-rrrYYYYY */
+ CCL_READ_CHAR (reg[rrr]);
+ ic += ADDR;
+ break;
+
+ case CCL_ReadBranch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ CCL_READ_CHAR (reg[rrr]);
+ /* fall through ... */
+ case CCL_Branch: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ if ((unsigned int) reg[rrr] < field1)
+ ic += XINT (ccl_prog[ic + reg[rrr]]);
+ else
+ ic += XINT (ccl_prog[ic + field1]);
+ break;
+
+ case CCL_ReadRegister: /* CCCCCCCCCCCCCCCCCCCCrrXXXXX */
+ while (1)
+ {
+ CCL_READ_CHAR (reg[rrr]);
+ if (!field1) break;
+ code = XINT (ccl_prog[ic]); ic++;
+ field1 = code >> 8;
+ field2 = (code & 0xFF) >> 5;
+ }
+ break;
+
+ case CCL_WriteExprConst: /* 1:00000OPERATION000RRR000XXXXX */
+ rrr = 7;
+ i = reg[RRR];
+ j = XINT (ccl_prog[ic]);
+ op = field1 >> 6;
+ ic++;
+ goto ccl_set_expr;
+
+ case CCL_WriteRegister: /* CCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ while (1)
+ {
+ i = reg[rrr];
+ CCL_WRITE_CHAR (i);
+ if (!field1) break;
+ code = XINT (ccl_prog[ic]); ic++;
+ field1 = code >> 8;
+ field2 = (code & 0xFF) >> 5;
+ }
+ break;
+
+ case CCL_WriteExprRegister: /* 1:00000OPERATIONRrrRRR000XXXXX */
+ rrr = 7;
+ i = reg[RRR];
+ j = reg[Rrr];
+ op = field1 >> 6;
+ goto ccl_set_expr;
+
+ case CCL_Call: /* CCCCCCCCCCCCCCCCCCCC000XXXXX */
+ {
+ Lisp_Object slot;
+
+ if (stack_idx >= 256
+ || field1 < 0
+ || field1 >= XVECTOR (Vccl_program_table)->size
+ || (slot = XVECTOR (Vccl_program_table)->contents[field1],
+ !CONSP (slot))
+ || !VECTORP (XCONS (slot)->cdr))
+ {
+ if (stack_idx > 0)
+ {
+ ccl_prog = ccl_prog_stack_struct[0].ccl_prog;
+ ic = ccl_prog_stack_struct[0].ic;
+ }
+ CCL_INVALID_CMD;
+ }
+
+ ccl_prog_stack_struct[stack_idx].ccl_prog = ccl_prog;
+ ccl_prog_stack_struct[stack_idx].ic = ic;
+ stack_idx++;
+ ccl_prog = XVECTOR (XCONS (slot)->cdr)->contents;
+ ic = CCL_HEADER_MAIN;
+ }
+ break;
+
+ case CCL_WriteConstString: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ if (!rrr)
+ CCL_WRITE_CHAR (field1);
+ else
+ {
+ CCL_WRITE_STRING (field1);
+ ic += (field1 + 2) / 3;
+ }
+ break;
+
+ case CCL_WriteArray: /* CCCCCCCCCCCCCCCCCCCCrrrXXXXX */
+ i = reg[rrr];
+ if ((unsigned int) i < field1)
+ {
+ j = XINT (ccl_prog[ic + i]);
+ CCL_WRITE_CHAR (j);
+ }
+ ic += field1;
+ break;
+
+ case CCL_End: /* 0000000000000000000000XXXXX */
+ if (stack_idx-- > 0)
+ {
+ ccl_prog = ccl_prog_stack_struct[stack_idx].ccl_prog;
+ ic = ccl_prog_stack_struct[stack_idx].ic;
+ break;
+ }
+ CCL_SUCCESS;
+
+ case CCL_ExprSelfConst: /* 00000OPERATION000000rrrXXXXX */
+ i = XINT (ccl_prog[ic]);
+ ic++;
+ op = field1 >> 6;
+ goto ccl_expr_self;
+
+ case CCL_ExprSelfReg: /* 00000OPERATION000RRRrrrXXXXX */
+ i = reg[RRR];
+ op = field1 >> 6;
+
+ ccl_expr_self:
+ switch (op)
+ {
+ case CCL_PLUS: reg[rrr] += i; break;
+ case CCL_MINUS: reg[rrr] -= i; break;
+ case CCL_MUL: reg[rrr] *= i; break;
+ case CCL_DIV: reg[rrr] /= i; break;
+ case CCL_MOD: reg[rrr] %= i; break;
+ case CCL_AND: reg[rrr] &= i; break;
+ case CCL_OR: reg[rrr] |= i; break;
+ case CCL_XOR: reg[rrr] ^= i; break;
+ case CCL_LSH: reg[rrr] <<= i; break;
+ case CCL_RSH: reg[rrr] >>= i; break;
+ case CCL_LSH8: reg[rrr] <<= 8; reg[rrr] |= i; break;
+ case CCL_RSH8: reg[7] = reg[rrr] & 0xFF; reg[rrr] >>= 8; break;
+ case CCL_DIVMOD: reg[7] = reg[rrr] % i; reg[rrr] /= i; break;
+ case CCL_LS: reg[rrr] = reg[rrr] < i; break;
+ case CCL_GT: reg[rrr] = reg[rrr] > i; break;
+ case CCL_EQ: reg[rrr] = reg[rrr] == i; break;
+ case CCL_LE: reg[rrr] = reg[rrr] <= i; break;
+ case CCL_GE: reg[rrr] = reg[rrr] >= i; break;
+ case CCL_NE: reg[rrr] = reg[rrr] != i; break;
+ default: CCL_INVALID_CMD;
+ }
+ break;
+
+ case CCL_SetExprConst: /* 00000OPERATION000RRRrrrXXXXX */
+ i = reg[RRR];
+ j = XINT (ccl_prog[ic]);
+ op = field1 >> 6;
+ jump_address = ++ic;
+ goto ccl_set_expr;
+
+ case CCL_SetExprReg: /* 00000OPERATIONRrrRRRrrrXXXXX */
+ i = reg[RRR];
+ j = reg[Rrr];
+ op = field1 >> 6;
+ jump_address = ic;
+ goto ccl_set_expr;
+
+ case CCL_ReadJumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
+ CCL_READ_CHAR (reg[rrr]);
+ case CCL_JumpCondExprConst: /* A--D--D--R--E--S--S-rrrXXXXX */
+ i = reg[rrr];
+ op = XINT (ccl_prog[ic]);
+ jump_address = ic++ + ADDR;
+ j = XINT (ccl_prog[ic]);
+ ic++;
+ rrr = 7;
+ goto ccl_set_expr;
+
+ case CCL_ReadJumpCondExprReg: /* A--D--D--R--E--S--S-rrrXXXXX */
+ CCL_READ_CHAR (reg[rrr]);
+ case CCL_JumpCondExprReg:
+ i = reg[rrr];
+ op = XINT (ccl_prog[ic]);
+ jump_address = ic++ + ADDR;
+ j = reg[XINT (ccl_prog[ic])];
+ ic++;
+ rrr = 7;
+
+ ccl_set_expr:
+ switch (op)
+ {
+ case CCL_PLUS: reg[rrr] = i + j; break;
+ case CCL_MINUS: reg[rrr] = i - j; break;
+ case CCL_MUL: reg[rrr] = i * j; break;
+ case CCL_DIV: reg[rrr] = i / j; break;
+ case CCL_MOD: reg[rrr] = i % j; break;
+ case CCL_AND: reg[rrr] = i & j; break;
+ case CCL_OR: reg[rrr] = i | j; break;
+ case CCL_XOR: reg[rrr] = i ^ j;; break;
+ case CCL_LSH: reg[rrr] = i << j; break;
+ case CCL_RSH: reg[rrr] = i >> j; break;
+ case CCL_LSH8: reg[rrr] = (i << 8) | j; break;
+ case CCL_RSH8: reg[rrr] = i >> 8; reg[7] = i & 0xFF; break;
+ case CCL_DIVMOD: reg[rrr] = i / j; reg[7] = i % j; break;
+ case CCL_LS: reg[rrr] = i < j; break;
+ case CCL_GT: reg[rrr] = i > j; break;
+ case CCL_EQ: reg[rrr] = i == j; break;
+ case CCL_LE: reg[rrr] = i <= j; break;
+ case CCL_GE: reg[rrr] = i >= j; break;
+ case CCL_NE: reg[rrr] = i != j; break;
+ case CCL_ENCODE_SJIS: ENCODE_SJIS (i, j, reg[rrr], reg[7]); break;
+ case CCL_DECODE_SJIS: DECODE_SJIS (i, j, reg[rrr], reg[7]); break;
+ default: CCL_INVALID_CMD;
+ }
+ code &= 0x1F;
+ if (code == CCL_WriteExprConst || code == CCL_WriteExprRegister)
+ {
+ i = reg[rrr];
+ CCL_WRITE_CHAR (i);
+ }
+ else if (!reg[rrr])
+ ic = jump_address;
+ break;
+
+ default:
+ CCL_INVALID_CMD;
+ }
+ }
+
+ ccl_error_handler:
+ if (destination)
+ {
+ /* We can insert an error message only if DESTINATION is
+ specified and we still have a room to store the message
+ there. */
+ char msg[256];
+ int msglen;
+
+ switch (ccl->status)
+ {
+ case CCL_STAT_INVALID_CMD:
+ sprintf(msg, "\nCCL: Invalid command %x (ccl_code = %x) at %d.",
+ code & 0x1F, code, ic);
+#ifdef CCL_DEBUG
+ {
+ int i = ccl_backtrace_idx - 1;
+ int j;
+
+ msglen = strlen (msg);
+ if (dst + msglen <= dst_end)
+ {
+ bcopy (msg, dst, msglen);
+ dst += msglen;
+ }
+
+ for (j = 0; j < CCL_DEBUG_BACKTRACE_LEN; j++, i--)
+ {
+ if (i < 0) i = CCL_DEBUG_BACKTRACE_LEN - 1;
+ if (ccl_backtrace_table[i] == 0)
+ break;
+ sprintf(msg, " %d", ccl_backtrace_table[i]);
+ msglen = strlen (msg);
+ if (dst + msglen > dst_end)
+ break;
+ bcopy (msg, dst, msglen);
+ dst += msglen;
+ }
+ }
+ goto ccl_finish;
+#endif
+
+ case CCL_STAT_QUIT:
+ sprintf(msg, "\nCCL: Quited.");
+ break;
+
+ default:
+ sprintf(msg, "\nCCL: Unknown error type (%d).", ccl->status);
+ }
+
+ msglen = strlen (msg);
+ if (dst + msglen <= dst_end)
+ {
+ bcopy (msg, dst, msglen);
+ dst += msglen;
+ }
+ }
+
+ ccl_finish:
+ ccl->ic = ic;
+ if (consumed) *consumed = src - source;
+ return dst - destination;
+}
+
+/* Setup fields of the structure pointed by CCL appropriately for the
+ execution of compiled CCL code in VEC (vector of integer). */
+setup_ccl_program (ccl, vec)
+ struct ccl_program *ccl;
+ Lisp_Object vec;
+{
+ int i;
+
+ ccl->size = XVECTOR (vec)->size;
+ ccl->prog = XVECTOR (vec)->contents;
+ ccl->ic = CCL_HEADER_MAIN;
+ ccl->eof_ic = XINT (XVECTOR (vec)->contents[CCL_HEADER_EOF]);
+ ccl->buf_magnification = XINT (XVECTOR (vec)->contents[CCL_HEADER_BUF_MAG]);
+ for (i = 0; i < 8; i++)
+ ccl->reg[i] = 0;
+ ccl->last_block = 0;
+ ccl->status = 0;
+}
+
+#ifdef emacs
+
+DEFUN ("ccl-execute", Fccl_execute, Sccl_execute, 2, 2, 0,
+ "Execute CCL-PROGRAM with registers initialized by REGISTERS.\n\
+CCL-PROGRAM is a compiled code generated by `ccl-compile',\n\
+ no I/O commands should appear in the CCL program.\n\
+REGISTERS is a vector of [R0 R1 ... R7] where RN is an initial value\n\
+ of Nth register.\n\
+As side effect, each element of REGISTER holds the value of\n\
+ corresponding register after the execution.")
+ (ccl_prog, reg)
+ Lisp_Object ccl_prog, reg;
+{
+ struct ccl_program ccl;
+ int i;
+
+ CHECK_VECTOR (ccl_prog, 0);
+ CHECK_VECTOR (reg, 1);
+ if (XVECTOR (reg)->size != 8)
+ error ("Invalid length of vector REGISTERS");
+
+ setup_ccl_program (&ccl, ccl_prog);
+ for (i = 0; i < 8; i++)
+ ccl.reg[i] = (INTEGERP (XVECTOR (reg)->contents[i])
+ ? XINT (XVECTOR (reg)->contents[i])
+ : 0);
+
+ ccl_driver (&ccl, (char *)0, (char *)0, 0, 0, (int *)0);
+ QUIT;
+ if (ccl.status != CCL_STAT_SUCCESS)
+ error ("Error in CCL program at %dth code", ccl.ic);
+
+ for (i = 0; i < 8; i++)
+ XSETINT (XVECTOR (reg)->contents[i], ccl.reg[i]);
+ return Qnil;
+}
+
+DEFUN ("ccl-execute-on-string", Fccl_execute_on_string, Sccl_execute_on_string,
+ 3, 3, 0,
+ "Execute CCL-PROGRAM with initial STATUS on STRING.\n\
+CCL-PROGRAM is a compiled code generated by `ccl-compile'.\n\
+Read buffer is set to STRING, and write buffer is allocated automatically.\n\
+STATUS is a vector of [R0 R1 ... R7 IC], where\n\
+ R0..R7 are initial values of corresponding registers,\n\
+ IC is the instruction counter specifying from where to start the program.\n\
+If R0..R7 are nil, they are initialized to 0.\n\
+If IC is nil, it is initialized to head of the CCL program.\n\
+Returns the contents of write buffer as a string,\n\
+ and as side effect, STATUS is updated.")
+ (ccl_prog, status, str)
+ Lisp_Object ccl_prog, status, str;
+{
+ Lisp_Object val;
+ struct ccl_program ccl;
+ int i, produced;
+ int outbufsize;
+ char *outbuf;
+ struct gcpro gcpro1, gcpro2, gcpro3;
+
+ CHECK_VECTOR (ccl_prog, 0);
+ CHECK_VECTOR (status, 1);
+ if (XVECTOR (status)->size != 9)
+ error ("Invalid length of vector STATUS");
+ CHECK_STRING (str, 2);
+ GCPRO3 (ccl_prog, status, str);
+
+ setup_ccl_program (&ccl, ccl_prog);
+ for (i = 0; i < 8; i++)
+ {
+ if (NILP (XVECTOR (status)->contents[i]))
+ XSETINT (XVECTOR (status)->contents[i], 0);
+ if (INTEGERP (XVECTOR (status)->contents[i]))
+ ccl.reg[i] = XINT (XVECTOR (status)->contents[i]);
+ }
+ if (INTEGERP (XVECTOR (status)->contents[i]))
+ {
+ i = XFASTINT (XVECTOR (status)->contents[8]);
+ if (ccl.ic < i && i < ccl.size)
+ ccl.ic = i;
+ }
+ outbufsize = XSTRING (str)->size * ccl.buf_magnification + 256;
+ outbuf = (char *) xmalloc (outbufsize);
+ if (!outbuf)
+ error ("Not enough memory");
+ ccl.last_block = 1;
+ produced = ccl_driver (&ccl, XSTRING (str)->data, outbuf,
+ XSTRING (str)->size, outbufsize, (int *)0);
+ for (i = 0; i < 8; i++)
+ XSET (XVECTOR (status)->contents[i], Lisp_Int, ccl.reg[i]);
+ XSETINT (XVECTOR (status)->contents[8], ccl.ic);
+ UNGCPRO;
+
+ val = make_string (outbuf, produced);
+ free (outbuf);
+ QUIT;
+ if (ccl.status != CCL_STAT_SUCCESS
+ && ccl.status != CCL_STAT_SUSPEND)
+ error ("Error in CCL program at %dth code", ccl.ic);
+
+ return val;
+}
+
+DEFUN ("register-ccl-program", Fregister_ccl_program, Sregister_ccl_program,
+ 2, 2, 0,
+ "Register CCL program PROGRAM of NAME in `ccl-program-table'.
+PROGRAM should be a compiled code of CCL program, or nil.
+Return index number of the registered CCL program.")
+ (name, ccl_prog)
+ Lisp_Object name, ccl_prog;
+{
+ int len = XVECTOR (Vccl_program_table)->size;
+ int i, idx;
+
+ CHECK_SYMBOL (name, 0);
+ if (!NILP (ccl_prog))
+ CHECK_VECTOR (ccl_prog, 1);
+
+ for (i = 0; i < len; i++)
+ {
+ Lisp_Object slot = XVECTOR (Vccl_program_table)->contents[i];
+
+ if (!CONSP (slot))
+ break;
+
+ if (EQ (name, XCONS (slot)->car))
+ {
+ XCONS (slot)->cdr = ccl_prog;
+ return make_number (i);
+ }
+ }
+
+ if (i == len)
+ {
+ Lisp_Object new_table = Fmake_vector (len * 2, Qnil);
+ int j;
+
+ for (j = 0; j < len; j++)
+ XVECTOR (new_table)->contents[j]
+ = XVECTOR (Vccl_program_table)->contents[j];
+ Vccl_program_table = new_table;
+ }
+
+ XVECTOR (Vccl_program_table)->contents[i] = Fcons (name, ccl_prog);
+ return make_number (i);
+}
+
+syms_of_ccl ()
+{
+ staticpro (&Vccl_program_table);
+ Vccl_program_table = Fmake_vector (32, Qnil);
+
+ DEFVAR_LISP ("font-ccl-encoder-alist", &Vfont_ccl_encoder_alist,
+ "Alist of fontname patterns vs corresponding CCL program.\n\
+Each element looks like (REGEXP . CCL-CODE),\n\
+ where CCL-CODE is a compiled CCL program.\n\
+When a font whose name matches REGEXP is used for displaying a character,\n\
+ CCL-CODE is executed to calculate the code point in the font\n\
+ from the charset number and position code(s) of the character which are set\n\
+ in CCL registers R0, R1, and R2 before the execution.\n\
+The code point in the font is set in CCL registers R1 and R2\n\
+ when the execution terminated.\n\
+If the font is single-byte font, the register R2 is not used.");
+ Vfont_ccl_encoder_alist = Qnil;
+
+ defsubr (&Sccl_execute);
+ defsubr (&Sccl_execute_on_string);
+ defsubr (&Sregister_ccl_program);
+}
+
+#endif /* emacs */
diff --git a/src/ccl.h b/src/ccl.h
new file mode 100644
index 00000000000..ebda0cc1595
--- /dev/null
+++ b/src/ccl.h
@@ -0,0 +1,53 @@
+/* Header for CCL (Code Conversion Language) interpreter.
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef _CCL_H
+#define _CCL_H
+
+/* Structure to hold information about running CCL code. Read
+ comments in the file ccl.c for the detail of each field. */
+struct ccl_program {
+ int size; /* Size of the compiled code. */
+ Lisp_Object *prog; /* Pointer into the compiled code. */
+ int ic; /* Instruction Counter (index for PROG). */
+ int eof_ic; /* Instruction Counter for end-of-file
+ processing code. */
+ int reg[8]; /* CCL registers, reg[7] is used for
+ condition flag of relational
+ operations. */
+ int last_block; /* Set to 1 while processing the last
+ block. */
+ int status; /* Exit status of the CCL program. */
+ int buf_magnification; /* Output buffer magnification. How
+ many times bigger the output buffer
+ should be than the input buffer. */
+};
+
+/* This data type is used for the spec field of the structure
+ coding_system. */
+
+struct ccl_spec {
+ struct ccl_program decoder;
+ struct ccl_program encoder;
+};
+
+/* Alist of fontname patterns vs corresponding CCL program. */
+extern Lisp_Object Vfont_ccl_encoder_alist;
+
+#endif /* _CCL_H */
diff --git a/src/charset.c b/src/charset.c
new file mode 100644
index 00000000000..b962f346f22
--- /dev/null
+++ b/src/charset.c
@@ -0,0 +1,1452 @@
+/* Multilingual characters handler.
+ Ver.1.0
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/* At first, see the document in `charset.h' to understand the code in
+ this file. */
+
+#include <stdio.h>
+
+#ifdef emacs
+
+#include <sys/types.h>
+#include <config.h>
+#include "lisp.h"
+#include "buffer.h"
+#include "charset.h"
+#include "coding.h"
+
+#else /* not emacs */
+
+#include "mulelib.h"
+
+#endif /* emacs */
+
+Lisp_Object Qcharset, Qascii, Qcomposition;
+
+/* Declaration of special leading-codes. */
+int leading_code_composition; /* for composite characters */
+int leading_code_private_11; /* for private DIMENSION1 of 1-column */
+int leading_code_private_12; /* for private DIMENSION1 of 2-column */
+int leading_code_private_21; /* for private DIMENSION2 of 1-column */
+int leading_code_private_22; /* for private DIMENSION2 of 2-column */
+
+/* Declaration of special charsets. */
+int charset_ascii; /* ASCII */
+int charset_composition; /* for a composite character */
+int charset_latin_iso8859_1; /* ISO8859-1 (Latin-1) */
+int charset_jisx0208_1978; /* JISX0208.1978 (Japanese Kanji old set) */
+int charset_jisx0208; /* JISX0208.1983 (Japanese Kanji) */
+int charset_katakana_jisx0201; /* JISX0201.Kana (Japanese Katakana) */
+int charset_latin_jisx0201; /* JISX0201.Roman (Japanese Roman) */
+int charset_big5_1; /* Big5 Level 1 (Chinese Traditional) */
+int charset_big5_2; /* Big5 Level 2 (Chinese Traditional) */
+
+Lisp_Object Qcharset_table;
+
+/* A char-table containing information of each character set. */
+Lisp_Object Vcharset_table;
+
+/* A vector of charset symbol indexed by charset-id. This is used
+ only for returning charset symbol from C functions. */
+Lisp_Object Vcharset_symbol_table;
+
+/* A list of charset symbols ever defined. */
+Lisp_Object Vcharset_list;
+
+/* Tables used by macros BYTES_BY_CHAR_HEAD and WIDTH_BY_CHAR_HEAD. */
+int bytes_by_char_head[256];
+int width_by_char_head[256];
+
+/* Mapping table from ISO2022's charset (specified by DIMENSION,
+ CHARS, and FINAL-CHAR) to Emacs' charset. */
+int iso_charset_table[2][2][128];
+
+/* Variables used locally in the macro FETCH_MULTIBYTE_CHAR. */
+unsigned char *_fetch_multibyte_char_p;
+int _fetch_multibyte_char_len;
+
+/* Set STR a pointer to the multi-byte form of the character C. If C
+ is not a composite character, the multi-byte form is set in WORKBUF
+ and STR points WORKBUF. The caller should allocate at least 4-byte
+ area at WORKBUF in advance. Returns the length of the multi-byte
+ form.
+
+ Use macro `CHAR_STRING (C, WORKBUF, STR)' instead of calling this
+ function directly if C can be an ASCII character. */
+
+int
+non_ascii_char_to_string (c, workbuf, str)
+ int c;
+ unsigned char *workbuf, **str;
+{
+ int charset;
+ unsigned char c1, c2;
+
+ if (COMPOSITE_CHAR_P (c))
+ {
+ int cmpchar_id = COMPOSITE_CHAR_ID (c);
+
+ if (cmpchar_id < n_cmpchars)
+ {
+ *str = cmpchar_table[cmpchar_id]->data;
+ return cmpchar_table[cmpchar_id]->len;
+ }
+ else
+ {
+ *str = workbuf;
+ return 0;
+ }
+ }
+
+ SPLIT_NON_ASCII_CHAR (c, charset, c1, c2);
+
+ *str = workbuf;
+ *workbuf++ = CHARSET_LEADING_CODE_BASE (charset);
+ if (*workbuf = CHARSET_LEADING_CODE_EXT (charset))
+ workbuf++;
+ *workbuf++ = c1 | 0x80;
+ if (c2)
+ *workbuf++ = c2 | 0x80;
+
+ return (workbuf - *str);
+}
+
+/* Return a non-ASCII character of which multi-byte form is at STR of
+ length LEN. If ACTUAL_LEN is not NULL, the actual length of the
+ character is set to the address ACTUAL_LEN.
+
+ Use macro `STRING_CHAR (STR, LEN)' instead of calling this function
+ directly if STR can hold an ASCII character. */
+
+string_to_non_ascii_char (str, len, actual_len)
+ unsigned char *str;
+ int len, *actual_len;
+{
+ int charset;
+ unsigned char c1, c2;
+ register int c;
+
+ if (SPLIT_STRING (str, len, charset, c1, c2) == CHARSET_ASCII)
+ {
+ if (actual_len)
+ *actual_len = 1;
+ return (int) *str;
+ }
+
+ c = MAKE_NON_ASCII_CHAR (charset, c1, c2);
+
+ if (actual_len)
+ *actual_len = (charset == CHARSET_COMPOSITION
+ ? cmpchar_table[COMPOSITE_CHAR_ID (c)]->len
+ : BYTES_BY_CHAR_HEAD (*str));
+ return c;
+}
+
+/* Return the length of the multi-byte form at string STR of length LEN. */
+int
+multibyte_form_length (str, len)
+ unsigned char *str;
+ int len;
+{
+ int charset;
+ unsigned char c1, c2;
+ register int c;
+
+ if (SPLIT_STRING (str, len, charset, c1, c2) == CHARSET_ASCII)
+ return 1;
+
+ return (charset == CHARSET_COMPOSITION
+ ? cmpchar_table[(c1 << 7) | c2]->len
+ : BYTES_BY_CHAR_HEAD (*str));
+}
+
+/* Check if string STR of length LEN contains valid multi-byte form of
+ a character. If valid, charset and position codes of the character
+ is set at *CHARSET, *C1, and *C2, and return 0. If not valid,
+ return -1. This should be used only in the macro SPLIT_STRING
+ which checks range of STR in advance. */
+
+split_non_ascii_string (str, len, charset, c1, c2)
+ register unsigned char *str, *c1, *c2;
+ register int len, *charset;
+{
+ register unsigned int cs = *str++;
+
+ if (cs == LEADING_CODE_COMPOSITION)
+ {
+ int cmpchar_id = str_cmpchar_id (str - 1, len);
+
+ if (cmpchar_id < 0)
+ return -1;
+ *charset = cs, *c1 = cmpchar_id >> 7, *c2 = cmpchar_id & 0x7F;
+ }
+ else if ((cs < LEADING_CODE_PRIVATE_11 || (cs = *str++) >= 0xA0)
+ && CHARSET_DEFINED_P (cs))
+ {
+ *charset = cs;
+ if (*str < 0xA0)
+ return -1;
+ *c1 = (*str++) & 0x7F;
+ if (CHARSET_DIMENSION (cs) == 2)
+ {
+ if (*str < 0xA0)
+ return -1;
+ *c2 = (*str++) & 0x7F;
+ }
+ }
+ else
+ return -1;
+ return 0;
+}
+
+/* Update the table Vcharset_table with the given arguments (see the
+ document of `define-charset' for the meaning of each argument).
+ Several other table contents are also updated. The caller should
+ check the validity of CHARSET-ID and the remaining arguments in
+ advance. */
+
+void
+update_charset_table (charset_id, dimension, chars, width, direction,
+ iso_final_char, iso_graphic_plane,
+ short_name, long_name, description)
+ Lisp_Object charset_id, dimension, chars, width, direction;
+ Lisp_Object iso_final_char, iso_graphic_plane;
+ Lisp_Object short_name, long_name, description;
+{
+ int charset = XINT (charset_id);
+ int bytes;
+ unsigned char leading_code_base, leading_code_ext;
+
+ if (NILP (Faref (Vcharset_table, charset_id)))
+ Faset (Vcharset_table, charset_id,
+ Fmake_vector (make_number (CHARSET_MAX_IDX), Qnil));
+
+ /* Get byte length of multibyte form, base leading-code, and
+ extended leading-code of the charset. See the comment under the
+ title "GENERAL NOTE on CHARACTER SET (CHARSET)" in charset.h. */
+ bytes = XINT (dimension);
+ if (charset < MIN_CHARSET_PRIVATE_DIMENSION1)
+ {
+ /* Official charset, it doesn't have an extended leading-code. */
+ if (charset != CHARSET_ASCII)
+ bytes += 1; /* For a base leading-code. */
+ leading_code_base = charset;
+ leading_code_ext = 0;
+ }
+ else
+ {
+ /* Private charset. */
+ bytes += 2; /* For base and extended leading-codes. */
+ leading_code_base
+ = (charset < LEADING_CODE_EXT_12
+ ? LEADING_CODE_PRIVATE_11
+ : (charset < LEADING_CODE_EXT_21
+ ? LEADING_CODE_PRIVATE_12
+ : (charset < LEADING_CODE_EXT_22
+ ? LEADING_CODE_PRIVATE_21
+ : LEADING_CODE_PRIVATE_22)));
+ leading_code_ext = charset;
+ }
+
+ CHARSET_TABLE_INFO (charset, CHARSET_ID_IDX) = charset_id;
+ CHARSET_TABLE_INFO (charset, CHARSET_BYTES_IDX) = make_number (bytes);
+ CHARSET_TABLE_INFO (charset, CHARSET_DIMENSION_IDX) = dimension;
+ CHARSET_TABLE_INFO (charset, CHARSET_CHARS_IDX) = chars;
+ CHARSET_TABLE_INFO (charset, CHARSET_WIDTH_IDX) = width;
+ CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX) = direction;
+ CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_BASE_IDX)
+ = make_number (leading_code_base);
+ CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_EXT_IDX)
+ = make_number (leading_code_ext);
+ CHARSET_TABLE_INFO (charset, CHARSET_ISO_FINAL_CHAR_IDX) = iso_final_char;
+ CHARSET_TABLE_INFO (charset, CHARSET_ISO_GRAPHIC_PLANE_IDX)
+ = iso_graphic_plane;
+ CHARSET_TABLE_INFO (charset, CHARSET_SHORT_NAME_IDX) = short_name;
+ CHARSET_TABLE_INFO (charset, CHARSET_LONG_NAME_IDX) = long_name;
+ CHARSET_TABLE_INFO (charset, CHARSET_DESCRIPTION_IDX) = description;
+ CHARSET_TABLE_INFO (charset, CHARSET_PLIST_IDX) = Qnil;
+
+ {
+ /* If we have already defined a charset which has the same
+ DIMENSION, CHARS and ISO-FINAL-CHAR but the different
+ DIRECTION, we must update the entry REVERSE-CHARSET of both
+ charsets. If there's no such charset, the value of the entry
+ is set to nil. */
+ int i;
+
+ for (i = 0; i < MAX_CHARSET; i++)
+ if (!NILP (CHARSET_TABLE_ENTRY (i)))
+ {
+ if (CHARSET_DIMENSION (i) == XINT (dimension)
+ && CHARSET_CHARS (i) == XINT (chars)
+ && CHARSET_ISO_FINAL_CHAR (i) == XINT (iso_final_char)
+ && CHARSET_DIRECTION (i) != XINT (direction))
+ {
+ CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
+ = make_number (i);
+ CHARSET_TABLE_INFO (i, CHARSET_REVERSE_CHARSET_IDX) = charset_id;
+ break;
+ }
+ }
+ if (i >= MAX_CHARSET)
+ /* No such a charset. */
+ CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX)
+ = make_number (-1);
+ }
+
+ if (charset != CHARSET_ASCII
+ && charset < MIN_CHARSET_PRIVATE_DIMENSION1)
+ {
+ /* Update tables bytes_by_char_head and width_by_char_head. */
+ bytes_by_char_head[leading_code_base] = bytes;
+ width_by_char_head[leading_code_base] = XINT (width);
+
+ /* Update table emacs_code_class. */
+ emacs_code_class[charset] = (bytes == 2
+ ? EMACS_leading_code_2
+ : (bytes == 3
+ ? EMACS_leading_code_3
+ : EMACS_leading_code_4));
+ }
+
+ /* Update table iso_charset_table. */
+ if (ISO_CHARSET_TABLE (dimension, chars, iso_final_char) < 0)
+ ISO_CHARSET_TABLE (dimension, chars, iso_final_char) = charset;
+}
+
+#ifdef emacs
+
+/* Return charset id of CHARSET_SYMBOL, or return -1 if CHARSET_SYMBOL
+ is invalid. */
+int
+get_charset_id (charset_symbol)
+ Lisp_Object charset_symbol;
+{
+ Lisp_Object val;
+ int charset;
+
+ return ((SYMBOLP (charset_symbol)
+ && (val = Fget (charset_symbol, Qcharset), VECTORP (val))
+ && (charset = XINT (XVECTOR (val)->contents[CHARSET_ID_IDX]),
+ CHARSET_VALID_P (charset)))
+ ? charset : -1);
+}
+
+/* Return an identification number for a new private charset of
+ DIMENSION and WIDTH. If there's no more room for the new charset,
+ return 0. */
+Lisp_Object
+get_new_private_charset_id (dimension, width)
+ int dimension, width;
+{
+ int charset, from, to;
+
+ if (dimension == 1)
+ {
+ if (width == 1)
+ from = LEADING_CODE_EXT_11, to = LEADING_CODE_EXT_12;
+ else
+ from = LEADING_CODE_EXT_12, to = LEADING_CODE_EXT_21;
+ }
+ else
+ {
+ if (width == 1)
+ from = LEADING_CODE_EXT_21, to = LEADING_CODE_EXT_22;
+ else
+ from = LEADING_CODE_EXT_22, to = LEADING_CODE_EXT_MAX - 1;
+ }
+
+ for (charset = from; charset < to; charset++)
+ if (!CHARSET_DEFINED_P (charset)) break;
+
+ return make_number (charset < to ? charset : 0);
+}
+
+DEFUN ("define-charset", Fdefine_charset, Sdefine_charset, 3, 3, 0,
+ "Define CHARSET-ID as the identification number of CHARSET with INFO-VECTOR.\n\
+If CHARSET-ID is nil, it is set automatically, which means CHARSET is\n\
+ treated as a private charset.\n\
+INFO-VECTOR is a vector of the format:\n\
+ [DIMENSION CHARS WIDTH DIRECTION ISO-FINAL-CHAR ISO-GRAPHIC-PLANE\n\
+ SHORT-NAME LONG-NAME DESCRIPTION]\n\
+The meanings of each elements is as follows:\n\
+DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.\n\
+CHARS (integer) is the number of characters in a dimension: 94 or 96.\n\
+WIDTH (integer) is the number of columns a character in the charset\n\
+occupies on the screen: one of 0, 1, and 2.\n\
+\n\
+DIRECTION (integer) is the rendering direction of characters in the\n\
+charset when rendering. If 0, render from right to left, else\n\
+render from left to right.\n\
+\n\
+ISO-FINAL-CHAR (character) is the final character of the\n\
+corresponding ISO 2022 charset.\n\
+\n\
+ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked\n\
+while encoding to variants of ISO 2022 coding system, one of the\n\
+following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).\n\
+\n\
+SHORT-NAME (string) is the short name to refer to the charset.\n\
+\n\
+LONG-NAME (string) is the long name to refer to the charset.\n\
+\n\
+DESCRIPTION (string) is the description string of the charset.")
+ (charset_id, charset_symbol, info_vector)
+ Lisp_Object charset_id, charset_symbol, info_vector;
+{
+ Lisp_Object *vec;
+
+ if (!NILP (charset_id))
+ CHECK_NUMBER (charset_id, 0);
+ CHECK_SYMBOL (charset_symbol, 1);
+ CHECK_VECTOR (info_vector, 2);
+
+ if (! NILP (charset_id))
+ {
+ if (! CHARSET_VALID_P (XINT (charset_id)))
+ error ("Invalid CHARSET: %d", XINT (charset_id));
+ else if (CHARSET_DEFINED_P (XINT (charset_id)))
+ error ("Already defined charset: %d", XINT (charset_id));
+ }
+
+ vec = XVECTOR (info_vector)->contents;
+ if (XVECTOR (info_vector)->size != 9
+ || !INTEGERP (vec[0]) || !(XINT (vec[0]) == 1 || XINT (vec[0]) == 2)
+ || !INTEGERP (vec[1]) || !(XINT (vec[1]) == 94 || XINT (vec[1]) == 96)
+ || !INTEGERP (vec[2]) || !(XINT (vec[2]) == 1 || XINT (vec[2]) == 2)
+ || !INTEGERP (vec[3]) || !(XINT (vec[3]) == 0 || XINT (vec[3]) == 1)
+ || !INTEGERP (vec[4]) || !(XINT (vec[4]) >= '0' && XINT (vec[4]) <= '~')
+ || !INTEGERP (vec[5]) || !(XINT (vec[5]) == 0 || XINT (vec[5]) == 1)
+ || !STRINGP (vec[6])
+ || !STRINGP (vec[7])
+ || !STRINGP (vec[8]))
+ error ("Invalid info-vector argument for defining charset %s",
+ XSYMBOL (charset_symbol)->name->data);
+
+ if (NILP (charset_id))
+ {
+ charset_id = get_new_private_charset_id (XINT (vec[0]), XINT (vec[2]));
+ if (XINT (charset_id) == 0)
+ error ("There's no room for a new private charset %s",
+ XSYMBOL (charset_symbol)->name->data);
+ }
+
+ update_charset_table (charset_id, vec[0], vec[1], vec[2], vec[3],
+ vec[4], vec[5], vec[6], vec[7], vec[8]);
+ Fput (charset_symbol, Qcharset, Faref (Vcharset_table, charset_id));
+ CHARSET_SYMBOL (XINT (charset_id)) = charset_symbol;
+ Vcharset_list = Fcons (charset_symbol, Vcharset_list);
+ return Qnil;
+}
+
+DEFUN ("declare-equiv-charset", Fdeclare_equiv_charset, Sdeclare_equiv_charset,
+ 4, 4, 0,
+ "Declare a charset of DIMENSION, CHARS, FINAL-CHAR is the same as CHARSET.\n\
+CHARSET should be defined by `defined-charset' in advance.")
+ (dimension, chars, final_char, charset_symbol)
+ Lisp_Object dimension, chars, final_char, charset_symbol;
+{
+ int charset;
+
+ CHECK_NUMBER (dimension, 0);
+ CHECK_NUMBER (chars, 1);
+ CHECK_NUMBER (final_char, 2);
+ CHECK_SYMBOL (charset_symbol, 3);
+
+ if (XINT (dimension) != 1 && XINT (dimension) != 2)
+ error ("Invalid DIMENSION %d, it should be 1 or 2", XINT (dimension));
+ if (XINT (chars) != 94 && XINT (chars) != 96)
+ error ("Invalid CHARS %d, it should be 94 or 96", XINT (chars));
+ if (XINT (final_char) < '0' || XFASTINT (final_char) > '~')
+ error ("Invalid FINAL-CHAR %c, it should be `0'..`~'", XINT (chars));
+ if ((charset = get_charset_id (charset_symbol)) < 0)
+ error ("Invalid charset %s", XSYMBOL (charset_symbol)->name->data);
+
+ ISO_CHARSET_TABLE (dimension, chars, final_char) = charset;
+ return Qnil;
+}
+
+/* Return number of different charsets in STR of length LEN. In
+ addition, for each found charset N, CHARSETS[N] is set 1. The
+ caller should allocate CHARSETS (MAX_CHARSET bytes) in advance. */
+
+int
+find_charset_in_str (str, len, charsets)
+ unsigned char *str, *charsets;
+ int len;
+{
+ int num = 0;
+
+ while (len > 0)
+ {
+ int bytes = BYTES_BY_CHAR_HEAD (*str);
+ int charset = CHARSET_AT (str);
+
+ if (!charsets[charset])
+ {
+ charsets[charset] = 1;
+ num += 1;
+ }
+ str += bytes;
+ len -= bytes;
+ }
+ return num;
+}
+
+DEFUN ("find-charset-region", Ffind_charset_region, Sfind_charset_region,
+ 2, 2, 0,
+ "Return a list of charsets in the region between BEG and END.\n\
+BEG and END are buffer positions.")
+ (beg, end)
+ Lisp_Object beg, end;
+{
+ char charsets[MAX_CHARSET];
+ int from, to, stop, i;
+ Lisp_Object val;
+
+ validate_region (&beg, &end);
+ from = XFASTINT (beg);
+ stop = to = XFASTINT (end);
+ if (from < GPT && GPT < to)
+ stop = GPT;
+ bzero (charsets, MAX_CHARSET);
+ while (1)
+ {
+ find_charset_in_str (POS_ADDR (from), stop - from, charsets);
+ if (stop < to)
+ from = stop, stop = to;
+ else
+ break;
+ }
+ val = Qnil;
+ for (i = MAX_CHARSET - 1; i >= 0; i--)
+ if (charsets[i])
+ val = Fcons (CHARSET_SYMBOL (i), val);
+ return val;
+}
+
+DEFUN ("find-charset-string", Ffind_charset_string, Sfind_charset_string,
+ 1, 1, 0,
+ "Return a list of charsets in STR.")
+ (str)
+ Lisp_Object str;
+{
+ char charsets[MAX_CHARSET];
+ int i;
+ Lisp_Object val;
+
+ CHECK_STRING (str, 0);
+ bzero (charsets, MAX_CHARSET);
+ find_charset_in_str (XSTRING (str)->data, XSTRING (str)->size, charsets);
+ val = Qnil;
+ for (i = MAX_CHARSET - 1; i >= 0; i--)
+ if (charsets[i])
+ val = Fcons (CHARSET_SYMBOL (i), val);
+ return val;
+}
+
+DEFUN ("make-char-internal", Fmake_char_internal, Smake_char_internal, 1, 3, 0,
+ "Return a character of CHARSET and position-codes CODE1 and CODE2.\n\
+CODE1 and CODE2 are optional, but if you don't supply\n\
+ sufficient position-codes, return a generic character which stands for\n\
+all characters or group of characters in the character sets.\n\
+A generic character can be an argument of `modify-syntax-entry' and\n\
+`modify-category-entry'.")
+ (charset, code1, code2)
+ Lisp_Object charset, code1, code2;
+{
+ CHECK_NUMBER (charset, 0);
+
+ if (NILP (code1))
+ XSETFASTINT (code1, 0);
+ else
+ CHECK_NUMBER (code1, 1);
+ if (NILP (code2))
+ XSETFASTINT (code2, 0);
+ else
+ CHECK_NUMBER (code2, 2);
+
+ if (!CHARSET_DEFINED_P (XINT (charset)))
+ error ("Invalid charset: %d", XINT (charset));
+
+ return make_number (MAKE_CHAR (XINT (charset), XINT (code1), XINT (code2)));
+}
+
+DEFUN ("split-char", Fsplit_char, Ssplit_char, 1, 1, 0,
+ "Return list of charset and one or two position-codes of CHAR.")
+ (ch)
+ Lisp_Object ch;
+{
+ Lisp_Object val;
+ int charset;
+ unsigned char c1, c2;
+
+ CHECK_NUMBER (ch, 0);
+ SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
+ return ((charset == CHARSET_COMPOSITION || CHARSET_DIMENSION (charset) == 2)
+ ? Fcons (CHARSET_SYMBOL (charset),
+ Fcons (make_number (c1), Fcons (make_number (c2), Qnil)))
+ : Fcons (CHARSET_SYMBOL (charset), Fcons (make_number (c1), Qnil)));
+}
+
+DEFUN ("char-charset", Fchar_charset, Schar_charset, 1, 1, 0,
+ "Return charset of CHAR.")
+ (ch)
+ Lisp_Object ch;
+{
+ CHECK_NUMBER (ch, 0);
+
+ return CHARSET_SYMBOL (CHAR_CHARSET (XINT (ch)));
+}
+
+DEFUN ("iso-charset", Fiso_charset, Siso_charset, 3, 3, 0,
+ "Return charset of ISO's specification DIMENSION, CHARS, and FINAL-CHAR.")
+ (dimension, chars, final_char)
+ Lisp_Object dimension, chars, final_char;
+{
+ int charset;
+
+ CHECK_NUMBER (dimension, 0);
+ CHECK_NUMBER (chars, 1);
+ CHECK_NUMBER (final_char, 2);
+
+ if ((charset = ISO_CHARSET_TABLE (dimension, chars, final_char)) < 0)
+ return Qnil;
+ return CHARSET_SYMBOL (charset);
+}
+
+DEFUN ("char-bytes", Fchar_bytes, Schar_bytes, 1, 1, 0,
+ "Return byte length of multi-byte form of CHAR.")
+ (ch)
+ Lisp_Object ch;
+{
+ Lisp_Object val;
+ int bytes;
+
+ CHECK_NUMBER (ch, 0);
+ if (COMPOSITE_CHAR_P (XFASTINT (ch)))
+ {
+ unsigned int id = COMPOSITE_CHAR_ID (XFASTINT (ch));
+
+ bytes = (id < n_cmpchars ? cmpchar_table[id]->len : 1);
+ }
+ else
+ {
+ int charset = CHAR_CHARSET (XFASTINT (ch));
+
+ bytes = CHARSET_DEFINED_P (charset) ? CHARSET_BYTES (charset) : 1;
+ }
+
+ XSETFASTINT (val, bytes);
+ return val;
+}
+
+/* Return the width of character of which multi-byte form starts with
+ C. The width is measured by how many columns occupied on the
+ screen when displayed in the current buffer. */
+
+#define ONE_BYTE_CHAR_WIDTH(c) \
+ (c < 0x20 \
+ ? (c == '\t' \
+ ? current_buffer->tab_width \
+ : (c == '\n' ? 0 : (NILP (current_buffer->ctl_arrow) ? 4 : 2))) \
+ : (c < 0x7f \
+ ? 1 \
+ : (c == 0x7F \
+ ? (NILP (current_buffer->ctl_arrow) ? 4 : 2) \
+ : ((! NILP (current_buffer->enable_multibyte_characters) \
+ && BASE_LEADING_CODE_P (c)) \
+ ? WIDTH_BY_CHAR_HEAD (c) \
+ : 4)))) \
+
+
+DEFUN ("char-width", Fchar_width, Schar_width, 1, 1, 0,
+ "Return width of CHAR when displayed in the current buffer.\n\
+The width is measured by how many columns it occupies on the screen.")
+ (ch)
+ Lisp_Object ch;
+{
+ Lisp_Object val;
+ int c;
+
+ CHECK_NUMBER (ch, 0);
+
+ c = XFASTINT (ch);
+ if (SINGLE_BYTE_CHAR_P (c))
+ XSETFASTINT (val, ONE_BYTE_CHAR_WIDTH (c));
+ else if (COMPOSITE_CHAR_P (c))
+ {
+ int id = COMPOSITE_CHAR_ID (XFASTINT (ch));
+ XSETFASTINT (val, (id < n_cmpchars ? cmpchar_table[id]->width : 0));
+ }
+ else
+ {
+ int charset = CHAR_CHARSET (c);
+
+ XSETFASTINT (val, CHARSET_WIDTH (charset));
+ }
+ return val;
+}
+
+/* Return width of string STR of length LEN when displayed in the
+ current buffer. The width is measured by how many columns it
+ occupies on the screen. */
+int
+strwidth (str, len)
+ unsigned char *str;
+ int len;
+{
+ unsigned char *endp = str + len;
+ int width = 0;
+
+ while (str < endp) {
+ if (*str == LEADING_CODE_COMPOSITION)
+ {
+ int id = str_cmpchar_id (str, endp - str);
+
+ if (id < 0)
+ {
+ width += 4;
+ str++;
+ }
+ else
+ {
+ width += cmpchar_table[id]->width;
+ str += cmpchar_table[id]->len;
+ }
+ }
+ else
+ {
+ width += ONE_BYTE_CHAR_WIDTH (*str);
+ str += BYTES_BY_CHAR_HEAD (*str);
+ }
+ }
+ return width;
+}
+
+DEFUN ("string-width", Fstring_width, Sstring_width, 1, 1, 0,
+ "Return width of STRING when displayed in the current buffer.\n\
+Width is measured by how many columns it occupies on the screen.\n\
+When calculating width of a multi-byte character in STRING,\n\
+ only the base leading-code is considered and the validity of\n\
+ the following bytes are not checked.")
+ (str)
+ Lisp_Object str;
+{
+ Lisp_Object val;
+
+ CHECK_STRING (str, 0);
+ XSETFASTINT (val, strwidth (XSTRING (str)->data, XSTRING (str)->size));
+ return val;
+}
+
+DEFUN ("char-direction", Fchar_direction, Schar_direction, 1, 1, 0,
+ "Return the direction of CHAR.\n\
+The returned value is 0 for left-to-right and 1 for right-to-left.")
+ (ch)
+ Lisp_Object ch;
+{
+ int charset;
+
+ CHECK_NUMBER (ch, 0);
+ charset = CHAR_CHARSET (XFASTINT (ch));
+ if (!CHARSET_DEFINED_P (charset))
+ error ("Invalid character: %d", XINT (ch));
+ return CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX);
+}
+
+DEFUN ("chars-in-string", Fchars_in_string, Schars_in_string, 1, 1, 0,
+ "Return number of characters in STRING.")
+ (str)
+ Lisp_Object str;
+{
+ Lisp_Object val;
+ unsigned char *p, *endp;
+ int chars;
+
+ CHECK_STRING (str, 0);
+
+ p = XSTRING (str)->data; endp = p + XSTRING (str)->size;
+ chars = 0;
+ while (p < endp)
+ {
+ if (*p == LEADING_CODE_COMPOSITION)
+ {
+ p++;
+ while (p < endp && ! CHAR_HEAD_P (p)) p++;
+ }
+ else
+ p += BYTES_BY_CHAR_HEAD (*p);
+ chars++;
+ }
+
+ XSETFASTINT (val, chars);
+ return val;
+}
+
+DEFUN ("char-boundary-p", Fchar_boundary_p, Schar_boundary_p, 1, 1, 0,
+ "Return non-nil value if POS is at character boundary of multibyte form.\n\
+The return value is:\n\
+ 0 if POS is at an ASCII character or at the end of range,\n\
+ 1 if POS is at a head of 2-byte length multi-byte form,\n\
+ 2 if POS is at a head of 3-byte length multi-byte form,\n\
+ 3 if POS is at a head of 4-byte length multi-byte form,\n\
+ 4 if POS is at a head of multi-byte form of a composite character.\n\
+If POS is out of range or not at character boundary, return NIL.")
+ (pos)
+ Lisp_Object pos;
+{
+ Lisp_Object val;
+ int n;
+
+ CHECK_NUMBER_COERCE_MARKER (pos, 0);
+
+ n = XINT (pos);
+ if (n < BEGV || n > ZV)
+ return Qnil;
+
+ if (n == ZV || NILP (current_buffer->enable_multibyte_characters))
+ XSETFASTINT (val, 0);
+ else
+ {
+ unsigned char *p = POS_ADDR (n);
+
+ if (SINGLE_BYTE_CHAR_P (*p))
+ XSETFASTINT (val, 0);
+ else if (*p == LEADING_CODE_COMPOSITION)
+ XSETFASTINT (val, 4);
+ else if (BYTES_BY_CHAR_HEAD (*p) > 1)
+ XSETFASTINT (val, BYTES_BY_CHAR_HEAD (*p) - 1);
+ else
+ val = Qnil;
+ }
+ return val;
+}
+
+DEFUN ("concat-chars", Fconcat_chars, Sconcat_chars, 1, MANY, 0,
+ "Concatenate all the argument characters and make the result a string.")
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ int i, n = XINT (nargs);
+ unsigned char *buf
+ = (unsigned char *) malloc (MAX_LENGTH_OF_MULTI_BYTE_FORM * n);
+ unsigned char *p = buf;
+ Lisp_Object val;
+
+ for (i = 0; i < n; i++)
+ {
+ int c, len;
+ unsigned char *str;
+
+ if (!INTEGERP (args[i]))
+ {
+ free (buf);
+ CHECK_NUMBER (args[i], 0);
+ }
+ c = XINT (args[i]);
+ len = CHAR_STRING (c, p, str);
+ if (p != str)
+ /* C is a composite character. */
+ bcopy (str, p, len);
+ p += len;
+ }
+
+ val = make_string (buf, p - buf);
+ free (buf);
+ return val;
+}
+
+#endif /* emacs */
+
+/*** Composite characters staffs ***/
+
+/* Each composite character is identified by CMPCHAR-ID which is
+ assigned when Emacs needs the character code of the composite
+ character (e.g. when displaying it on the screen). See the
+ document "GENERAL NOTE on COMPOSITE CHARACTER" in `charset.h' how a
+ composite character is represented in Emacs. */
+
+/* If `static' is defined, it means that it is defined to null string. */
+#ifndef static
+/* The following function is copied from lread.c. */
+static int
+hash_string (ptr, len)
+ unsigned char *ptr;
+ int len;
+{
+ register unsigned char *p = ptr;
+ register unsigned char *end = p + len;
+ register unsigned char c;
+ register int hash = 0;
+
+ while (p != end)
+ {
+ c = *p++;
+ if (c >= 0140) c -= 40;
+ hash = ((hash<<3) + (hash>>28) + c);
+ }
+ return hash & 07777777777;
+}
+#endif
+
+/* Table of pointers to the structure `cmpchar_info' indexed by
+ CMPCHAR-ID. */
+struct cmpchar_info **cmpchar_table;
+/* The current size of `cmpchar_table'. */
+static int cmpchar_table_size;
+/* Number of the current composite characters. */
+int n_cmpchars;
+
+#define CMPCHAR_HASH_TABLE_SIZE 0xFFF
+
+static int *cmpchar_hash_table[CMPCHAR_HASH_TABLE_SIZE];
+
+/* Each element of `cmpchar_hash_table' is a pointer to an array of
+ integer, where the 1st element is the size of the array, the 2nd
+ element is how many elements are actually used in the array, and
+ the remaining elements are CMPCHAR-IDs of composite characters of
+ the same hash value. */
+#define CMPCHAR_HASH_SIZE(table) table[0]
+#define CMPCHAR_HASH_USED(table) table[1]
+#define CMPCHAR_HASH_CMPCHAR_ID(table, i) table[i]
+
+/* Return CMPCHAR-ID of the composite character in STR of the length
+ LEN. If the composite character has not yet been registered,
+ register it in `cmpchar_table' and assign new CMPCHAR-ID. This
+ is the sole function for assigning CMPCHAR-ID. */
+int
+str_cmpchar_id (str, len)
+ unsigned char *str;
+ int len;
+{
+ int hash_idx, *hashp;
+ unsigned char *buf;
+ int embedded_rule; /* 1 if composition rule is embedded. */
+ int chars; /* number of components. */
+ int i;
+ struct cmpchar_info *cmpcharp;
+
+ if (len < 5)
+ /* Any composite char have at least 3-byte length. */
+ return -1;
+
+ /* The second byte 0xFF means compostion rule is embedded. */
+ embedded_rule = (str[1] == 0xFF);
+
+ /* At first, get the actual length of the composite character. */
+ {
+ unsigned char *p, *endp = str + 1, *lastp = str + len;
+ int bytes;
+
+ while (endp < lastp && ! CHAR_HEAD_P (endp)) endp++;
+ chars = 0;
+ p = str + 1 + embedded_rule;
+ while (p < endp)
+ {
+ /* No need of checking if *P is 0xA0 because
+ BYTES_BY_CHAR_HEAD (0x80) surely returns 2. */
+ p += (bytes = BYTES_BY_CHAR_HEAD (*p - 0x20) + embedded_rule);
+ chars++;
+ }
+ len = (p -= embedded_rule) - str;
+ if (p > endp)
+ len -= - bytes, chars--;
+
+ if (chars < 2 || chars > MAX_COMPONENT_COUNT)
+ /* Invalid number of components. */
+ return -1;
+ }
+ hash_idx = hash_string (str, len) % CMPCHAR_HASH_TABLE_SIZE;
+ hashp = cmpchar_hash_table[hash_idx];
+
+ /* Then, look into the hash table. */
+ if (hashp != NULL)
+ /* Find the correct one among composite characters of the same
+ hash value. */
+ for (i = 2; i < CMPCHAR_HASH_USED (hashp); i++)
+ {
+ cmpcharp = cmpchar_table[CMPCHAR_HASH_CMPCHAR_ID (hashp, i)];
+ if (len == cmpcharp->len
+ && ! bcmp (str, cmpcharp->data, len))
+ return CMPCHAR_HASH_CMPCHAR_ID (hashp, i);
+ }
+
+ /* We have to register the composite character in cmpchar_table. */
+ /* Make the entry in hash table. */
+ if (hashp == NULL)
+ {
+ /* Make a table for 8 composite characters initially. */
+ hashp = (cmpchar_hash_table[hash_idx]
+ = (int *) xmalloc (sizeof (int) * (2 + 8)));
+ CMPCHAR_HASH_SIZE (hashp) = 10;
+ CMPCHAR_HASH_USED (hashp) = 2;
+ }
+ else if (CMPCHAR_HASH_USED (hashp) >= CMPCHAR_HASH_SIZE (hashp))
+ {
+ CMPCHAR_HASH_SIZE (hashp) += 8;
+ hashp = (cmpchar_hash_table[hash_idx]
+ = (int *) xrealloc (hashp,
+ sizeof (int) * CMPCHAR_HASH_SIZE (hashp)));
+ }
+ CMPCHAR_HASH_CMPCHAR_ID (hashp, CMPCHAR_HASH_USED (hashp)) = n_cmpchars;
+ CMPCHAR_HASH_USED (hashp)++;
+
+ /* Set information of the composite character in cmpchar_table. */
+ if (cmpchar_table_size == 0)
+ {
+ /* This is the first composite character to be registered. */
+ cmpchar_table_size = 256;
+ cmpchar_table
+ = (struct cmpchar_info **) xmalloc (sizeof (cmpchar_table[0])
+ * cmpchar_table_size);
+ }
+ else if (cmpchar_table_size <= n_cmpchars)
+ {
+ cmpchar_table_size += 256;
+ cmpchar_table
+ = (struct cmpchar_info **) xrealloc (cmpchar_table,
+ sizeof (cmpchar_table[0])
+ * cmpchar_table_size);
+ }
+
+ cmpcharp = (struct cmpchar_info *) xmalloc (sizeof (struct cmpchar_info));
+
+ cmpcharp->len = len;
+ cmpcharp->data = (unsigned char *) xmalloc (len + 1);
+ bcopy (str, cmpcharp->data, len);
+ cmpcharp->data[len] = 0;
+ cmpcharp->glyph_len = chars;
+ cmpcharp->glyph = (GLYPH *) xmalloc (sizeof (GLYPH) * chars);
+ if (embedded_rule)
+ {
+ cmpcharp->cmp_rule = (unsigned char *) xmalloc (chars);
+ cmpcharp->col_offset = (float *) xmalloc (sizeof (float) * chars);
+ }
+ else
+ {
+ cmpcharp->cmp_rule = NULL;
+ cmpcharp->col_offset = NULL;
+ }
+
+ /* Setup GLYPH data and composition rules (if any) so as not to make
+ them every time on displaying. */
+ {
+ unsigned char *bufp;
+ int width;
+ float leftmost = 0.0, rightmost = 1.0;
+
+ if (embedded_rule)
+ /* At first, col_offset[N] is set to relative to col_offset[0]. */
+ cmpcharp->col_offset[0] = 0;
+
+ for (i = 0, bufp = cmpcharp->data + 1; i < chars; i++)
+ {
+ if (embedded_rule)
+ cmpcharp->cmp_rule[i] = *bufp++;
+
+ if (*bufp == 0xA0) /* This is an ASCII character. */
+ {
+ cmpcharp->glyph[i] = FAST_MAKE_GLYPH ((*++bufp & 0x7F), 0);
+ width = 1;
+ bufp++;
+ }
+ else /* Multibyte character. */
+ {
+ /* Make `bufp' point normal multi-byte form temporally. */
+ *bufp -= 0x20;
+ cmpcharp->glyph[i]
+ = FAST_MAKE_GLYPH (string_to_non_ascii_char (bufp, 4, 0), 0);
+ width = WIDTH_BY_CHAR_HEAD (*bufp);
+ *bufp += 0x20;
+ bufp += BYTES_BY_CHAR_HEAD (*bufp - 0x20);
+ }
+
+ if (embedded_rule && i > 0)
+ {
+ /* Reference points (global_ref and new_ref) are
+ encoded as below:
+
+ 0--1--2 -- ascent
+ | |
+ | |
+ | 4 -+--- center
+ -- 3 5 -- baseline
+ | |
+ 6--7--8 -- descent
+
+ Now, we calculate the column offset of the new glyph
+ from the left edge of the first glyph. This can avoid
+ the same calculation everytime displaying this
+ composite character. */
+
+ /* Reference points of global glyph and new glyph. */
+ int global_ref = (cmpcharp->cmp_rule[i] - 0xA0) / 9;
+ int new_ref = (cmpcharp->cmp_rule[i] - 0xA0) % 9;
+ /* Column offset relative to the first glyph. */
+ float left = (leftmost
+ + (global_ref % 3) * (rightmost - leftmost) / 2.0
+ - (new_ref % 3) * width / 2.0);
+
+ cmpcharp->col_offset[i] = left;
+ if (left < leftmost)
+ leftmost = left;
+ if (left + width > rightmost)
+ rightmost = left + width;
+ }
+ else
+ {
+ if (width > rightmost)
+ rightmost = width;
+ }
+ }
+ if (embedded_rule)
+ {
+ /* Now col_offset[N] are relative to the left edge of the
+ first component. Make them relative to the left edge of
+ overall glyph. */
+ for (i = 0; i < chars; i++)
+ cmpcharp->col_offset[i] -= leftmost;
+ /* Make rightmost holds width of overall glyph. */
+ rightmost -= leftmost;
+ }
+
+ cmpcharp->width = rightmost;
+ if (cmpcharp->width < rightmost)
+ /* To get a ceiling integer value. */
+ cmpcharp->width++;
+ }
+
+ cmpchar_table[n_cmpchars] = cmpcharp;
+
+ return n_cmpchars++;
+}
+
+/* Return the Nth element of the composite character C. */
+int
+cmpchar_component (c, n)
+ unsigned int c, n;
+{
+ int id = COMPOSITE_CHAR_ID (c);
+
+ if (id >= n_cmpchars /* C is not a valid composite character. */
+ || n >= cmpchar_table[id]->glyph_len) /* No such component. */
+ return -1;
+ /* No face data is stored in glyph code. */
+ return ((int) (cmpchar_table[id]->glyph[n]));
+}
+
+DEFUN ("cmpcharp", Fcmpcharp, Scmpcharp, 1, 1, 0,
+ "T if CHAR is a composite character.")
+ (ch)
+ Lisp_Object ch;
+{
+ CHECK_NUMBER (ch, 0);
+ return (COMPOSITE_CHAR_P (XINT (ch)) ? Qt : Qnil);
+}
+
+DEFUN ("composite-char-component", Fcmpchar_component, Scmpchar_component,
+ 2, 2, 0,
+ "Return the IDXth component character of composite character CHARACTER.")
+ (character, idx)
+ Lisp_Object character, idx;
+{
+ int c;
+
+ CHECK_NUMBER (character, 0);
+ CHECK_NUMBER (idx, 1);
+
+ if ((c = cmpchar_component (XINT (character), XINT (idx))) < 0)
+ args_out_of_range (character, idx);
+
+ return make_number (c);
+}
+
+DEFUN ("composite-char-composition-rule", Fcmpchar_cmp_rule, Scmpchar_cmp_rule,
+ 2, 2, 0,
+ "Return the IDXth composition rule embedded in composite character CHARACTER.
+The returned rule is for composing the IDXth component
+on the (IDX-1)th component. If IDX is 0, the returned value is always 255.")
+ (character, idx)
+ Lisp_Object character, idx;
+{
+ int id, i;
+
+ CHECK_NUMBER (character, 0);
+ CHECK_NUMBER (idx, 1);
+
+ id = COMPOSITE_CHAR_ID (XINT (character));
+ if (id < 0 || id >= n_cmpchars)
+ error ("Invalid composite character: %d", XINT (character));
+ i = XINT (idx);
+ if (i > cmpchar_table[id]->glyph_len)
+ args_out_of_range (character, idx);
+
+ return make_number (cmpchar_table[id]->cmp_rule[i]);
+}
+
+DEFUN ("composite-char-composition-rule-p", Fcmpchar_cmp_rule_p,
+ Scmpchar_cmp_rule_p, 1, 1, 0,
+ "Return non-nil if composite character CHARACTER contains a embedded rule.")
+ (character)
+ Lisp_Object character;
+{
+ int id;
+
+ CHECK_NUMBER (character, 0);
+ id = COMPOSITE_CHAR_ID (XINT (character));
+ if (id < 0 || id >= n_cmpchars)
+ error ("Invalid composite character: %d", XINT (character));
+
+ return (cmpchar_table[id]->cmp_rule ? Qt : Qnil);
+}
+
+DEFUN ("composite-char-component-count", Fcmpchar_cmp_count,
+ Scmpchar_cmp_count, 1, 1, 0,
+ "Return number of compoents of composite character CHARACTER.")
+ (character)
+ Lisp_Object character;
+{
+ int id;
+
+ CHECK_NUMBER (character, 0);
+ id = COMPOSITE_CHAR_ID (XINT (character));
+ if (id < 0 || id >= n_cmpchars)
+ error ("Invalid composite character: %d", XINT (character));
+
+ return (make_number (cmpchar_table[id]->glyph_len));
+}
+
+DEFUN ("compose-string", Fcompose_string, Scompose_string,
+ 1, 1, 0,
+ "Return one char string composed from all characters in STRING.")
+ (str)
+ Lisp_Object str;
+{
+ unsigned char buf[MAX_LENGTH_OF_MULTI_BYTE_FORM], *p, *pend, *ptemp;
+ int len, i;
+
+ CHECK_STRING (str, 0);
+
+ buf[0] = LEADING_CODE_COMPOSITION;
+ p = XSTRING (str)->data;
+ pend = p + XSTRING (str)->size;
+ i = 1;
+ while (p < pend)
+ {
+ if (*p < 0x20 || *p == 127) /* control code */
+ error ("Invalid component character: %d", *p);
+ else if (*p < 0x80) /* ASCII */
+ {
+ if (i + 2 >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
+ error ("Too long string to be composed: %s", XSTRING (str)->data);
+ /* Prepend an ASCII charset indicator 0xA0, set MSB of the
+ code itself. */
+ buf[i++] = 0xA0;
+ buf[i++] = *p++ + 0x80;
+ }
+ else if (*p == LEADING_CODE_COMPOSITION) /* composite char */
+ {
+ /* Already composed. Eliminate the heading
+ LEADING_CODE_COMPOSITION, keep the remaining bytes
+ unchanged. */
+ p++;
+ ptemp = p;
+ while (! CHAR_HEAD_P (p)) p++;
+ if (i + (p - ptemp) >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
+ error ("Too long string to be composed: %s", XSTRING (str)->data);
+ bcopy (ptemp, buf + i, p - ptemp);
+ i += p - ptemp;
+ }
+ else /* multibyte char */
+ {
+ /* Add 0x20 to the base leading-code, keep the remaining
+ bytes unchanged. */
+ len = BYTES_BY_CHAR_HEAD (*p);
+ if (i + len >= MAX_LENGTH_OF_MULTI_BYTE_FORM)
+ error ("Too long string to be composed: %s", XSTRING (str)->data);
+ bcopy (p, buf + i, len);
+ buf[i] += 0x20;
+ p += len, i += len;
+ }
+ }
+
+ if (i < 5)
+ /* STR contains only one character, which can't be composed. */
+ error ("Too short string to be composed: %s", XSTRING (str)->data);
+
+ return make_string (buf, i);
+}
+
+
+charset_id_internal (charset_name)
+ char *charset_name;
+{
+ Lisp_Object val = Fget (intern (charset_name), Qcharset);
+
+ if (!VECTORP (val))
+ error ("Charset %s is not defined", charset_name);
+
+ return (XINT (XVECTOR (val)->contents[0]));
+}
+
+DEFUN ("setup-special-charsets", Fsetup_special_charsets,
+ Ssetup_special_charsets, 0, 0, 0, "Internal use only.")
+ ()
+{
+ charset_latin_iso8859_1 = charset_id_internal ("latin-iso8859-1");
+ charset_jisx0208_1978 = charset_id_internal ("japanese-jisx0208-1978");
+ charset_jisx0208 = charset_id_internal ("japanese-jisx0208");
+ charset_katakana_jisx0201 = charset_id_internal ("katakana-jisx0201");
+ charset_latin_jisx0201 = charset_id_internal ("latin-jisx0201");
+ charset_big5_1 = charset_id_internal ("chinese-big5-1");
+ charset_big5_2 = charset_id_internal ("chinese-big5-2");
+ return Qnil;
+}
+
+init_charset_once ()
+{
+ int i, j, k;
+
+ staticpro (&Vcharset_table);
+ staticpro (&Vcharset_symbol_table);
+
+ /* This has to be done here, before we call Fmake_char_table. */
+ Qcharset_table = intern ("charset-table");
+ staticpro (&Qcharset_table);
+
+ /* Intern this now in case it isn't already done.
+ Setting this variable twice is harmless.
+ But don't staticpro it here--that is done in alloc.c. */
+ Qchar_table_extra_slots = intern ("char-table-extra-slots");
+
+ /* Now we are ready to set up this property, so we can
+ create the charset table. */
+ Fput (Qcharset_table, Qchar_table_extra_slots, make_number (0));
+ Vcharset_table = Fmake_char_table (Qcharset_table, Qnil);
+
+ Vcharset_symbol_table = Fmake_vector (make_number (MAX_CHARSET), Qnil);
+
+ /* Setup tables. */
+ for (i = 0; i < 2; i++)
+ for (j = 0; j < 2; j++)
+ for (k = 0; k < 128; k++)
+ iso_charset_table [i][j][k] = -1;
+
+ bzero (cmpchar_hash_table, sizeof cmpchar_hash_table);
+ cmpchar_table_size = n_cmpchars = 0;
+
+ for (i = 0; i < 256; i++)
+ BYTES_BY_CHAR_HEAD (i) = 1;
+ BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11) = 3;
+ BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12) = 3;
+ BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21) = 4;
+ BYTES_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22) = 4;
+ /* The following doesn't reflect the actual bytes, but just to tell
+ that it is a start of a multibyte character. */
+ BYTES_BY_CHAR_HEAD (LEADING_CODE_COMPOSITION) = 2;
+
+ for (i = 0; i < 128; i++)
+ WIDTH_BY_CHAR_HEAD (i) = 1;
+ for (; i < 256; i++)
+ WIDTH_BY_CHAR_HEAD (i) = 4;
+ WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_11) = 1;
+ WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_12) = 2;
+ WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_21) = 1;
+ WIDTH_BY_CHAR_HEAD (LEADING_CODE_PRIVATE_22) = 2;
+}
+
+#ifdef emacs
+
+syms_of_charset ()
+{
+ Qascii = intern ("ascii");
+ staticpro (&Qascii);
+
+ Qcharset = intern ("charset");
+ staticpro (&Qcharset);
+
+ /* Define ASCII charset now. */
+ update_charset_table (make_number (CHARSET_ASCII),
+ make_number (1), make_number (94),
+ make_number (1),
+ make_number (0),
+ make_number ('B'),
+ make_number (0),
+ build_string ("ASCII"),
+ build_string ("ASCII"),
+ build_string ("ASCII (ISO646 IRV)"));
+ CHARSET_SYMBOL (CHARSET_ASCII) = Qascii;
+ Fput (Qascii, Qcharset, CHARSET_TABLE_ENTRY (CHARSET_ASCII));
+
+ Qcomposition = intern ("composition");
+ staticpro (&Qcomposition);
+ CHARSET_SYMBOL (CHARSET_COMPOSITION) = Qcomposition;
+
+ defsubr (&Sdefine_charset);
+ defsubr (&Sdeclare_equiv_charset);
+ defsubr (&Sfind_charset_region);
+ defsubr (&Sfind_charset_string);
+ defsubr (&Smake_char_internal);
+ defsubr (&Ssplit_char);
+ defsubr (&Schar_charset);
+ defsubr (&Siso_charset);
+ defsubr (&Schar_bytes);
+ defsubr (&Schar_width);
+ defsubr (&Sstring_width);
+ defsubr (&Schar_direction);
+ defsubr (&Schars_in_string);
+ defsubr (&Schar_boundary_p);
+ defsubr (&Sconcat_chars);
+ defsubr (&Scmpcharp);
+ defsubr (&Scmpchar_component);
+ defsubr (&Scmpchar_cmp_rule);
+ defsubr (&Scmpchar_cmp_rule_p);
+ defsubr (&Scmpchar_cmp_count);
+ defsubr (&Scompose_string);
+ defsubr (&Ssetup_special_charsets);
+
+ DEFVAR_LISP ("charset-list", &Vcharset_list,
+ "List of charsets ever defined.");
+ Vcharset_list = Fcons (Qascii, Qnil);
+
+ DEFVAR_INT ("leading-code-composition", &leading_code_composition,
+ "Leading-code of composite characters.");
+ leading_code_composition = LEADING_CODE_COMPOSITION;
+
+ DEFVAR_INT ("leading-code-private-11", &leading_code_private_11,
+ "Leading-code of private TYPE9N charset of column-width 1.");
+ leading_code_private_11 = LEADING_CODE_PRIVATE_11;
+
+ DEFVAR_INT ("leading-code-private-12", &leading_code_private_12,
+ "Leading-code of private TYPE9N charset of column-width 2.");
+ leading_code_private_12 = LEADING_CODE_PRIVATE_12;
+
+ DEFVAR_INT ("leading-code-private-21", &leading_code_private_21,
+ "Leading-code of private TYPE9Nx9N charset of column-width 1.");
+ leading_code_private_21 = LEADING_CODE_PRIVATE_21;
+
+ DEFVAR_INT ("leading-code-private-22", &leading_code_private_22,
+ "Leading-code of private TYPE9Nx9N charset of column-width 2.");
+ leading_code_private_22 = LEADING_CODE_PRIVATE_22;
+}
+
+#endif /* emacs */
diff --git a/src/charset.h b/src/charset.h
new file mode 100644
index 00000000000..677a5755adf
--- /dev/null
+++ b/src/charset.h
@@ -0,0 +1,649 @@
+/* Header for multilingual character handler.
+ Ver.1.0
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef _CHARSET_H
+#define _CHARSET_H
+
+/*** GENERAL NOTE on CHARACTER SET (CHARSET) ***
+
+ A character set ("charset" hereafter) is a meaningful collection
+ (i.e. language, culture, functionality, etc) of characters. Emacs
+ handles multiple charsets at once. Each charset corresponds to one
+ of ISO charsets (except for a special charset for composition
+ characters). Emacs identifies a charset by a unique identification
+ number, whereas ISO identifies a charset by a triplet of DIMENSION,
+ CHARS and FINAL-CHAR. So, hereafter, just saying "charset" means an
+ identification number (integer value).
+
+ The value range of charset is 0x00, 0x80..0xFE. There are four
+ kinds of charset depending on DIMENSION (1 or 2) and CHARS (94 or
+ 96). For instance, a charset of DIMENSION2_CHARS94 contains 94x94
+
+
+ Within Emacs Lisp, a charset is treated as a symbol which has a
+ property `charset'. The property value is a vector containing
+ various information about the charset. For readability of C codes,
+ we use the following convention on C variable names:
+ charset_symbol: Emacs Lisp symbol of a charset
+ charset_id: Emacs Lisp integer of an identification number of a charset
+ charset: C integer of an identification number of a charset
+
+ Each charset (except for ASCII) is assigned a base leading-code
+ (range 0x80..0x9D). In addition, a charset of greater than 0xA0
+ (whose base leading-code is 0x9A..0x9D) is assigned an extended
+ leading-code (range 0xA0..0xFE). In this case, each base
+ leading-code specify the allowable range of extended leading-code as
+ shown in the table below. A leading-code is used to represent a
+ character in Emacs' buffer and string.
+
+ We call a charset which has extended leading-code as "private
+ charset" because those are mainly for a charset which is not
+ registered by ISO. On the contrary, we call a charset which does
+ not have extended leading-code as "official charset".
+
+ ---------------------------------------------------------------------------
+ charset dimension base leading-code extended leading-code
+ ---------------------------------------------------------------------------
+ 0x00 official dim1 -- none -- -- none --
+ (ASCII)
+ 0x01..0x7F --never used--
+ 0x80 COMPOSITION same as charset -- none --
+ 0x81..0x8F official dim1 same as charset -- none --
+ 0x90..0x99 official dim2 same as charset -- none --
+ 0x9A..0x9F --never used--
+ 0xA0..0xDF private dim1 0x9A same as charset
+ of 1-column width
+ 0xE0..0xEF private dim1 0x9B same as charset
+ of 2-column width
+ 0xF0..0xF4 private dim2 0x9C same as charset
+ of 1-column width
+ 0xF5..0xFE private dim2 0x9D same as charset
+ of 2-column width
+ 0xFF --never used--
+ ---------------------------------------------------------------------------
+
+ In the table, "COMPOSITION" means a charset for a composite
+ character which is a character composed from several (up to 16)
+ non-composite characters (components). Although a composite
+ character can contain components of many charsets, a composite
+ character itself belongs to the charset CHARSET-COMPOSITION. See
+ the document "GENERAL NOTE on COMPOSITE CHARACTER" below for more
+ detail.
+
+*/
+
+/* Definition of special leading-codes. */
+/* Base leading-code. */
+/* Special leading-code followed by components of a composite character. */
+#define LEADING_CODE_COMPOSITION 0x80
+/* Leading-code followed by extended leading-code. */
+#define LEADING_CODE_PRIVATE_11 0x9A /* for private DIMENSION1 of 1-column */
+#define LEADING_CODE_PRIVATE_12 0x9B /* for private DIMENSION1 of 2-column */
+#define LEADING_CODE_PRIVATE_21 0x9C /* for private DIMENSION2 of 1-column */
+#define LEADING_CODE_PRIVATE_22 0x9D /* for private DIMENSION2o f 2-column */
+
+/* Extended leading-code. */
+/* Start of each extended leading-codes. */
+#define LEADING_CODE_EXT_11 0xA0 /* follows LEADING_CODE_PRIVATE_11 */
+#define LEADING_CODE_EXT_12 0xE0 /* follows LEADING_CODE_PRIVATE_12 */
+#define LEADING_CODE_EXT_21 0xF0 /* follows LEADING_CODE_PRIVATE_21 */
+#define LEADING_CODE_EXT_22 0xF5 /* follows LEADING_CODE_PRIVATE_22 */
+/* Maximum value of extended leading-codes. */
+#define LEADING_CODE_EXT_MAX 0xFE
+
+/* Definition of minimum/maximum charset of each DIMENSION. */
+#define MIN_CHARSET_OFFICIAL_DIMENSION1 0x81
+#define MAX_CHARSET_OFFICIAL_DIMENSION1 0x8F
+#define MIN_CHARSET_OFFICIAL_DIMENSION2 0x90
+#define MAX_CHARSET_OFFICIAL_DIMENSION2 0x99
+#define MIN_CHARSET_PRIVATE_DIMENSION1 LEADING_CODE_EXT_11
+#define MIN_CHARSET_PRIVATE_DIMENSION2 LEADING_CODE_EXT_21
+
+/* Definition of special charsets. */
+#define CHARSET_ASCII 0
+#define CHARSET_COMPOSITION 0x80
+
+extern int charset_ascii; /* ASCII */
+extern int charset_composition; /* for a composite character */
+extern int charset_latin_iso8859_1; /* ISO8859-1 (Latin-1) */
+extern int charset_jisx0208_1978; /* JISX0208.1978 (Japanese Kanji old set) */
+extern int charset_jisx0208; /* JISX0208.1983 (Japanese Kanji) */
+extern int charset_katakana_jisx0201; /* JISX0201.Kana (Japanese Katakana) */
+extern int charset_latin_jisx0201; /* JISX0201.Roman (Japanese Roman) */
+extern int charset_big5_1; /* Big5 Level 1 (Chinese Traditional) */
+extern int charset_big5_2; /* Big5 Level 2 (Chinese Traditional) */
+
+/* Check if STR points the head of multi-byte form, i.e. *STR is an
+ ASCII character or a base leading-code. */
+#define CHAR_HEAD_P(str) ((unsigned char) *(str) < 0xA0)
+
+/*** GENERAL NOTE on CHARACTER REPRESENTATION ***
+
+ At first, the term "character" or "char" is used for a multilingual
+ character (of course, including ASCII character), not for a byte in
+ computer memory. We use the term "code" or "byte" for the latter
+ case.
+
+ A character is identified by charset and one or two POSITION-CODEs.
+ POSITION-CODE is the position of the character in the charset. A
+ character of DIMENSION1 charset has one POSITION-CODE: POSITION-CODE-1.
+ A character of DIMENSION2 charset has two POSITION-CODE:
+ POSITION-CODE-1 and POSITION-CODE-2. The code range of
+ POSITION-CODE is 0x20..0x7F.
+
+ Emacs has two kinds of representation of a character: multi-byte
+ form (for buffer and string) and single-word form (for character
+ object in Emacs Lisp). The latter is called "character code" here
+ after. Both representation encode the information of charset and
+ POSITION-CODE but in a different way (for instance, MSB of
+ POSITION-CODE is set in multi-byte form).
+
+ For details of multi-byte form, see the section "2. Emacs internal
+ format handlers" of `coding.c'.
+
+ Emacs uses 19 bits for a character code. The bits are divided into
+ 3 fields: FIELD1(5bits):FIELD2(7bits):FIELD3(7bits).
+
+ A character code of DIMENSION1 character uses FIELD2 to hold charset
+ and FIELD3 to hold POSITION-CODE-1. A character code of DIMENSION2
+ character uses FIELD1 to hold charset, FIELD2 and FIELD3 to hold
+ POSITION-CODE-1 and POSITION-CODE-2 respectively.
+
+ More precisely...
+
+ FIELD2 of DIMENSION1 character (except for ASCII) is "charset - 0x70".
+ This is to make all character codes except for ASCII greater than
+ 256 (ASCII's FIELD2 is 0). So, the range of FIELD2 of DIMENSION1
+ character is 0 or 0x11..0x7F.
+
+ FIELD1 of DIMENSION2 character is "charset - 0x8F" for official
+ charset and "charset - 0xE0" for private charset. So, the range of
+ FIELD1 of DIMENSION2 character is 0x01..0x1E.
+
+ -----------------------------------------------------------------------
+ charset FIELD1 (5-bit) FIELD2 (7-bit) FIELD3 (7-bit)
+ -----------------------------------------------------------------------
+ ASCII 0 0 POSITION-CODE-1
+ DIMENSION1 0 charset - 0x70 POSITION-CODE-1
+ DIMENSION2(o) charset - 0x8F POSITION-CODE-1 POSITION-CODE-2
+ DIMENSION2(p) charset - 0xE0 POSITION-CODE-1 POSITION-CODE-2
+ -----------------------------------------------------------------------
+ "(o)": official, "(p)": private
+ -----------------------------------------------------------------------
+
+*/
+
+/*** GENERAL NOTE on COMPOSITE CHARACTER ***
+
+ A composite character is a character composed from several (up to
+ 16) non-composite characters (components). Although each components
+ can belong to any charset, a composite character itself belongs to
+ the charset `charset-composition' and is assigned a special
+ leading-code `LEADING_CODE_COMPOSITION' for multi-byte form. See
+ the document "2. Emacs internal format handlers" in `coding.c' for
+ more detail about multi-byte form.
+
+ A character code of composite character has special format. In the
+ above document, FIELD1 of a composite character is 0x1F. Each
+ composite character is assigned a sequential number CMPCHAR-ID.
+ FIELD2 and FIELD3 are combined to make 14bits field for holding
+ CMPCHAR-ID, which means that Emacs can handle at most 2^14 (= 16384)
+ composite characters at once.
+
+ -----------------------------------------------------------------------
+ charset FIELD1 (5-bit) FIELD2&3 (14-bit)
+ -----------------------------------------------------------------------
+ CHARSET-COMPOSITION 0x1F CMPCHAR-ID
+ -----------------------------------------------------------------------
+
+ Emacs assigns CMPCHAR-ID to a composite character only when it
+ requires the character code of the composite character (e.g. while
+ displaying the composite character).
+
+*/
+
+/* Masks of each field of character code. */
+#define CHAR_FIELD1_MASK (0x1F << 14)
+#define CHAR_FIELD2_MASK (0x7F << 7)
+#define CHAR_FIELD3_MASK 0x7F
+
+/* Macros to access each field of character C. */
+#define CHAR_FIELD1(c) (((c) & CHAR_FIELD1_MASK) >> 14)
+#define CHAR_FIELD2(c) (((c) & CHAR_FIELD2_MASK) >> 7)
+#define CHAR_FIELD3(c) ((c) & CHAR_FIELD3_MASK)
+
+/* Minimum character code of character of each DIMENSION. */
+#define MIN_CHAR_OFFICIAL_DIMENSION1 \
+ ((MIN_CHARSET_OFFICIAL_DIMENSION1 - 0x70) << 7)
+#define MIN_CHAR_PRIVATE_DIMENSION1 \
+ ((MIN_CHARSET_PRIVATE_DIMENSION1 - 0x70) << 7)
+#define MIN_CHAR_OFFICIAL_DIMENSION2 \
+ ((MIN_CHARSET_OFFICIAL_DIMENSION2 - 0x8F) << 14)
+#define MIN_CHAR_PRIVATE_DIMENSION2 \
+ ((MIN_CHARSET_PRIVATE_DIMENSION2 - 0xE0) << 14)
+#define MIN_CHAR_COMPOSITION \
+ (0x1F << 14)
+
+/* 1 if C is an ASCII character, else 0. */
+#define SINGLE_BYTE_CHAR_P(c) ((c) < 0x100)
+/* 1 if C is an composite character, else 0. */
+#define COMPOSITE_CHAR_P(c) ((c) >= MIN_CHAR_COMPOSITION)
+
+/* A char-table containing information of each character set.
+
+ Unlike ordinary char-tables, this doesn't contain any nested table.
+ Only the top level elements are used. Each element is a vector of
+ the following information:
+ CHARSET-ID, BYTES, DIMENSION, CHARS, WIDTH, DIRECTION,
+ LEADING-CODE-BASE, LEADING-CODE-EXT,
+ ISO-FINAL-CHAR, ISO-GRAPHIC-PLANE,
+ REVERSE-CHARSET, SHORT-NAME, LONG-NAME, DESCRIPTION,
+ PLIST.
+
+ CHARSET-ID (integer) is the identification number of the charset.
+
+ BYTE (integer) is the length of multi-byte form of a character in
+ the charset: one of 1, 2, 3, and 4.
+
+ DIMENSION (integer) is the number of bytes to represent a character: 1 or 2.
+
+ CHARS (integer) is the number of characters in a dimension: 94 or 96.
+
+ WIDTH (integer) is the number of columns a character in the charset
+ occupies on the screen: one of 0, 1, and 2.
+
+ DIRECTION (integer) is the rendering direction of characters in the
+ charset when rendering. If 0, render from right to left, else
+ render from left to right.
+
+ LEADING-CODE-BASE (integer) is the base leading-code for the
+ charset.
+
+ LEADING-CODE-EXT (integer) is the extended leading-code for the
+ charset. All charsets of less than 0xA0 has the value 0.
+
+ ISO-FINAL-CHAR (character) is the final character of the
+ corresponding ISO 2022 charset.
+
+ ISO-GRAPHIC-PLANE (integer) is the graphic plane to be invoked
+ while encoding to variants of ISO 2022 coding system, one of the
+ following: 0/graphic-plane-left(GL), 1/graphic-plane-right(GR).
+
+ REVERSE-CHARSET (integer) is the charset which differs only in
+ LEFT-TO-RIGHT value from the charset. If there's no such a
+ charset, the value is -1.
+
+ SHORT-NAME (string) is the short name to refer to the charset.
+
+ LONG-NAME (string) is the long name to refer to the charset.
+
+ DESCRIPTION (string) is the description string of the charset.
+
+ PLIST (property list) may contain any type of information a user
+ want to put and get by functions `put-charset-property' and
+ `get-charset-property' respectively. */
+extern Lisp_Object Vcharset_table;
+
+/* Macros to access various information of CHARSET in Vcharset_table.
+ We provide these macros for efficiency. No range check of CHARSET. */
+
+/* Return entry of CHARSET (lisp integer) in Vcharset_table. */
+#define CHARSET_TABLE_ENTRY(charset) \
+ XCHAR_TABLE (Vcharset_table)->contents[charset]
+
+/* Return information INFO-IDX of CHARSET. */
+#define CHARSET_TABLE_INFO(charset, info_idx) \
+ XVECTOR (CHARSET_TABLE_ENTRY (charset))->contents[info_idx]
+
+#define CHARSET_ID_IDX (0)
+#define CHARSET_BYTES_IDX (1)
+#define CHARSET_DIMENSION_IDX (2)
+#define CHARSET_CHARS_IDX (3)
+#define CHARSET_WIDTH_IDX (4)
+#define CHARSET_DIRECTION_IDX (5)
+#define CHARSET_LEADING_CODE_BASE_IDX (6)
+#define CHARSET_LEADING_CODE_EXT_IDX (7)
+#define CHARSET_ISO_FINAL_CHAR_IDX (8)
+#define CHARSET_ISO_GRAPHIC_PLANE_IDX (9)
+#define CHARSET_REVERSE_CHARSET_IDX (10)
+#define CHARSET_SHORT_NAME_IDX (11)
+#define CHARSET_LONG_NAME_IDX (12)
+#define CHARSET_DESCRIPTION_IDX (13)
+#define CHARSET_PLIST_IDX (14)
+/* Size of a vector of each entry of Vcharset_table. */
+#define CHARSET_MAX_IDX (15)
+
+/* And several more macros to be used frequently. */
+#define CHARSET_BYTES(charset) \
+ XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_BYTES_IDX))
+#define CHARSET_DIMENSION(charset) \
+ XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_DIMENSION_IDX))
+#define CHARSET_CHARS(charset) \
+ XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_CHARS_IDX))
+#define CHARSET_WIDTH(charset) \
+ XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_WIDTH_IDX))
+#define CHARSET_DIRECTION(charset) \
+ XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_DIRECTION_IDX))
+#define CHARSET_LEADING_CODE_BASE(charset) \
+ XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_BASE_IDX))
+#define CHARSET_LEADING_CODE_EXT(charset) \
+ XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_LEADING_CODE_EXT_IDX))
+#define CHARSET_ISO_FINAL_CHAR(charset) \
+ XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_ISO_FINAL_CHAR_IDX))
+#define CHARSET_ISO_GRAPHIC_PLANE(charset) \
+ XFASTINT (CHARSET_TABLE_INFO (charset, CHARSET_ISO_GRAPHIC_PLANE_IDX))
+#define CHARSET_REVERSE_CHARSET(charset) \
+ XINT (CHARSET_TABLE_INFO (charset, CHARSET_REVERSE_CHARSET_IDX))
+
+/* Macros to specify direction of a charset. */
+#define CHARSET_DIRECTION_LEFT_TO_RIGHT 0
+#define CHARSET_DIRECTION_RIGHT_TO_LEFT 1
+
+/* A vector of charset symbol indexed by charset-id. This is used
+ only for returning charset symbol from C functions. */
+extern Lisp_Object Vcharset_symbol_table;
+
+/* Return symbol of CHARSET. */
+#define CHARSET_SYMBOL(charset) \
+ XVECTOR (Vcharset_symbol_table)->contents[charset]
+
+/* 1 if CHARSET is valid, else 0. */
+#define CHARSET_VALID_P(charset) \
+ ((charset) == 0 \
+ || ((charset) >= 0x80 && (charset) <= MAX_CHARSET_OFFICIAL_DIMENSION2) \
+ || ((charset) >= MIN_CHARSET_PRIVATE_DIMENSION1 && (charset) < MAX_CHARSET))
+
+/* 1 if CHARSET is already defined, else 0. */
+#define CHARSET_DEFINED_P(charset) \
+ (((charset) >= 0) && ((charset) < MAX_CHARSET) \
+ && !NILP (CHARSET_TABLE_ENTRY (charset)))
+
+/* Since the information CHARSET-BYTES and CHARSET-WIDTH of
+ Vcharset_table can be retrieved only from the first byte of
+ multi-byte form (an ASCII code or a base leading-code), we provide
+ here tables to be used by macros BYTES_BY_CHAR_HEAD and
+ WIDTH_BY_CHAR_HEAD for faster information retrieval. */
+extern int bytes_by_char_head[256];
+extern int width_by_char_head[256];
+
+#define BYTES_BY_CHAR_HEAD(char_head) bytes_by_char_head[char_head]
+#define WIDTH_BY_CHAR_HEAD(char_head) width_by_char_head[char_head]
+
+/* Charset of the character C. */
+#define CHAR_CHARSET(c) \
+ (SINGLE_BYTE_CHAR_P (c) \
+ ? CHARSET_ASCII \
+ : ((c) < MIN_CHAR_OFFICIAL_DIMENSION2 \
+ ? CHAR_FIELD2 (c) + 0x70 \
+ : ((c) < MIN_CHAR_PRIVATE_DIMENSION2 \
+ ? CHAR_FIELD1 (c) + 0x8F \
+ : ((c) < MIN_CHAR_COMPOSITION \
+ ? CHAR_FIELD1 (c) + 0xE0 \
+ : CHARSET_COMPOSITION))))
+
+/* Return charset at the place pointed by P. */
+#define CHARSET_AT(p) \
+ (*(p) < 0x80 \
+ ? CHARSET_ASCII \
+ : (*(p) == LEADING_CODE_COMPOSITION \
+ ? CHARSET_COMPOSITION \
+ : (*(p) < LEADING_CODE_PRIVATE_11 \
+ ? (int)*(p) \
+ : (*(p) <= LEADING_CODE_PRIVATE_22 \
+ ? (int)*((p) + 1) \
+ : -1))))
+
+/* Same as `CHARSET_AT ()' but perhaps runs faster because of an
+ additional argument C which is the code (byte) at P. */
+#define FIRST_CHARSET_AT(p, c) \
+ ((c) < 0x80 \
+ ? CHARSET_ASCII \
+ : ((c) == LEADING_CODE_COMPOSITION \
+ ? CHARSET_COMPOSITION \
+ : ((c) < LEADING_CODE_PRIVATE_11 \
+ ? (int)(c) \
+ : ((c) <= LEADING_CODE_PRIVATE_22 \
+ ? (int)*((p) + 1) \
+ : -1))))
+
+/* Check if two characters C1 and C2 belong to the same charset.
+ Always return 0 for composite characters. */
+#define SAME_CHARSET_P(c1, c2) \
+ (c1 < MIN_CHAR_COMPOSITION \
+ && (SINGLE_BYTE_CHAR_P (c1) \
+ ? SINGLE_BYTE_CHAR_P (c2) \
+ : (c1 < MIN_CHAR_OFFICIAL_DIMENSION2 \
+ ? (c1 & CHAR_FIELD2_MASK) == (c2 & CHAR_FIELD2_MASK) \
+ : (c1 & CHAR_FIELD1_MASK) == (c2 & CHAR_FIELD1_MASK))))
+
+/* Return a non-ASCII character of which charset is CHARSET and
+ position-codes are C1 and C2. DIMENSION1 character ignores C2. */
+#define MAKE_NON_ASCII_CHAR(charset, c1, c2) \
+ ((charset) == CHARSET_COMPOSITION \
+ ? MAKE_COMPOSITE_CHAR (((c1) << 7) + (c2)) \
+ : (CHARSET_DIMENSION (charset) == 1 \
+ ? (((charset) - 0x70) << 7) | (c1) \
+ : ((charset) < MIN_CHARSET_PRIVATE_DIMENSION2 \
+ ? (((charset) - 0x8F) << 14) | ((c1) << 7) | (c2) \
+ : (((charset) - 0xE0) << 14) | ((c1) << 7) | (c2))))
+
+/* Return a composite character of which CMPCHAR-ID is ID. */
+#define MAKE_COMPOSITE_CHAR(id) (MIN_CHAR_COMPOSITION + (id))
+
+/* Return CMPCHAR-ID of a composite character C. */
+#define COMPOSITE_CHAR_ID(c) ((c) - MIN_CHAR_COMPOSITION)
+
+/* Return a character of which charset is CHARSET and position-codes
+ are C1 and C2. DIMENSION1 character ignores C2. */
+#define MAKE_CHAR(charset, c1, c2) \
+ ((charset) == CHARSET_ASCII \
+ ? (c1) \
+ : MAKE_NON_ASCII_CHAR ((charset), (c1) & 0x7F, (c2) & 0x7F))
+
+/* The charset of non-ASCII character C is set to CHARSET, and the
+ position-codes of C are set to C1 and C2. C2 of DIMENSION1 character
+ is 0. */
+#define SPLIT_NON_ASCII_CHAR(c, charset, c1, c2) \
+ ((c) < MIN_CHAR_OFFICIAL_DIMENSION2 \
+ ? (charset = CHAR_FIELD2 (c) + 0x70, \
+ c1 = CHAR_FIELD3 (c), \
+ c2 = 0) \
+ : (charset = ((c) < MIN_CHAR_COMPOSITION \
+ ? (CHAR_FIELD1 (c) \
+ + ((c) < MIN_CHAR_PRIVATE_DIMENSION2 ? 0x8F : 0xE0)) \
+ : CHARSET_COMPOSITION), \
+ c1 = CHAR_FIELD2 (c), \
+ c2 = CHAR_FIELD3 (c)))
+
+/* The charset of character C is set to CHARSET, and the
+ position-codes of C are set to C1 and C2. C2 of DIMENSION1 character
+ is 0. */
+#define SPLIT_CHAR(c, charset, c1, c2) \
+ (SINGLE_BYTE_CHAR_P (c) \
+ ? charset = CHARSET_ASCII, c1 = (c), c2 = 0 \
+ : SPLIT_NON_ASCII_CHAR (c, charset, c1, c2))
+
+/* The charset of the character at STR is set to CHARSET, and the
+ position-codes are set to C1 and C2. C2 of DIMENSION1 character is 0.
+ If the character is a composite character, the upper 7-bit and
+ lower 7-bit of CMPCHAR-ID are set in C1 and C2 respectively. No
+ range checking. */
+#define SPLIT_STRING(str, len, charset, c1, c2) \
+ ((BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) < 2 \
+ || BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) > len \
+ || split_non_ascii_string (str, len, &charset, &c1, &c2, 0) < 0) \
+ ? c1 = *(str), charset = CHARSET_ASCII \
+ : charset)
+
+#define MAX_CHARSET 0xFF
+
+/* Mapping table from ISO2022's charset (specified by DIMENSION,
+ CHARS, and FINAL_CHAR) to Emacs' charset. Should be accessed by
+ macro ISO_CHARSET_TABLE (DIMENSION, CHARS, FINAL_CHAR). */
+extern int iso_charset_table[2][2][128];
+
+#define ISO_CHARSET_TABLE(dimension, chars, final_char) \
+ iso_charset_table[XINT (dimension) - 1][XINT (chars) > 94][XINT (final_char)]
+
+#define BASE_LEADING_CODE_P(c) (BYTES_BY_CHAR_HEAD ((unsigned char) (c)) > 1)
+
+/* The following two macros CHAR_STRING and STRING_CHAR are the main
+ entry points to convert between Emacs two types of character
+ representations: multi-byte form and single-word form (character
+ code). */
+
+/* Set STR a pointer to the multi-byte form of the character C. If C
+ is not a composite character, the multi-byte form is set in WORKBUF
+ and STR points WORKBUF. The caller should allocate at least 4-byte
+ area at WORKBUF in advance. Returns the length of the multi-byte
+ form. */
+
+#define CHAR_STRING(c, workbuf, str) \
+ (SINGLE_BYTE_CHAR_P (c) \
+ ? *(str = workbuf) = (unsigned char)(c), 1 \
+ : non_ascii_char_to_string (c, workbuf, &str))
+
+/* Return a character code of the character of which multi-byte form
+ is at STR and the length is LEN. If STR doesn't contain valid
+ multi-byte form, only the first byte in STR is returned. */
+
+#define STRING_CHAR(str, len) \
+ ((BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) == 1 \
+ || BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) > (len)) \
+ ? (unsigned char) *(str) \
+ : string_to_non_ascii_char (str, len, 0))
+
+/* This is like STRING_CHAR but the third arg ACTUAL_LEN is set to
+ the length of the multi-byte form. Just to know the length, use
+ MULTIBYTE_FORM_LENGTH. */
+
+#define STRING_CHAR_AND_LENGTH(str, len, actual_len) \
+ ((BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) == 1 \
+ || BYTES_BY_CHAR_HEAD ((unsigned char) *(str)) > (len)) \
+ ? (actual_len = 1), (unsigned char) *(str) \
+ : string_to_non_ascii_char (str, len, &actual_len))
+
+/* Return the length of the multi-byte form at string STR of length LEN. */
+
+#define MULTIBYTE_FORM_LENGTH(str, len) \
+ ((BYTES_BY_CHAR_HEAD (*(unsigned char *)(str)) == 1 \
+ || BYTES_BY_CHAR_HEAD (*(unsigned char *)(str)) > (len)) \
+ ? 1 \
+ : multibyte_form_length (str, len))
+
+/* Set C a (possibly multibyte) character at P. P points into a
+ string which is the virtual concatenation of STR1 (which ends at
+ END1) or STR2 (which ends at END2). */
+
+#define GET_CHAR_AFTER_2(c, p, str1, end1, str2, end2) \
+ do { \
+ const char *dtemp = (p) == (end1) ? (str2) : (p); \
+ const char *dlimit = ((p) >= (str1) && (p) < (end1)) ? (end1) : (end2); \
+ c = STRING_CHAR (dtemp, dlimit - dtemp); \
+ } while (0)
+
+/* Set C a (possibly multibyte) character before P. P points into a
+ string which is the virtual concatenation of STR1 (which ends at
+ END1) or STR2 (which ends at END2). */
+
+#define GET_CHAR_BEFORE_2(c, p, str1, end1, str2, end2) \
+ do { \
+ const char *dtemp = (p); \
+ const char *dlimit = ((p) > (str2) && (p) <= (end2)) ? (str2) : (str1); \
+ while (dtemp-- > dlimit && (unsigned char) *dtemp >= 0xA0); \
+ c = STRING_CHAR (dtemp, p - dtemp); \
+ } while (0)
+
+#ifdef emacs
+
+/* Increase the buffer point POS of the current buffer to the next
+ character boundary. This macro relies on the fact that *GPT_ADDR
+ and *Z_ADDR are always accessible and the values are '\0'. No
+ range checking of POS. */
+#define INC_POS(pos) \
+ do { \
+ unsigned char *p = POS_ADDR (pos) + 1; \
+ pos++; \
+ while (!CHAR_HEAD_P (p)) p++, pos++; \
+ } while (0)
+
+/* Decrease the buffer point POS of the current buffer to the previous
+ character boundary. No range checking of POS. */
+#define DEC_POS(pos) \
+ do { \
+ unsigned char *p, *p_min; \
+ if (--pos < GPT) \
+ p = BEG_ADDR + pos - 1, p_min = BEG_ADDR; \
+ else \
+ p = BEG_ADDR + GAP_SIZE + pos - 1, p_min = GAP_END_ADDR; \
+ while (p > p_min && !CHAR_HEAD_P (p)) p--, pos--; \
+ } while (0)
+
+#endif /* emacs */
+
+/* Maximum counts of components in one composite character. */
+#define MAX_COMPONENT_COUNT 16
+
+/* Structure to hold information of a composite character. */
+struct cmpchar_info {
+ /* Byte length of the composite character. */
+ int len;
+
+ /* Multi-byte form of the composite character. */
+ unsigned char *data;
+
+ /* Length of glyph codes. */
+ int glyph_len;
+
+ /* Width of the overall glyph of the composite character. */
+ int width;
+
+ /* Pointer to an array of glyph codes of the composite character.
+ This actually contains only character code, no face. */
+ GLYPH *glyph;
+
+ /* Pointer to an array of composition rules. The value has the form:
+ (0xA0 + ((GLOBAL-REF-POINT << 2) | NEW-REF-POINT))
+ where each XXX-REF-POINT is 0..8. */
+ unsigned char *cmp_rule;
+
+ /* Pointer to an array of x-axis offset of left edge of glyphs
+ relative to the left of of glyph[0] except for the first element
+ which is the absolute offset from the left edge of overall glyph.
+ The actual pixel offset should be calculated by multiplying each
+ frame's one column width by this value:
+ (i.e. FONT_WIDTH (f->output_data.x->font) * col_offset[N]). */
+ float *col_offset;
+
+ /* Work slot used by `dumpglyphs' (xterm.c). */
+ int face_work;
+};
+
+/* Table of pointers to the structure `cmpchar_info' indexed by
+ CMPCHAR-ID. */
+extern struct cmpchar_info **cmpchar_table;
+/* Number of the current composite characters. */
+extern int n_cmpchars;
+
+/* This is the maximum length of multi-byte form. */
+#define MAX_LENGTH_OF_MULTI_BYTE_FORM (MAX_COMPONENT_COUNT * 6)
+
+#endif /* _CHARSET_H */
+
diff --git a/src/coding.c b/src/coding.c
new file mode 100644
index 00000000000..95bbd26fef9
--- /dev/null
+++ b/src/coding.c
@@ -0,0 +1,3520 @@
+/* Coding system handler (conversion, detection, and etc).
+ Ver.1.0.
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+/*** TABLE OF CONTENTS ***
+
+ 1. Preamble
+ 2. Emacs' internal format handlers
+ 3. ISO2022 handlers
+ 4. Shift-JIS and BIG5 handlers
+ 5. End-of-line handlers
+ 6. C library functions
+ 7. Emacs Lisp library functions
+ 8. Post-amble
+
+*/
+
+/*** GENERAL NOTE on CODING SYSTEM ***
+
+ Coding system is an encoding mechanism of one or more character
+ sets. Here's a list of coding systems which Emacs can handle. When
+ we say "decode", it means converting some other coding system to
+ Emacs' internal format, and when we say "encode", it means
+ converting Emacs' internal format to some other coding system.
+
+ 0. Emacs' internal format
+
+ Emacs itself holds a multi-lingual character in a buffer and a string
+ in a special format. Details are described in the section 2.
+
+ 1. ISO2022
+
+ The most famous coding system for multiple character sets. X's
+ Compound Text, various EUCs (Extended Unix Code), and such coding
+ systems used in Internet communication as ISO-2022-JP are all
+ variants of ISO2022. Details are described in the section 3.
+
+ 2. SJIS (or Shift-JIS or MS-Kanji-Code)
+
+ A coding system to encode character sets: ASCII, JISX0201, and
+ JISX0208. Widely used for PC's in Japan. Details are described in
+ the section 4.
+
+ 3. BIG5
+
+ A coding system to encode character sets: ASCII and Big5. Widely
+ used by Chinese (mainly in Taiwan and Hong Kong). Details are
+ described in the section 4. In this file, when written as "BIG5"
+ (all uppercase), it means the coding system, and when written as
+ "Big5" (capitalized), it means the character set.
+
+ 4. Else
+
+ If a user want to read/write a text encoded in a coding system not
+ listed above, he can supply a decoder and an encoder for it in CCL
+ (Code Conversion Language) programs. Emacs executes the CCL program
+ while reading/writing.
+
+ Emacs represent a coding-system by a Lisp symbol that has a property
+ `coding-system'. But, before actually using the coding-system, the
+ information about it is set in a structure of type `struct
+ coding_system' for rapid processing. See the section 6 for more
+ detail.
+
+*/
+
+/*** GENERAL NOTES on END-OF-LINE FORMAT ***
+
+ How end-of-line of a text is encoded depends on a system. For
+ instance, Unix's format is just one byte of `line-feed' code,
+ whereas DOS's format is two bytes sequence of `carriage-return' and
+ `line-feed' codes. MacOS's format is one byte of `carriage-return'.
+
+ Since how characters in a text is encoded and how end-of-line is
+ encoded is independent, any coding system described above can take
+ any format of end-of-line. So, Emacs has information of format of
+ end-of-line in each coding-system. See the section 6 for more
+ detail.
+
+*/
+
+/*** GENERAL NOTES on `detect_coding_XXX ()' functions ***
+
+ These functions check if a text between SRC and SRC_END is encoded
+ in the coding system category XXX. Each returns an integer value in
+ which appropriate flag bits for the category XXX is set. The flag
+ bits are defined in macros CODING_CATEGORY_MASK_XXX. Below is the
+ template of these functions. */
+#if 0
+int
+detect_coding_internal (src, src_end)
+ unsigned char *src, *src_end;
+{
+ ...
+}
+#endif
+
+/*** GENERAL NOTES on `decode_coding_XXX ()' functions ***
+
+ These functions decode SRC_BYTES length text at SOURCE encoded in
+ CODING to Emacs' internal format. The resulting text goes to a
+ place pointed by DESTINATION, the length of which should not exceed
+ DST_BYTES. The bytes actually processed is returned as *CONSUMED.
+ The return value is the length of the decoded text. Below is a
+ template of these functions. */
+#if 0
+decode_coding_XXX (coding, source, destination, src_bytes, dst_bytes, consumed)
+ struct coding_system *coding;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+{
+ ...
+}
+#endif
+
+/*** GENERAL NOTES on `encode_coding_XXX ()' functions ***
+
+ These functions encode SRC_BYTES length text at SOURCE of Emacs
+ internal format to CODING. The resulting text goes to a place
+ pointed by DESTINATION, the length of which should not exceed
+ DST_BYTES. The bytes actually processed is returned as *CONSUMED.
+ The return value is the length of the encoded text. Below is a
+ template of these functions. */
+#if 0
+encode_coding_XXX (coding, source, destination, src_bytes, dst_bytes, consumed)
+ struct coding_system *coding;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+{
+ ...
+}
+#endif
+
+/*** COMMONLY USED MACROS ***/
+
+/* The following three macros ONE_MORE_BYTE, TWO_MORE_BYTES, and
+ THREE_MORE_BYTES safely get one, two, and three bytes from the
+ source text respectively. If there are not enough bytes in the
+ source, they jump to `label_end_of_loop'. The caller should set
+ variables `src' and `src_end' to appropriate areas in advance. */
+
+#define ONE_MORE_BYTE(c1) \
+ do { \
+ if (src < src_end) \
+ c1 = *src++; \
+ else \
+ goto label_end_of_loop; \
+ } while (0)
+
+#define TWO_MORE_BYTES(c1, c2) \
+ do { \
+ if (src + 1 < src_end) \
+ c1 = *src++, c2 = *src++; \
+ else \
+ goto label_end_of_loop; \
+ } while (0)
+
+#define THREE_MORE_BYTES(c1, c2, c3) \
+ do { \
+ if (src + 2 < src_end) \
+ c1 = *src++, c2 = *src++, c3 = *src++; \
+ else \
+ goto label_end_of_loop; \
+ } while (0)
+
+/* The following three macros DECODE_CHARACTER_ASCII,
+ DECODE_CHARACTER_DIMENSION1, and DECODE_CHARACTER_DIMENSION2 put
+ the multi-byte form of a character of each class at the place
+ pointed by `dst'. The caller should set the variable `dst' to
+ point to an appropriate area and the variable `coding' to point to
+ the coding-system of the currently decoding text in advance. */
+
+/* Decode one ASCII character C. */
+
+#define DECODE_CHARACTER_ASCII(c) \
+ do { \
+ if (COMPOSING_P (coding->composing)) \
+ *dst++ = 0xA0, *dst++ = (c) | 0x80; \
+ else \
+ *dst++ = (c); \
+ } while (0)
+
+/* Decode one DIMENSION1 character of which charset is CHARSET and
+ position-code is C. */
+
+#define DECODE_CHARACTER_DIMENSION1(charset, c) \
+ do { \
+ unsigned char leading_code = CHARSET_LEADING_CODE_BASE (charset); \
+ if (COMPOSING_P (coding->composing)) \
+ *dst++ = leading_code + 0x20; \
+ else \
+ *dst++ = leading_code; \
+ if (leading_code = CHARSET_LEADING_CODE_EXT (charset)) \
+ *dst++ = leading_code; \
+ *dst++ = (c) | 0x80; \
+ } while (0)
+
+/* Decode one DIMENSION2 character of which charset is CHARSET and
+ position-codes are C1 and C2. */
+
+#define DECODE_CHARACTER_DIMENSION2(charset, c1, c2) \
+ do { \
+ DECODE_CHARACTER_DIMENSION1 (charset, c1); \
+ *dst++ = (c2) | 0x80; \
+ } while (0)
+
+
+/*** 1. Preamble ***/
+
+#include <stdio.h>
+
+#ifdef emacs
+
+#include <config.h>
+#include "lisp.h"
+#include "buffer.h"
+#include "charset.h"
+#include "ccl.h"
+#include "coding.h"
+#include "window.h"
+
+#else /* not emacs */
+
+#include "mulelib.h"
+
+#endif /* not emacs */
+
+Lisp_Object Qcoding_system, Qeol_type;
+Lisp_Object Qbuffer_file_coding_system;
+Lisp_Object Qpost_read_conversion, Qpre_write_conversion;
+
+extern Lisp_Object Qinsert_file_contents, Qwrite_region;
+Lisp_Object Qcall_process, Qcall_process_region, Qprocess_argument;
+Lisp_Object Qstart_process, Qopen_network_stream;
+Lisp_Object Qtarget_idx;
+
+/* Mnemonic character of each format of end-of-line. */
+int eol_mnemonic_unix, eol_mnemonic_dos, eol_mnemonic_mac;
+/* Mnemonic character to indicate format of end-of-line is not yet
+ decided. */
+int eol_mnemonic_undecided;
+
+#ifdef emacs
+
+Lisp_Object Qcoding_system_vector, Qcoding_system_p, Qcoding_system_error;
+
+/* Coding-systems are handed between Emacs Lisp programs and C internal
+ routines by the following three variables. */
+/* Coding-system for reading files and receiving data from process. */
+Lisp_Object Vcoding_system_for_read;
+/* Coding-system for writing files and sending data to process. */
+Lisp_Object Vcoding_system_for_write;
+/* Coding-system actually used in the latest I/O. */
+Lisp_Object Vlast_coding_system_used;
+
+/* Coding-system of what terminal accept for displaying. */
+struct coding_system terminal_coding;
+
+/* Coding-system of what is sent from terminal keyboard. */
+struct coding_system keyboard_coding;
+
+Lisp_Object Vcoding_system_alist;
+
+#endif /* emacs */
+
+Lisp_Object Qcoding_category_index;
+
+/* List of symbols `coding-category-xxx' ordered by priority. */
+Lisp_Object Vcoding_category_list;
+
+/* Table of coding-systems currently assigned to each coding-category. */
+Lisp_Object coding_category_table[CODING_CATEGORY_IDX_MAX];
+
+/* Table of names of symbol for each coding-category. */
+char *coding_category_name[CODING_CATEGORY_IDX_MAX] = {
+ "coding-category-internal",
+ "coding-category-sjis",
+ "coding-category-iso-7",
+ "coding-category-iso-8-1",
+ "coding-category-iso-8-2",
+ "coding-category-iso-else",
+ "coding-category-big5",
+ "coding-category-binary"
+};
+
+/* Alist of charsets vs the alternate charsets. */
+Lisp_Object Valternate_charset_table;
+
+/* Alist of charsets vs revision number. */
+Lisp_Object Vcharset_revision_alist;
+
+
+/*** 2. Emacs internal format handlers ***/
+
+/* Emacs' internal format for encoding multiple character sets is a
+ kind of multi-byte encoding, i.e. encoding a character by a sequence
+ of one-byte codes of variable length. ASCII characters and control
+ characters (e.g. `tab', `newline') are represented by one-byte as
+ is. It takes the range 0x00 through 0x7F. The other characters
+ are represented by a sequence of `base leading-code', optional
+ `extended leading-code', and one or two `position-code's. Length
+ of the sequence is decided by the base leading-code. Leading-code
+ takes the range 0x80 through 0x9F, whereas extended leading-code
+ and position-code take the range 0xA0 through 0xFF. See the
+ document of `charset.h' for more detail about leading-code and
+ position-code.
+
+ There's one exception in this rule. Special leading-code
+ `leading-code-composition' denotes that the following several
+ characters should be composed into one character. Leading-codes of
+ components (except for ASCII) are added 0x20. An ASCII character
+ component is represented by a 2-byte sequence of `0xA0' and
+ `ASCII-code + 0x80'. See also the document in `charset.h' for the
+ detail of composite character. Hence, we can summarize the code
+ range as follows:
+
+ --- CODE RANGE of Emacs' internal format ---
+ (character set) (range)
+ ASCII 0x00 .. 0x7F
+ ELSE (1st byte) 0x80 .. 0x9F
+ (rest bytes) 0xA0 .. 0xFF
+ ---------------------------------------------
+
+ */
+
+enum emacs_code_class_type emacs_code_class[256];
+
+/* Go to the next statement only if *SRC is accessible and the code is
+ greater than 0xA0. */
+#define CHECK_CODE_RANGE_A0_FF \
+ do { \
+ if (src >= src_end) \
+ goto label_end_of_switch; \
+ else if (*src++ < 0xA0) \
+ return 0; \
+ } while (0)
+
+/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
+ Check if a text is encoded in Emacs' internal format. If it is,
+ return CODING_CATEGORY_MASK_INTERNAL, else return 0. */
+
+int
+detect_coding_internal (src, src_end)
+ unsigned char *src, *src_end;
+{
+ unsigned char c;
+ int composing = 0;
+
+ while (src < src_end)
+ {
+ c = *src++;
+
+ if (composing)
+ {
+ if (c < 0xA0)
+ composing = 0;
+ else
+ c -= 0x20;
+ }
+
+ switch (emacs_code_class[c])
+ {
+ case EMACS_ascii_code:
+ case EMACS_linefeed_code:
+ break;
+
+ case EMACS_control_code:
+ if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
+ return 0;
+ break;
+
+ case EMACS_invalid_code:
+ return 0;
+
+ case EMACS_leading_code_composition: /* c == 0x80 */
+ if (composing)
+ CHECK_CODE_RANGE_A0_FF;
+ else
+ composing = 1;
+ break;
+
+ case EMACS_leading_code_4:
+ CHECK_CODE_RANGE_A0_FF;
+ /* fall down to check it two more times ... */
+
+ case EMACS_leading_code_3:
+ CHECK_CODE_RANGE_A0_FF;
+ /* fall down to check it one more time ... */
+
+ case EMACS_leading_code_2:
+ CHECK_CODE_RANGE_A0_FF;
+ break;
+
+ default:
+ label_end_of_switch:
+ break;
+ }
+ }
+ return CODING_CATEGORY_MASK_INTERNAL;
+}
+
+
+/*** 3. ISO2022 handlers ***/
+
+/* The following note describes the coding system ISO2022 briefly.
+ Since the intension of this note is to help understanding of the
+ programs in this file, some parts are NOT ACCURATE or OVERLY
+ SIMPLIFIED. For the thorough understanding, please refer to the
+ original document of ISO2022.
+
+ ISO2022 provides many mechanisms to encode several character sets
+ in 7-bit and 8-bit environment. If one choose 7-bite environment,
+ all text is encoded by codes of less than 128. This may make the
+ encoded text a little bit longer, but the text get more stability
+ to pass through several gateways (some of them split MSB off).
+
+ There are two kind of character set: control character set and
+ graphic character set. The former contains control characters such
+ as `newline' and `escape' to provide control functions (control
+ functions are provided also by escape sequence). The latter
+ contains graphic characters such as ' A' and '-'. Emacs recognizes
+ two control character sets and many graphic character sets.
+
+ Graphic character sets are classified into one of the following
+ four classes, DIMENSION1_CHARS94, DIMENSION1_CHARS96,
+ DIMENSION2_CHARS94, DIMENSION2_CHARS96 according to the number of
+ bytes (DIMENSION) and the number of characters in one dimension
+ (CHARS) of the set. In addition, each character set is assigned an
+ identification tag (called "final character" and denoted as <F>
+ here after) which is unique in each class. <F> of each character
+ set is decided by ECMA(*) when it is registered in ISO. Code range
+ of <F> is 0x30..0x7F (0x30..0x3F are for private use only).
+
+ Note (*): ECMA = European Computer Manufacturers Association
+
+ Here are examples of graphic character set [NAME(<F>)]:
+ o DIMENSION1_CHARS94 -- ASCII('B'), right-half-of-JISX0201('I'), ...
+ o DIMENSION1_CHARS96 -- right-half-of-ISO8859-1('A'), ...
+ o DIMENSION2_CHARS94 -- GB2312('A'), JISX0208('B'), ...
+ o DIMENSION2_CHARS96 -- none for the moment
+
+ A code area (1byte=8bits) is divided into 4 areas, C0, GL, C1, and GR.
+ C0 [0x00..0x1F] -- control character plane 0
+ GL [0x20..0x7F] -- graphic character plane 0
+ C1 [0x80..0x9F] -- control character plane 1
+ GR [0xA0..0xFF] -- graphic character plane 1
+
+ A control character set is directly designated and invoked to C0 or
+ C1 by an escape sequence. The most common case is that ISO646's
+ control character set is designated/invoked to C0 and ISO6429's
+ control character set is designated/invoked to C1, and usually
+ these designations/invocations are omitted in a coded text. With
+ 7-bit environment, only C0 can be used, and a control character for
+ C1 is encoded by an appropriate escape sequence to fit in the
+ environment. All control characters for C1 are defined the
+ corresponding escape sequences.
+
+ A graphic character set is at first designated to one of four
+ graphic registers (G0 through G3), then these graphic registers are
+ invoked to GL or GR. These designations and invocations can be
+ done independently. The most common case is that G0 is invoked to
+ GL, G1 is invoked to GR, and ASCII is designated to G0, and usually
+ these invocations and designations are omitted in a coded text.
+ With 7-bit environment, only GL can be used.
+
+ When a graphic character set of CHARS94 is invoked to GL, code 0x20
+ and 0x7F of GL area work as control characters SPACE and DEL
+ respectively, and code 0xA0 and 0xFF of GR area should not be used.
+
+ There are two ways of invocation: locking-shift and single-shift.
+ With locking-shift, the invocation lasts until the next different
+ invocation, whereas with single-shift, the invocation works only
+ for the following character and doesn't affect locking-shift.
+ Invocations are done by the following control characters or escape
+ sequences.
+
+ ----------------------------------------------------------------------
+ function control char escape sequence description
+ ----------------------------------------------------------------------
+ SI (shift-in) 0x0F none invoke G0 to GL
+ SI (shift-out) 0x0E none invoke G1 to GL
+ LS2 (locking-shift-2) none ESC 'n' invoke G2 into GL
+ LS3 (locking-shift-3) none ESC 'o' invoke G3 into GL
+ SS2 (single-shift-2) 0x8E ESC 'N' invoke G2 into GL
+ SS3 (single-shift-3) 0x8F ESC 'O' invoke G3 into GL
+ ----------------------------------------------------------------------
+ The first four are for locking-shift. Control characters for these
+ functions are defined by macros ISO_CODE_XXX in `coding.h'.
+
+ Designations are done by the following escape sequences.
+ ----------------------------------------------------------------------
+ escape sequence description
+ ----------------------------------------------------------------------
+ ESC '(' <F> designate DIMENSION1_CHARS94<F> to G0
+ ESC ')' <F> designate DIMENSION1_CHARS94<F> to G1
+ ESC '*' <F> designate DIMENSION1_CHARS94<F> to G2
+ ESC '+' <F> designate DIMENSION1_CHARS94<F> to G3
+ ESC ',' <F> designate DIMENSION1_CHARS96<F> to G0 (*)
+ ESC '-' <F> designate DIMENSION1_CHARS96<F> to G1
+ ESC '.' <F> designate DIMENSION1_CHARS96<F> to G2
+ ESC '/' <F> designate DIMENSION1_CHARS96<F> to G3
+ ESC '$' '(' <F> designate DIMENSION2_CHARS94<F> to G0 (**)
+ ESC '$' ')' <F> designate DIMENSION2_CHARS94<F> to G1
+ ESC '$' '*' <F> designate DIMENSION2_CHARS94<F> to G2
+ ESC '$' '+' <F> designate DIMENSION2_CHARS94<F> to G3
+ ESC '$' ',' <F> designate DIMENSION2_CHARS96<F> to G0 (*)
+ ESC '$' '-' <F> designate DIMENSION2_CHARS96<F> to G1
+ ESC '$' '.' <F> designate DIMENSION2_CHARS96<F> to G2
+ ESC '$' '/' <F> designate DIMENSION2_CHARS96<F> to G3
+ ----------------------------------------------------------------------
+
+ In this list, "DIMENSION1_CHARS94<F>" means a graphic character set
+ of dimension 1, chars 94, and final character <F>, and etc.
+
+ Note (*): Although these designations are not allowed in ISO2022,
+ Emacs accepts them on decoding, and produces them on encoding
+ CHARS96 character set in a coding system which is characterized as
+ 7-bit environment, non-locking-shift, and non-single-shift.
+
+ Note (**): If <F> is '@', 'A', or 'B', the intermediate character
+ '(' can be omitted. We call this as "short-form" here after.
+
+ Now you may notice that there are a lot of ways for encoding the
+ same multilingual text in ISO2022. Actually, there exist many
+ coding systems such as Compound Text (used in X's inter client
+ communication, ISO-2022-JP (used in Japanese Internet), ISO-2022-KR
+ (used in Korean Internet), EUC (Extended UNIX Code, used in Asian
+ localized platforms), and all of these are variants of ISO2022.
+
+ In addition to the above, Emacs handles two more kinds of escape
+ sequences: ISO6429's direction specification and Emacs' private
+ sequence for specifying character composition.
+
+ ISO6429's direction specification takes the following format:
+ o CSI ']' -- end of the current direction
+ o CSI '0' ']' -- end of the current direction
+ o CSI '1' ']' -- start of left-to-right text
+ o CSI '2' ']' -- start of right-to-left text
+ The control character CSI (0x9B: control sequence introducer) is
+ abbreviated to the escape sequence ESC '[' in 7-bit environment.
+
+ Character composition specification takes the following format:
+ o ESC '0' -- start character composition
+ o ESC '1' -- end character composition
+ Since these are not standard escape sequences of any ISO, the use
+ of them for these meaning is restricted to Emacs only. */
+
+enum iso_code_class_type iso_code_class[256];
+
+/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
+ Check if a text is encoded in ISO2022. If it is, returns an
+ integer in which appropriate flag bits any of:
+ CODING_CATEGORY_MASK_ISO_7
+ CODING_CATEGORY_MASK_ISO_8_1
+ CODING_CATEGORY_MASK_ISO_8_2
+ CODING_CATEGORY_MASK_ISO_ELSE
+ are set. If a code which should never appear in ISO2022 is found,
+ returns 0. */
+
+int
+detect_coding_iso2022 (src, src_end)
+ unsigned char *src, *src_end;
+{
+ unsigned char graphic_register[4];
+ unsigned char c, esc_cntl;
+ int mask = (CODING_CATEGORY_MASK_ISO_7
+ | CODING_CATEGORY_MASK_ISO_8_1
+ | CODING_CATEGORY_MASK_ISO_8_2);
+ /* We may look ahead maximum 3 bytes. */
+ unsigned char *adjusted_src_end = src_end - 3;
+ int i;
+
+ for (i = 0; i < 4; i++)
+ graphic_register[i] = CHARSET_ASCII;
+
+ while (src < adjusted_src_end)
+ {
+ c = *src++;
+ switch (c)
+ {
+ case ISO_CODE_ESC:
+ if (src >= adjusted_src_end)
+ break;
+ c = *src++;
+ if (c == '$')
+ {
+ /* Designation of 2-byte character set. */
+ if (src >= adjusted_src_end)
+ break;
+ c = *src++;
+ }
+ if ((c >= ')' && c <= '+') || (c >= '-' && c <= '/'))
+ /* Designation to graphic register 1, 2, or 3. */
+ mask &= ~CODING_CATEGORY_MASK_ISO_7;
+ else if (c == 'N' || c == 'O' || c == 'n' || c == 'o')
+ return CODING_CATEGORY_MASK_ISO_ELSE;
+ break;
+
+ case ISO_CODE_SI:
+ case ISO_CODE_SO:
+ return CODING_CATEGORY_MASK_ISO_ELSE;
+
+ case ISO_CODE_CSI:
+ case ISO_CODE_SS2:
+ case ISO_CODE_SS3:
+ mask &= ~CODING_CATEGORY_MASK_ISO_7;
+ break;
+
+ default:
+ if (c < 0x80)
+ break;
+ else if (c < 0xA0)
+ return 0;
+ else
+ {
+ int count = 1;
+
+ mask &= ~CODING_CATEGORY_MASK_ISO_7;
+ while (src < adjusted_src_end && *src >= 0xA0)
+ count++, src++;
+ if (count & 1 && src < adjusted_src_end)
+ mask &= ~CODING_CATEGORY_MASK_ISO_8_2;
+ }
+ break;
+ }
+ }
+
+ return mask;
+}
+
+/* Decode a character of which charset is CHARSET and the 1st position
+ code is C1. If dimension of CHARSET 2, the 2nd position code is
+ fetched from SRC and set to C2. If CHARSET is negative, it means
+ that we are decoding ill formed text, and what we can do is just to
+ read C1 as is. */
+
+#define DECODE_ISO_CHARACTER(charset, c1) \
+ do { \
+ if ((charset) >= 0 && CHARSET_DIMENSION (charset) == 2) \
+ ONE_MORE_BYTE (c2); \
+ if (COMPOSING_HEAD_P (coding->composing)) \
+ { \
+ *dst++ = LEADING_CODE_COMPOSITION; \
+ if (COMPOSING_WITH_RULE_P (coding->composing)) \
+ /* To tell composition rules are embeded. */ \
+ *dst++ = 0xFF; \
+ coding->composing += 2; \
+ } \
+ if ((charset) < 0) \
+ *dst++ = c1; \
+ else if ((charset) == CHARSET_ASCII) \
+ DECODE_CHARACTER_ASCII (c1); \
+ else if (CHARSET_DIMENSION (charset) == 1) \
+ DECODE_CHARACTER_DIMENSION1 (charset, c1); \
+ else \
+ DECODE_CHARACTER_DIMENSION2 (charset, c1, c2); \
+ if (COMPOSING_WITH_RULE_P (coding->composing)) \
+ /* To tell a composition rule follows. */ \
+ coding->composing = COMPOSING_WITH_RULE_RULE; \
+ } while (0)
+
+/* Set designation state into CODING. */
+#define DECODE_DESIGNATION(reg, dimension, chars, final_char) \
+ do { \
+ int charset = ISO_CHARSET_TABLE (dimension, chars, final_char); \
+ Lisp_Object temp \
+ = Fassq (CHARSET_SYMBOL (charset), Valternate_charset_table); \
+ if (! NILP (temp)) \
+ charset = get_charset_id (XCONS (temp)->cdr); \
+ if (charset >= 0) \
+ { \
+ if (coding->direction == 1 \
+ && CHARSET_REVERSE_CHARSET (charset) >= 0) \
+ charset = CHARSET_REVERSE_CHARSET (charset); \
+ CODING_SPEC_ISO_DESIGNATION (coding, reg) = charset; \
+ } \
+ } while (0)
+
+/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions". */
+
+int
+decode_coding_iso2022 (coding, source, destination,
+ src_bytes, dst_bytes, consumed)
+ struct coding_system *coding;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+{
+ unsigned char *src = source;
+ unsigned char *src_end = source + src_bytes;
+ unsigned char *dst = destination;
+ unsigned char *dst_end = destination + dst_bytes;
+ /* Since the maximum bytes produced by each loop is 7, we subtract 6
+ from DST_END to assure that overflow checking is necessary only
+ at the head of loop. */
+ unsigned char *adjusted_dst_end = dst_end - 6;
+ int charset;
+ /* Charsets invoked to graphic plane 0 and 1 respectively. */
+ int charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
+ int charset1 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 1);
+
+ while (src < src_end && dst < adjusted_dst_end)
+ {
+ /* SRC_BASE remembers the start position in source in each loop.
+ The loop will be exited when there's not enough source text
+ to analyze long escape sequence or 2-byte code (within macros
+ ONE_MORE_BYTE or TWO_MORE_BYTES). In that case, SRC is reset
+ to SRC_BASE before exiting. */
+ unsigned char *src_base = src;
+ unsigned char c1 = *src++, c2, cmprule;
+
+ switch (iso_code_class [c1])
+ {
+ case ISO_0x20_or_0x7F:
+ if (!coding->composing
+ && (charset0 < 0 || CHARSET_CHARS (charset0) == 94))
+ {
+ /* This is SPACE or DEL. */
+ *dst++ = c1;
+ break;
+ }
+ /* This is a graphic character, we fall down ... */
+
+ case ISO_graphic_plane_0:
+ if (coding->composing == COMPOSING_WITH_RULE_RULE)
+ {
+ /* This is a composition rule. */
+ *dst++ = c1 | 0x80;
+ coding->composing = COMPOSING_WITH_RULE_TAIL;
+ }
+ else
+ DECODE_ISO_CHARACTER (charset0, c1);
+ break;
+
+ case ISO_0xA0_or_0xFF:
+ if (charset1 < 0 || CHARSET_CHARS (charset1) == 94)
+ {
+ /* Invalid code. */
+ *dst++ = c1;
+ break;
+ }
+ /* This is a graphic character, we fall down ... */
+
+ case ISO_graphic_plane_1:
+ DECODE_ISO_CHARACTER (charset1, c1);
+ break;
+
+ case ISO_control_code:
+ /* All ISO2022 control characters in this class have the
+ same representation in Emacs internal format. */
+ *dst++ = c1;
+ break;
+
+ case ISO_carriage_return:
+ if (coding->eol_type == CODING_EOL_CR)
+ {
+ *dst++ = '\n';
+ }
+ else if (coding->eol_type == CODING_EOL_CRLF)
+ {
+ ONE_MORE_BYTE (c1);
+ if (c1 == ISO_CODE_LF)
+ *dst++ = '\n';
+ else
+ {
+ src--;
+ *dst++ = c1;
+ }
+ }
+ else
+ {
+ *dst++ = c1;
+ }
+ break;
+
+ case ISO_shift_out:
+ CODING_SPEC_ISO_INVOCATION (coding, 0) = 1;
+ charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
+ break;
+
+ case ISO_shift_in:
+ CODING_SPEC_ISO_INVOCATION (coding, 0) = 0;
+ charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
+ break;
+
+ case ISO_single_shift_2_7:
+ case ISO_single_shift_2:
+ /* SS2 is handled as an escape sequence of ESC 'N' */
+ c1 = 'N';
+ goto label_escape_sequence;
+
+ case ISO_single_shift_3:
+ /* SS2 is handled as an escape sequence of ESC 'O' */
+ c1 = 'O';
+ goto label_escape_sequence;
+
+ case ISO_control_sequence_introducer:
+ /* CSI is handled as an escape sequence of ESC '[' ... */
+ c1 = '[';
+ goto label_escape_sequence;
+
+ case ISO_escape:
+ ONE_MORE_BYTE (c1);
+ label_escape_sequence:
+ /* Escape sequences handled by Emacs are invocation,
+ designation, direction specification, and character
+ composition specification. */
+ switch (c1)
+ {
+ case '&': /* revision of following character set */
+ ONE_MORE_BYTE (c1);
+ if (!(c1 >= '@' && c1 <= '~'))
+ {
+ goto label_invalid_escape_sequence;
+ }
+ ONE_MORE_BYTE (c1);
+ if (c1 != ISO_CODE_ESC)
+ {
+ goto label_invalid_escape_sequence;
+ }
+ ONE_MORE_BYTE (c1);
+ goto label_escape_sequence;
+
+ case '$': /* designation of 2-byte character set */
+ ONE_MORE_BYTE (c1);
+ if (c1 >= '@' && c1 <= 'B')
+ { /* designation of JISX0208.1978, GB2312.1980,
+ or JISX0208.1980 */
+ DECODE_DESIGNATION (0, 2, 94, c1);
+ }
+ else if (c1 >= 0x28 && c1 <= 0x2B)
+ { /* designation of DIMENSION2_CHARS94 character set */
+ ONE_MORE_BYTE (c2);
+ DECODE_DESIGNATION (c1 - 0x28, 2, 94, c2);
+ }
+ else if (c1 >= 0x2C && c1 <= 0x2F)
+ { /* designation of DIMENSION2_CHARS96 character set */
+ ONE_MORE_BYTE (c2);
+ DECODE_DESIGNATION (c1 - 0x2C, 2, 96, c2);
+ }
+ else
+ {
+ goto label_invalid_escape_sequence;
+ }
+ break;
+
+ case 'n': /* invocation of locking-shift-2 */
+ CODING_SPEC_ISO_INVOCATION (coding, 0) = 2;
+ break;
+
+ case 'o': /* invocation of locking-shift-3 */
+ CODING_SPEC_ISO_INVOCATION (coding, 0) = 3;
+ break;
+
+ case 'N': /* invocation of single-shift-2 */
+ ONE_MORE_BYTE (c1);
+ charset = CODING_SPEC_ISO_DESIGNATION (coding, 2);
+ DECODE_ISO_CHARACTER (charset, c1);
+ break;
+
+ case 'O': /* invocation of single-shift-3 */
+ ONE_MORE_BYTE (c1);
+ charset = CODING_SPEC_ISO_DESIGNATION (coding, 3);
+ DECODE_ISO_CHARACTER (charset, c1);
+ break;
+
+ case '0': /* start composing without embeded rules */
+ coding->composing = COMPOSING_NO_RULE_HEAD;
+ break;
+
+ case '1': /* end composing */
+ coding->composing = COMPOSING_NO;
+ break;
+
+ case '2': /* start composing with embeded rules */
+ coding->composing = COMPOSING_WITH_RULE_HEAD;
+ break;
+
+ case '[': /* specification of direction */
+ /* For the moment, nested direction is not supported.
+ So, the value of `coding->direction' is 0 or 1: 0
+ means left-to-right, 1 means right-to-left. */
+ ONE_MORE_BYTE (c1);
+ switch (c1)
+ {
+ case ']': /* end of the current direction */
+ coding->direction = 0;
+
+ case '0': /* end of the current direction */
+ case '1': /* start of left-to-right direction */
+ ONE_MORE_BYTE (c1);
+ if (c1 == ']')
+ coding->direction = 0;
+ else
+ goto label_invalid_escape_sequence;
+ break;
+
+ case '2': /* start of right-to-left direction */
+ ONE_MORE_BYTE (c1);
+ if (c1 == ']')
+ coding->direction= 1;
+ else
+ goto label_invalid_escape_sequence;
+ break;
+
+ default:
+ goto label_invalid_escape_sequence;
+ }
+ break;
+
+ default:
+ if (c1 >= 0x28 && c1 <= 0x2B)
+ { /* designation of DIMENSION1_CHARS94 character set */
+ ONE_MORE_BYTE (c2);
+ DECODE_DESIGNATION (c1 - 0x28, 1, 94, c2);
+ }
+ else if (c1 >= 0x2C && c1 <= 0x2F)
+ { /* designation of DIMENSION1_CHARS96 character set */
+ ONE_MORE_BYTE (c2);
+ DECODE_DESIGNATION (c1 - 0x2C, 1, 96, c2);
+ }
+ else
+ {
+ goto label_invalid_escape_sequence;
+ }
+ }
+ /* We must update these variables now. */
+ charset0 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 0);
+ charset1 = CODING_SPEC_ISO_PLANE_CHARSET (coding, 1);
+ break;
+
+ label_invalid_escape_sequence:
+ {
+ int length = src - src_base;
+
+ bcopy (src_base, dst, length);
+ dst += length;
+ }
+ }
+ continue;
+
+ label_end_of_loop:
+ coding->carryover_size = src - src_base;
+ bcopy (src_base, coding->carryover, coding->carryover_size);
+ src = src_base;
+ break;
+ }
+
+ /* If this is the last block of the text to be decoded, we had
+ better just flush out all remaining codes in the text although
+ they are not valid characters. */
+ if (coding->last_block)
+ {
+ bcopy (src, dst, src_end - src);
+ dst += (src_end - src);
+ src = src_end;
+ }
+ *consumed = src - source;
+ return dst - destination;
+}
+
+/* ISO2022 encoding staffs. */
+
+/*
+ It is not enough to say just "ISO2022" on encoding, but we have to
+ specify more details. In Emacs, each coding-system of ISO2022
+ variant has the following specifications:
+ 1. Initial designation to G0 thru G3.
+ 2. Allows short-form designation?
+ 3. ASCII should be designated to G0 before control characters?
+ 4. ASCII should be designated to G0 at end of line?
+ 5. 7-bit environment or 8-bit environment?
+ 6. Use locking-shift?
+ 7. Use Single-shift?
+ And the following two are only for Japanese:
+ 8. Use ASCII in place of JIS0201-1976-Roman?
+ 9. Use JISX0208-1983 in place of JISX0208-1978?
+ These specifications are encoded in `coding->flags' as flag bits
+ defined by macros CODING_FLAG_ISO_XXX. See `coding.h' for more
+ detail.
+*/
+
+/* Produce codes (escape sequence) for designating CHARSET to graphic
+ register REG. If <final-char> of CHARSET is '@', 'A', or 'B' and
+ the coding system CODING allows, produce designation sequence of
+ short-form. */
+
+#define ENCODE_DESIGNATION(charset, reg, coding) \
+ do { \
+ unsigned char final_char = CHARSET_ISO_FINAL_CHAR (charset); \
+ char *intermediate_char_94 = "()*+"; \
+ char *intermediate_char_96 = ",-./"; \
+ Lisp_Object temp \
+ = Fassq (make_number (charset), Vcharset_revision_alist); \
+ if (! NILP (temp)) \
+ { \
+ *dst++ = ISO_CODE_ESC; \
+ *dst++ = '&'; \
+ *dst++ = XINT (XCONS (temp)->cdr) + '@'; \
+ } \
+ *dst++ = ISO_CODE_ESC; \
+ if (CHARSET_DIMENSION (charset) == 1) \
+ { \
+ if (CHARSET_CHARS (charset) == 94) \
+ *dst++ = (unsigned char) (intermediate_char_94[reg]); \
+ else \
+ *dst++ = (unsigned char) (intermediate_char_96[reg]); \
+ } \
+ else \
+ { \
+ *dst++ = '$'; \
+ if (CHARSET_CHARS (charset) == 94) \
+ { \
+ if (! (coding->flags & CODING_FLAG_ISO_SHORT_FORM) \
+ || reg != 0 \
+ || final_char < '@' || final_char > 'B') \
+ *dst++ = (unsigned char) (intermediate_char_94[reg]); \
+ } \
+ else \
+ *dst++ = (unsigned char) (intermediate_char_96[reg]); \
+ } \
+ *dst++ = final_char; \
+ CODING_SPEC_ISO_DESIGNATION (coding, reg) = charset; \
+ } while (0)
+
+/* The following two macros produce codes (control character or escape
+ sequence) for ISO2022 single-shift functions (single-shift-2 and
+ single-shift-3). */
+
+#define ENCODE_SINGLE_SHIFT_2 \
+ do { \
+ if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \
+ *dst++ = ISO_CODE_ESC, *dst++ = 'N'; \
+ else \
+ *dst++ = ISO_CODE_SS2; \
+ CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 1; \
+ } while (0)
+
+#define ENCODE_SINGLE_SHIFT_3 \
+ do { \
+ if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \
+ *dst++ = ISO_CODE_ESC, *dst++ = 'O'; \
+ else \
+ *dst++ = ISO_CODE_SS3; \
+ CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 1; \
+ } while (0)
+
+/* The following four macros produce codes (control character or
+ escape sequence) for ISO2022 locking-shift functions (shift-in,
+ shift-out, locking-shift-2, and locking-shift-3). */
+
+#define ENCODE_SHIFT_IN \
+ do { \
+ *dst++ = ISO_CODE_SI; \
+ CODING_SPEC_ISO_INVOCATION (coding, 0) = 0; \
+ } while (0)
+
+#define ENCODE_SHIFT_OUT \
+ do { \
+ *dst++ = ISO_CODE_SO; \
+ CODING_SPEC_ISO_INVOCATION (coding, 0) = 1; \
+ } while (0)
+
+#define ENCODE_LOCKING_SHIFT_2 \
+ do { \
+ *dst++ = ISO_CODE_ESC, *dst++ = 'n'; \
+ CODING_SPEC_ISO_INVOCATION (coding, 0) = 2; \
+ } while (0)
+
+#define ENCODE_LOCKING_SHIFT_3 \
+ do { \
+ *dst++ = ISO_CODE_ESC, *dst++ = 'o'; \
+ CODING_SPEC_ISO_INVOCATION (coding, 0) = 3; \
+ } while (0)
+
+/* Produce codes for a DIMENSION1 character of which character set is
+ CHARSET and position-code is C1. Designation and invocation
+ sequences are also produced in advance if necessary. */
+
+
+#define ENCODE_ISO_CHARACTER_DIMENSION1(charset, c1) \
+ do { \
+ if (CODING_SPEC_ISO_SINGLE_SHIFTING (coding)) \
+ { \
+ if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \
+ *dst++ = c1 & 0x7F; \
+ else \
+ *dst++ = c1 | 0x80; \
+ CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 0; \
+ break; \
+ } \
+ else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 0)) \
+ { \
+ *dst++ = c1 & 0x7F; \
+ break; \
+ } \
+ else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 1)) \
+ { \
+ *dst++ = c1 | 0x80; \
+ break; \
+ } \
+ else \
+ /* Since CHARSET is not yet invoked to any graphic planes, we \
+ must invoke it, or, at first, designate it to some graphic \
+ register. Then repeat the loop to actually produce the \
+ character. */ \
+ dst = encode_invocation_designation (charset, coding, dst); \
+ } while (1)
+
+/* Produce codes for a DIMENSION2 character of which character set is
+ CHARSET and position-codes are C1 and C2. Designation and
+ invocation codes are also produced in advance if necessary. */
+
+#define ENCODE_ISO_CHARACTER_DIMENSION2(charset, c1, c2) \
+ do { \
+ if (CODING_SPEC_ISO_SINGLE_SHIFTING (coding)) \
+ { \
+ if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS) \
+ *dst++ = c1 & 0x7F, *dst++ = c2 & 0x7F; \
+ else \
+ *dst++ = c1 | 0x80, *dst++ = c2 | 0x80; \
+ CODING_SPEC_ISO_SINGLE_SHIFTING (coding) = 0; \
+ break; \
+ } \
+ else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 0)) \
+ { \
+ *dst++ = c1 & 0x7F, *dst++= c2 & 0x7F; \
+ break; \
+ } \
+ else if (charset == CODING_SPEC_ISO_PLANE_CHARSET (coding, 1)) \
+ { \
+ *dst++ = c1 | 0x80, *dst++= c2 | 0x80; \
+ break; \
+ } \
+ else \
+ /* Since CHARSET is not yet invoked to any graphic planes, we \
+ must invoke it, or, at first, designate it to some graphic \
+ register. Then repeat the loop to actually produce the \
+ character. */ \
+ dst = encode_invocation_designation (charset, coding, dst); \
+ } while (1)
+
+/* Produce designation and invocation codes at a place pointed by DST
+ to use CHARSET. The element `spec.iso2022' of *CODING is updated.
+ Return new DST. */
+
+unsigned char *
+encode_invocation_designation (charset, coding, dst)
+ int charset;
+ struct coding_system *coding;
+ unsigned char *dst;
+{
+ int reg; /* graphic register number */
+
+ /* At first, check designations. */
+ for (reg = 0; reg < 4; reg++)
+ if (charset == CODING_SPEC_ISO_DESIGNATION (coding, reg))
+ break;
+
+ if (reg >= 4)
+ {
+ /* CHARSET is not yet designated to any graphic registers. */
+ /* At first check the requested designation. */
+ reg = CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset);
+ if (reg < 0)
+ /* Since CHARSET requests no special designation, designate to
+ graphic register 0. */
+ reg = 0;
+
+ ENCODE_DESIGNATION (charset, reg, coding);
+ }
+
+ if (CODING_SPEC_ISO_INVOCATION (coding, 0) != reg
+ && CODING_SPEC_ISO_INVOCATION (coding, 1) != reg)
+ {
+ /* Since the graphic register REG is not invoked to any graphic
+ planes, invoke it to graphic plane 0. */
+ switch (reg)
+ {
+ case 0: /* graphic register 0 */
+ ENCODE_SHIFT_IN;
+ break;
+
+ case 1: /* graphic register 1 */
+ ENCODE_SHIFT_OUT;
+ break;
+
+ case 2: /* graphic register 2 */
+ if (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT)
+ ENCODE_SINGLE_SHIFT_2;
+ else
+ ENCODE_LOCKING_SHIFT_2;
+ break;
+
+ case 3: /* graphic register 3 */
+ if (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT)
+ ENCODE_SINGLE_SHIFT_3;
+ else
+ ENCODE_LOCKING_SHIFT_3;
+ break;
+ }
+ }
+ return dst;
+}
+
+/* The following two macros produce codes for indicating composition. */
+#define ENCODE_COMPOSITION_NO_RULE_START *dst++ = ISO_CODE_ESC, *dst++ = '0'
+#define ENCODE_COMPOSITION_WITH_RULE_START *dst++ = ISO_CODE_ESC, *dst++ = '2'
+#define ENCODE_COMPOSITION_END *dst++ = ISO_CODE_ESC, *dst++ = '1'
+
+/* The following three macros produce codes for indicating direction
+ of text. */
+#define ENCODE_CONTROL_SEQUENCE_INTRODUCER \
+ do { \
+ if (coding->flags == CODING_FLAG_ISO_SEVEN_BITS) \
+ *dst++ = ISO_CODE_ESC, *dst++ = '['; \
+ else \
+ *dst++ = ISO_CODE_CSI; \
+ } while (0)
+
+#define ENCODE_DIRECTION_R2L \
+ ENCODE_CONTROL_SEQUENCE_INTRODUCER, *dst++ = '2', *dst++ = ']'
+
+#define ENCODE_DIRECTION_L2R \
+ ENCODE_CONTROL_SEQUENCE_INTRODUCER, *dst++ = '0', *dst++ = ']'
+
+/* Produce codes for designation and invocation to reset the graphic
+ planes and registers to initial state. */
+#define ENCODE_RESET_PLANE_AND_REGISTER(eol) \
+ do { \
+ int reg; \
+ if (CODING_SPEC_ISO_INVOCATION (coding, 0) != 0) \
+ ENCODE_SHIFT_IN; \
+ for (reg = 0; reg < 4; reg++) \
+ { \
+ if (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg) < 0) \
+ { \
+ if (eol) CODING_SPEC_ISO_DESIGNATION (coding, reg) = -1; \
+ } \
+ else if (CODING_SPEC_ISO_DESIGNATION (coding, reg) \
+ != CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg)) \
+ ENCODE_DESIGNATION \
+ (CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, reg), reg, coding); \
+ } \
+ } while (0)
+
+/* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions". */
+
+int
+encode_coding_iso2022 (coding, source, destination,
+ src_bytes, dst_bytes, consumed)
+ struct coding_system *coding;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+{
+ unsigned char *src = source;
+ unsigned char *src_end = source + src_bytes;
+ unsigned char *dst = destination;
+ unsigned char *dst_end = destination + dst_bytes;
+ /* Since the maximum bytes produced by each loop is 6, we subtract 5
+ from DST_END to assure overflow checking is necessary only at the
+ head of loop. */
+ unsigned char *adjusted_dst_end = dst_end - 5;
+
+ while (src < src_end && dst < adjusted_dst_end)
+ {
+ /* SRC_BASE remembers the start position in source in each loop.
+ The loop will be exited when there's not enough source text
+ to analyze multi-byte codes (within macros ONE_MORE_BYTE,
+ TWO_MORE_BYTES, and THREE_MORE_BYTES). In that case, SRC is
+ reset to SRC_BASE before exiting. */
+ unsigned char *src_base = src;
+ unsigned char c1 = *src++, c2, c3, c4;
+ int charset;
+
+ /* If we are seeing a component of a composite character, we are
+ seeing a leading-code specially encoded for composition, or a
+ composition rule if composing with rule. We must set C1
+ to a normal leading-code or an ASCII code. If we are not at
+ a composed character, we must reset the composition state. */
+ if (COMPOSING_P (coding->composing))
+ {
+ if (c1 < 0xA0)
+ {
+ /* We are not in a composite character any longer. */
+ coding->composing = COMPOSING_NO;
+ ENCODE_COMPOSITION_END;
+ }
+ else
+ {
+ if (coding->composing == COMPOSING_WITH_RULE_RULE)
+ {
+ *dst++ = c1 & 0x7F;
+ coding->composing = COMPOSING_WITH_RULE_HEAD;
+ continue;
+ }
+ else if (coding->composing == COMPOSING_WITH_RULE_HEAD)
+ coding->composing = COMPOSING_WITH_RULE_RULE;
+ if (c1 == 0xA0)
+ {
+ /* This is an ASCII component. */
+ ONE_MORE_BYTE (c1);
+ c1 &= 0x7F;
+ }
+ else
+ /* This is a leading-code of non ASCII component. */
+ c1 -= 0x20;
+ }
+ }
+
+ /* Now encode one character. C1 is a control character, an
+ ASCII character, or a leading-code of multi-byte character. */
+ switch (emacs_code_class[c1])
+ {
+ case EMACS_ascii_code:
+ ENCODE_ISO_CHARACTER_DIMENSION1 (CHARSET_ASCII, c1);
+ break;
+
+ case EMACS_control_code:
+ if (coding->flags & CODING_FLAG_ISO_RESET_AT_CNTL)
+ ENCODE_RESET_PLANE_AND_REGISTER (0);
+ *dst++ = c1;
+ break;
+
+ case EMACS_carriage_return_code:
+ if (!coding->selective)
+ {
+ if (coding->flags & CODING_FLAG_ISO_RESET_AT_CNTL)
+ ENCODE_RESET_PLANE_AND_REGISTER (0);
+ *dst++ = c1;
+ break;
+ }
+ /* fall down to treat '\r' as '\n' ... */
+
+ case EMACS_linefeed_code:
+ if (coding->flags & CODING_FLAG_ISO_RESET_AT_EOL)
+ ENCODE_RESET_PLANE_AND_REGISTER (1);
+ if (coding->eol_type == CODING_EOL_LF
+ || coding->eol_type == CODING_EOL_AUTOMATIC)
+ *dst++ = ISO_CODE_LF;
+ else if (coding->eol_type == CODING_EOL_CRLF)
+ *dst++ = ISO_CODE_CR, *dst++ = ISO_CODE_LF;
+ else
+ *dst++ = ISO_CODE_CR;
+ break;
+
+ case EMACS_leading_code_2:
+ ONE_MORE_BYTE (c2);
+ ENCODE_ISO_CHARACTER_DIMENSION1 (c1, c2);
+ break;
+
+ case EMACS_leading_code_3:
+ TWO_MORE_BYTES (c2, c3);
+ if (c1 < LEADING_CODE_PRIVATE_11)
+ ENCODE_ISO_CHARACTER_DIMENSION2 (c1, c2, c3);
+ else
+ ENCODE_ISO_CHARACTER_DIMENSION1 (c2, c3);
+ break;
+
+ case EMACS_leading_code_4:
+ THREE_MORE_BYTES (c2, c3, c4);
+ ENCODE_ISO_CHARACTER_DIMENSION2 (c2, c3, c4);
+ break;
+
+ case EMACS_leading_code_composition:
+ ONE_MORE_BYTE (c1);
+ if (c1 == 0xFF)
+ {
+ coding->composing = COMPOSING_WITH_RULE_HEAD;
+ ENCODE_COMPOSITION_WITH_RULE_START;
+ }
+ else
+ {
+ /* Rewind one byte because it is a character code of
+ composition elements. */
+ src--;
+ coding->composing = COMPOSING_NO_RULE_HEAD;
+ ENCODE_COMPOSITION_NO_RULE_START;
+ }
+ break;
+
+ case EMACS_invalid_code:
+ *dst++ = c1;
+ break;
+ }
+ continue;
+ label_end_of_loop:
+ coding->carryover_size = src - src_base;
+ bcopy (src_base, coding->carryover, coding->carryover_size);
+ src = src_base;
+ break;
+ }
+
+ /* If this is the last block of the text to be encoded, we must
+ reset the state of graphic planes and registers to initial one.
+ In addition, we had better just flush out all remaining codes in
+ the text although they are not valid characters. */
+ if (coding->last_block)
+ {
+ ENCODE_RESET_PLANE_AND_REGISTER (1);
+ bcopy(src, dst, src_end - src);
+ dst += (src_end - src);
+ src = src_end;
+ }
+ *consumed = src - source;
+ return dst - destination;
+}
+
+
+/*** 4. SJIS and BIG5 handlers ***/
+
+/* Although SJIS and BIG5 are not ISO's coding system, They are used
+ quite widely. So, for the moment, Emacs supports them in the bare
+ C code. But, in the future, they may be supported only by CCL. */
+
+/* SJIS is a coding system encoding three character sets: ASCII, right
+ half of JISX0201-Kana, and JISX0208. An ASCII character is encoded
+ as is. A character of charset katakana-jisx0201 is encoded by
+ "position-code + 0x80". A character of charset japanese-jisx0208
+ is encoded in 2-byte but two position-codes are divided and shifted
+ so that it fit in the range below.
+
+ --- CODE RANGE of SJIS ---
+ (character set) (range)
+ ASCII 0x00 .. 0x7F
+ KATAKANA-JISX0201 0xA0 .. 0xDF
+ JISX0208 (1st byte) 0x80 .. 0x9F and 0xE0 .. 0xFF
+ (2nd byte) 0x40 .. 0xFF
+ -------------------------------
+
+*/
+
+/* BIG5 is a coding system encoding two character sets: ASCII and
+ Big5. An ASCII character is encoded as is. Big5 is a two-byte
+ character set and is encoded in two-byte.
+
+ --- CODE RANGE of BIG5 ---
+ (character set) (range)
+ ASCII 0x00 .. 0x7F
+ Big5 (1st byte) 0xA1 .. 0xFE
+ (2nd byte) 0x40 .. 0x7E and 0xA1 .. 0xFE
+ --------------------------
+
+ Since the number of characters in Big5 is larger than maximum
+ characters in Emacs' charset (96x96), it can't be handled as one
+ charset. So, in Emacs, Big5 is divided into two: `charset-big5-1'
+ and `charset-big5-2'. Both are DIMENSION2 and CHARS94. The former
+ contains frequently used characters and the latter contains less
+ frequently used characters. */
+
+/* Macros to decode or encode a character of Big5 in BIG5. B1 and B2
+ are the 1st and 2nd position-codes of Big5 in BIG5 coding system.
+ C1 and C2 are the 1st and 2nd position-codes of of Emacs' internal
+ format. CHARSET is `charset_big5_1' or `charset_big5_2'. */
+
+/* Number of Big5 characters which have the same code in 1st byte. */
+#define BIG5_SAME_ROW (0xFF - 0xA1 + 0x7F - 0x40)
+
+#define DECODE_BIG5(b1, b2, charset, c1, c2) \
+ do { \
+ unsigned int temp \
+ = (b1 - 0xA1) * BIG5_SAME_ROW + b2 - (b2 < 0x7F ? 0x40 : 0x62); \
+ if (b1 < 0xC9) \
+ charset = charset_big5_1; \
+ else \
+ { \
+ charset = charset_big5_2; \
+ temp -= (0xC9 - 0xA1) * BIG5_SAME_ROW; \
+ } \
+ c1 = temp / (0xFF - 0xA1) + 0x21; \
+ c2 = temp % (0xFF - 0xA1) + 0x21; \
+ } while (0)
+
+#define ENCODE_BIG5(charset, c1, c2, b1, b2) \
+ do { \
+ unsigned int temp = (c1 - 0x21) * (0xFF - 0xA1) + (c2 - 0x21); \
+ if (charset == charset_big5_2) \
+ temp += BIG5_SAME_ROW * (0xC9 - 0xA1); \
+ b1 = temp / BIG5_SAME_ROW + 0xA1; \
+ b2 = temp % BIG5_SAME_ROW; \
+ b2 += b2 < 0x3F ? 0x40 : 0x62; \
+ } while (0)
+
+/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
+ Check if a text is encoded in SJIS. If it is, return
+ CODING_CATEGORY_MASK_SJIS, else return 0. */
+
+int
+detect_coding_sjis (src, src_end)
+ unsigned char *src, *src_end;
+{
+ unsigned char c;
+
+ while (src < src_end)
+ {
+ c = *src++;
+ if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
+ return 0;
+ if ((c >= 0x80 && c < 0xA0) || c >= 0xE0)
+ {
+ if (src < src_end && *src++ < 0x40)
+ return 0;
+ }
+ }
+ return CODING_CATEGORY_MASK_SJIS;
+}
+
+/* See the above "GENERAL NOTES on `detect_coding_XXX ()' functions".
+ Check if a text is encoded in BIG5. If it is, return
+ CODING_CATEGORY_MASK_BIG5, else return 0. */
+
+int
+detect_coding_big5 (src, src_end)
+ unsigned char *src, *src_end;
+{
+ unsigned char c;
+
+ while (src < src_end)
+ {
+ c = *src++;
+ if (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO)
+ return 0;
+ if (c >= 0xA1)
+ {
+ if (src >= src_end)
+ break;
+ c = *src++;
+ if (c < 0x40 || (c >= 0x7F && c <= 0xA0))
+ return 0;
+ }
+ }
+ return CODING_CATEGORY_MASK_BIG5;
+}
+
+/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions".
+ If SJIS_P is 1, decode SJIS text, else decode BIG5 test. */
+
+int
+decode_coding_sjis_big5 (coding, source, destination,
+ src_bytes, dst_bytes, consumed, sjis_p)
+ struct coding_system *coding;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+ int sjis_p;
+{
+ unsigned char *src = source;
+ unsigned char *src_end = source + src_bytes;
+ unsigned char *dst = destination;
+ unsigned char *dst_end = destination + dst_bytes;
+ /* Since the maximum bytes produced by each loop is 4, we subtract 3
+ from DST_END to assure overflow checking is necessary only at the
+ head of loop. */
+ unsigned char *adjusted_dst_end = dst_end - 3;
+
+ while (src < src_end && dst < adjusted_dst_end)
+ {
+ /* SRC_BASE remembers the start position in source in each loop.
+ The loop will be exited when there's not enough source text
+ to analyze two-byte character (within macro ONE_MORE_BYTE).
+ In that case, SRC is reset to SRC_BASE before exiting. */
+ unsigned char *src_base = src;
+ unsigned char c1 = *src++, c2, c3, c4;
+
+ if (c1 == '\r')
+ {
+ if (coding->eol_type == CODING_EOL_CRLF)
+ {
+ ONE_MORE_BYTE (c2);
+ if (c2 == '\n')
+ *dst++ = c2;
+ else
+ /* To process C2 again, SRC is subtracted by 1. */
+ *dst++ = c1, src--;
+ }
+ else
+ *dst++ = c1;
+ }
+ else if (c1 < 0x80)
+ *dst++ = c1;
+ else if (c1 < 0xA0 || c1 >= 0xE0)
+ {
+ /* SJIS -> JISX0208, BIG5 -> Big5 (only if 0xE0 <= c1 < 0xFF) */
+ if (sjis_p)
+ {
+ ONE_MORE_BYTE (c2);
+ DECODE_SJIS (c1, c2, c3, c4);
+ DECODE_CHARACTER_DIMENSION2 (charset_jisx0208, c3, c4);
+ }
+ else if (c1 >= 0xE0 && c1 < 0xFF)
+ {
+ int charset;
+
+ ONE_MORE_BYTE (c2);
+ DECODE_BIG5 (c1, c2, charset, c3, c4);
+ DECODE_CHARACTER_DIMENSION2 (charset, c3, c4);
+ }
+ else /* Invalid code */
+ *dst++ = c1;
+ }
+ else
+ {
+ /* SJIS -> JISX0201-Kana, BIG5 -> Big5 */
+ if (sjis_p)
+ DECODE_CHARACTER_DIMENSION1 (charset_katakana_jisx0201, c1);
+ else
+ {
+ int charset;
+
+ ONE_MORE_BYTE (c2);
+ DECODE_BIG5 (c1, c2, charset, c3, c4);
+ DECODE_CHARACTER_DIMENSION2 (charset, c3, c4);
+ }
+ }
+ continue;
+
+ label_end_of_loop:
+ coding->carryover_size = src - src_base;
+ bcopy (src_base, coding->carryover, coding->carryover_size);
+ src = src_base;
+ break;
+ }
+
+ *consumed = src - source;
+ return dst - destination;
+}
+
+/* See the above "GENERAL NOTES on `encode_coding_XXX ()' functions".
+ This function can encode `charset_ascii', `charset_katakana_jisx0201',
+ `charset_jisx0208', `charset_big5_1', and `charset_big5-2'. We are
+ sure that all these charsets are registered as official charset
+ (i.e. do not have extended leading-codes). Characters of other
+ charsets are produced without any encoding. If SJIS_P is 1, encode
+ SJIS text, else encode BIG5 text. */
+
+int
+encode_coding_sjis_big5 (coding, source, destination,
+ src_bytes, dst_bytes, consumed, sjis_p)
+ struct coding_system *coding;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+ int sjis_p;
+{
+ unsigned char *src = source;
+ unsigned char *src_end = source + src_bytes;
+ unsigned char *dst = destination;
+ unsigned char *dst_end = destination + dst_bytes;
+ /* Since the maximum bytes produced by each loop is 2, we subtract 1
+ from DST_END to assure overflow checking is necessary only at the
+ head of loop. */
+ unsigned char *adjusted_dst_end = dst_end - 1;
+
+ while (src < src_end && dst < adjusted_dst_end)
+ {
+ /* SRC_BASE remembers the start position in source in each loop.
+ The loop will be exited when there's not enough source text
+ to analyze multi-byte codes (within macros ONE_MORE_BYTE and
+ TWO_MORE_BYTES). In that case, SRC is reset to SRC_BASE
+ before exiting. */
+ unsigned char *src_base = src;
+ unsigned char c1 = *src++, c2, c3, c4;
+
+ if (coding->composing)
+ {
+ if (c1 == 0xA0)
+ {
+ ONE_MORE_BYTE (c1);
+ c1 &= 0x7F;
+ }
+ else if (c1 >= 0xA0)
+ c1 -= 0x20;
+ else
+ coding->composing = 0;
+ }
+
+ switch (emacs_code_class[c1])
+ {
+ case EMACS_ascii_code:
+ case EMACS_control_code:
+ *dst++ = c1;
+ break;
+
+ case EMACS_carriage_return_code:
+ if (!coding->selective)
+ {
+ *dst++ = c1;
+ break;
+ }
+ /* fall down to treat '\r' as '\n' ... */
+
+ case EMACS_linefeed_code:
+ if (coding->eol_type == CODING_EOL_LF
+ || coding->eol_type == CODING_EOL_AUTOMATIC)
+ *dst++ = '\n';
+ else if (coding->eol_type == CODING_EOL_CRLF)
+ *dst++ = '\r', *dst++ = '\n';
+ else
+ *dst++ = '\r';
+ break;
+
+ case EMACS_leading_code_2:
+ ONE_MORE_BYTE (c2);
+ if (sjis_p && c1 == charset_katakana_jisx0201)
+ *dst++ = c2;
+ else
+ *dst++ = c1, *dst++ = c2;
+ break;
+
+ case EMACS_leading_code_3:
+ TWO_MORE_BYTES (c2, c3);
+ c2 &= 0x7F, c3 &= 0x7F;
+ if (sjis_p && c1 == charset_jisx0208)
+ {
+ unsigned char s1, s2;
+
+ ENCODE_SJIS (c2, c3, s1, s2);
+ *dst++ = s1, *dst++ = s2;
+ }
+ else if (!sjis_p && (c1 == charset_big5_1 || c1 == charset_big5_2))
+ {
+ unsigned char b1, b2;
+
+ ENCODE_BIG5 (c1, c2, c3, b1, b2);
+ *dst++ = b1, *dst++ = b2;
+ }
+ else
+ *dst++ = c1, *dst++ = c2, *dst++ = c3;
+ break;
+
+ case EMACS_leading_code_4:
+ THREE_MORE_BYTES (c2, c3, c4);
+ *dst++ = c1, *dst++ = c2, *dst++ = c3, *dst++ = c4;
+ break;
+
+ case EMACS_leading_code_composition:
+ coding->composing = 1;
+ break;
+
+ default: /* i.e. case EMACS_invalid_code: */
+ *dst++ = c1;
+ }
+ continue;
+
+ label_end_of_loop:
+ coding->carryover_size = src - src_base;
+ bcopy (src_base, coding->carryover, coding->carryover_size);
+ src = src_base;
+ break;
+ }
+
+ *consumed = src - source;
+ return dst - destination;
+}
+
+
+/*** 5. End-of-line handlers ***/
+
+/* See the above "GENERAL NOTES on `decode_coding_XXX ()' functions".
+ This function is called only when `coding->eol_type' is
+ CODING_EOL_CRLF or CODING_EOL_CR. */
+
+decode_eol (coding, source, destination, src_bytes, dst_bytes, consumed)
+ struct coding_system *coding;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+{
+ unsigned char *src = source;
+ unsigned char *src_end = source + src_bytes;
+ unsigned char *dst = destination;
+ unsigned char *dst_end = destination + dst_bytes;
+ int produced;
+
+ switch (coding->eol_type)
+ {
+ case CODING_EOL_CRLF:
+ {
+ /* Since the maximum bytes produced by each loop is 2, we
+ subtract 1 from DST_END to assure overflow checking is
+ necessary only at the head of loop. */
+ unsigned char *adjusted_dst_end = dst_end - 1;
+
+ while (src < src_end && dst < adjusted_dst_end)
+ {
+ unsigned char *src_base = src;
+ unsigned char c = *src++;
+ if (c == '\r')
+ {
+ ONE_MORE_BYTE (c);
+ if (c != '\n')
+ *dst++ = '\r';
+
+ }
+ else
+ *dst++ = c;
+ continue;
+
+ label_end_of_loop:
+ coding->carryover_size = src - src_base;
+ bcopy (src_base, coding->carryover, coding->carryover_size);
+ src = src_base;
+ break;
+ }
+ *consumed = src - source;
+ produced = dst - destination;
+ break;
+ }
+
+ case CODING_EOL_CR:
+ produced = (src_bytes > dst_bytes) ? dst_bytes : src_bytes;
+ bcopy (source, destination, produced);
+ dst_end = destination + produced;
+ while (dst < dst_end)
+ if (*dst++ == '\r') dst[-1] = '\n';
+ *consumed = produced;
+ break;
+
+ default: /* i.e. case: CODING_EOL_LF */
+ produced = (src_bytes > dst_bytes) ? dst_bytes : src_bytes;
+ bcopy (source, destination, produced);
+ *consumed = produced;
+ break;
+ }
+
+ return produced;
+}
+
+/* See "GENERAL NOTES about `encode_coding_XXX ()' functions". Encode
+ format of end-of-line according to `coding->eol_type'. If
+ `coding->selective' is 1, code '\r' in source text also means
+ end-of-line. */
+
+encode_eol (coding, source, destination, src_bytes, dst_bytes, consumed)
+ struct coding_system *coding;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+{
+ unsigned char *src = source;
+ unsigned char *dst = destination;
+ int produced;
+
+ if (src_bytes <= 0)
+ return 0;
+
+ switch (coding->eol_type)
+ {
+ case CODING_EOL_LF:
+ case CODING_EOL_AUTOMATIC:
+ produced = (src_bytes > dst_bytes) ? dst_bytes : src_bytes;
+ bcopy (source, destination, produced);
+ if (coding->selective)
+ {
+ int i = produced;
+ while (i--)
+ if (*dst++ == '\r') dst[-1] = '\n';
+ }
+ *consumed = produced;
+
+ case CODING_EOL_CRLF:
+ {
+ unsigned char c;
+ unsigned char *src_end = source + src_bytes;
+ unsigned char *dst_end = destination + dst_bytes;
+ /* Since the maximum bytes produced by each loop is 2, we
+ subtract 1 from DST_END to assure overflow checking is
+ necessary only at the head of loop. */
+ unsigned char *adjusted_dst_end = dst_end - 1;
+
+ while (src < src_end && dst < adjusted_dst_end)
+ {
+ c = *src++;
+ if (c == '\n' || (c == '\r' && coding->selective))
+ *dst++ = '\r', *dst++ = '\n';
+ else
+ *dst++ = c;
+ }
+ produced = dst - destination;
+ *consumed = src - source;
+ break;
+ }
+
+ default: /* i.e. case CODING_EOL_CR: */
+ produced = (src_bytes > dst_bytes) ? dst_bytes : src_bytes;
+ bcopy (source, destination, produced);
+ {
+ int i = produced;
+ while (i--)
+ if (*dst++ == '\n') dst[-1] = '\r';
+ }
+ *consumed = produced;
+ }
+
+ return produced;
+}
+
+
+/*** 6. C library functions ***/
+
+/* In Emacs Lisp, coding system is represented by a Lisp symbol which
+ has a property `coding-system'. The value of this property is a
+ vector of length 5 (called as coding-vector). Among elements of
+ this vector, the first (element[0]) and the fifth (element[4])
+ carry important information for decoding/encoding. Before
+ decoding/encoding, this information should be set in fields of a
+ structure of type `coding_system'.
+
+ A value of property `coding-system' can be a symbol of another
+ subsidiary coding-system. In that case, Emacs gets coding-vector
+ from that symbol.
+
+ `element[0]' contains information to be set in `coding->type'. The
+ value and its meaning is as follows:
+
+ 0 -- coding_system_internal
+ 1 -- coding_system_sjis
+ 2 -- coding_system_iso2022
+ 3 -- coding_system_big5
+ 4 -- coding_system_ccl
+ nil -- coding_system_no_conversion
+ t -- coding_system_automatic
+
+ `element[4]' contains information to be set in `coding->flags' and
+ `coding->spec'. The meaning varies by `coding->type'.
+
+ If `coding->type' is `coding_type_iso2022', element[4] is a vector
+ of length 32 (of which the first 13 sub-elements are used now).
+ Meanings of these sub-elements are:
+
+ sub-element[N] where N is 0 through 3: to be set in `coding->spec.iso2022'
+ If the value is an integer of valid charset, the charset is
+ assumed to be designated to graphic register N initially.
+
+ If the value is minus, it is a minus value of charset which
+ reserves graphic register N, which means that the charset is
+ not designated initially but should be designated to graphic
+ register N just before encoding a character in that charset.
+
+ If the value is nil, graphic register N is never used on
+ encoding.
+
+ sub-element[N] where N is 4 through 11: to be set in `coding->flags'
+ Each value takes t or nil. See the section ISO2022 of
+ `coding.h' for more information.
+
+ If `coding->type' is `coding_type_big5', element[4] is t to denote
+ BIG5-ETen or nil to denote BIG5-HKU.
+
+ If `coding->type' takes the other value, element[4] is ignored.
+
+ Emacs Lisp's coding system also carries information about format of
+ end-of-line in a value of property `eol-type'. If the value is
+ integer, 0 means CODING_EOL_LF, 1 means CODING_EOL_CRLF, and 2
+ means CODING_EOL_CR. If it is not integer, it should be a vector
+ of subsidiary coding systems of which property `eol-type' has one
+ of above values.
+
+*/
+
+/* Extract information for decoding/encoding from CODING_SYSTEM_SYMBOL
+ and set it in CODING. If CODING_SYSTEM_SYMBOL is invalid, CODING
+ is setup so that no conversion is necessary and return -1, else
+ return 0. */
+
+int
+setup_coding_system (coding_system_symbol, coding)
+ Lisp_Object coding_system_symbol;
+ struct coding_system *coding;
+{
+ Lisp_Object coding_system_vector = Qnil;
+ Lisp_Object type, eol_type;
+
+ /* At first, set several fields default values. */
+ coding->require_flushing = 0;
+ coding->last_block = 0;
+ coding->selective = 0;
+ coding->composing = 0;
+ coding->direction = 0;
+ coding->carryover_size = 0;
+ coding->symbol = Qnil;
+ coding->post_read_conversion = coding->pre_write_conversion = Qnil;
+
+ /* Get value of property `coding-system'. If it is a Lisp symbol
+ pointing another coding system, fetch its property until we get a
+ vector. */
+ while (!NILP (coding_system_symbol))
+ {
+ coding->symbol = coding_system_symbol;
+ if (NILP (coding->post_read_conversion))
+ coding->post_read_conversion = Fget (coding_system_symbol,
+ Qpost_read_conversion);
+ if (NILP (coding->pre_write_conversion))
+ coding->pre_write_conversion = Fget (coding_system_symbol,
+ Qpre_write_conversion);
+
+ coding_system_vector = Fget (coding_system_symbol, Qcoding_system);
+ if (VECTORP (coding_system_vector))
+ break;
+ coding_system_symbol = coding_system_vector;
+ }
+ Vlast_coding_system_used = coding->symbol;
+
+ if (!VECTORP (coding_system_vector)
+ || XVECTOR (coding_system_vector)->size != 5)
+ goto label_invalid_coding_system;
+
+ /* Get value of property `eol-type' by searching from the root
+ coding-system. */
+ coding_system_symbol = coding->symbol;
+ eol_type = Qnil;
+ while (SYMBOLP (coding_system_symbol) && !NILP (coding_system_symbol))
+ {
+ eol_type = Fget (coding_system_symbol, Qeol_type);
+ if (!NILP (eol_type))
+ break;
+ coding_system_symbol = Fget (coding_system_symbol, Qcoding_system);
+ }
+
+ if (VECTORP (eol_type))
+ coding->eol_type = CODING_EOL_AUTOMATIC;
+ else if (XFASTINT (eol_type) == 1)
+ coding->eol_type = CODING_EOL_CRLF;
+ else if (XFASTINT (eol_type) == 2)
+ coding->eol_type = CODING_EOL_CR;
+ else
+ coding->eol_type = CODING_EOL_LF;
+
+ type = XVECTOR (coding_system_vector)->contents[0];
+ switch (XFASTINT (type))
+ {
+ case 0:
+ coding->type = coding_type_internal;
+ break;
+
+ case 1:
+ coding->type = coding_type_sjis;
+ break;
+
+ case 2:
+ coding->type = coding_type_iso2022;
+ {
+ Lisp_Object val = XVECTOR (coding_system_vector)->contents[4];
+ Lisp_Object *flags;
+ int i, charset, default_reg_bits = 0;
+
+ if (!VECTORP (val) || XVECTOR (val)->size != 32)
+ goto label_invalid_coding_system;
+
+ flags = XVECTOR (val)->contents;
+ coding->flags
+ = ((NILP (flags[4]) ? 0 : CODING_FLAG_ISO_SHORT_FORM)
+ | (NILP (flags[5]) ? 0 : CODING_FLAG_ISO_RESET_AT_EOL)
+ | (NILP (flags[6]) ? 0 : CODING_FLAG_ISO_RESET_AT_CNTL)
+ | (NILP (flags[7]) ? 0 : CODING_FLAG_ISO_SEVEN_BITS)
+ | (NILP (flags[8]) ? 0 : CODING_FLAG_ISO_LOCKING_SHIFT)
+ | (NILP (flags[9]) ? 0 : CODING_FLAG_ISO_SINGLE_SHIFT)
+ | (NILP (flags[10]) ? 0 : CODING_FLAG_ISO_USE_ROMAN)
+ | (NILP (flags[11]) ? 0 : CODING_FLAG_ISO_USE_OLDJIS)
+ | (NILP (flags[12]) ? 0 : CODING_FLAG_ISO_NO_DIRECTION));
+
+ /* Invoke graphic register 0 to plane 0. */
+ CODING_SPEC_ISO_INVOCATION (coding, 0) = 0;
+ /* Invoke graphic register 1 to plane 1 if we can use full 8-bit. */
+ CODING_SPEC_ISO_INVOCATION (coding, 1)
+ = (coding->flags & CODING_FLAG_ISO_SEVEN_BITS ? -1 : 1);
+ /* Not single shifting at first. */
+ CODING_SPEC_ISO_SINGLE_SHIFTING(coding) = 0;
+
+ /* Checks FLAGS[REG] (REG = 0, 1, 2 3) and decide designations.
+ FLAGS[REG] can be one of below:
+ integer CHARSET: CHARSET occupies register I,
+ t: designate nothing to REG initially, but can be used
+ by any charsets,
+ list of integer, nil, or t: designate the first
+ element (if integer) to REG initially, the remaining
+ elements (if integer) is designated to REG on request,
+ if an element is t, REG can be used by any charset,
+ nil: REG is never used. */
+ for (charset = 0; charset < MAX_CHARSET; charset++)
+ CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) = -1;
+ for (i = 0; i < 4; i++)
+ {
+ if (INTEGERP (flags[i])
+ && (charset = XINT (flags[i]), CHARSET_VALID_P (charset)))
+ {
+ CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = charset;
+ CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) = i;
+ }
+ else if (EQ (flags[i], Qt))
+ {
+ CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = -1;
+ default_reg_bits |= 1 << i;
+ }
+ else if (CONSP (flags[i]))
+ {
+ Lisp_Object tail = flags[i];
+
+ if (INTEGERP (XCONS (tail)->car)
+ && (charset = XINT (XCONS (tail)->car),
+ CHARSET_VALID_P (charset)))
+ {
+ CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = charset;
+ CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) =i;
+ }
+ else
+ CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = -1;
+ tail = XCONS (tail)->cdr;
+ while (CONSP (tail))
+ {
+ if (INTEGERP (XCONS (tail)->car)
+ && (charset = XINT (XCONS (tail)->car),
+ CHARSET_VALID_P (charset)))
+ CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset)
+ = i;
+ else if (EQ (XCONS (tail)->car, Qt))
+ default_reg_bits |= 1 << i;
+ tail = XCONS (tail)->cdr;
+ }
+ }
+ else
+ CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i) = -1;
+
+ CODING_SPEC_ISO_DESIGNATION (coding, i)
+ = CODING_SPEC_ISO_INITIAL_DESIGNATION (coding, i);
+ }
+
+ if (! (coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT))
+ {
+ /* REG 1 can be used only by locking shift in 7-bit env. */
+ if (coding->flags & CODING_FLAG_ISO_SEVEN_BITS)
+ default_reg_bits &= ~2;
+ if (! (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT))
+ /* Without any shifting, only REG 0 and 1 can be used. */
+ default_reg_bits &= 3;
+ }
+
+ for (charset = 0; charset < MAX_CHARSET; charset++)
+ if (CHARSET_VALID_P (charset)
+ && CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset) < 0)
+ {
+ /* We have not yet decided where to designate CHARSET. */
+ int reg_bits = default_reg_bits;
+
+ if (CHARSET_CHARS (charset) == 96)
+ /* A charset of CHARS96 can't be designated to REG 0. */
+ reg_bits &= ~1;
+
+ if (reg_bits)
+ /* There exist some default graphic register. */
+ CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset)
+ = (reg_bits & 1
+ ? 0 : (reg_bits & 2 ? 1 : (reg_bits & 4 ? 2 : 3)));
+ else
+ /* We anyway have to designate CHARSET to somewhere. */
+ CODING_SPEC_ISO_REQUESTED_DESIGNATION (coding, charset)
+ = (CHARSET_CHARS (charset) == 94
+ ? 0
+ : ((coding->flags & CODING_FLAG_ISO_LOCKING_SHIFT
+ || ! coding->flags & CODING_FLAG_ISO_SEVEN_BITS)
+ ? 1
+ : (coding->flags & CODING_FLAG_ISO_SINGLE_SHIFT
+ ? 2 : 0)));
+ }
+ }
+ coding->require_flushing = 1;
+ break;
+
+ case 3:
+ coding->type = coding_type_big5;
+ coding->flags
+ = (NILP (XVECTOR (coding_system_vector)->contents[4])
+ ? CODING_FLAG_BIG5_HKU
+ : CODING_FLAG_BIG5_ETEN);
+ break;
+
+ case 4:
+ coding->type = coding_type_ccl;
+ {
+ Lisp_Object val = XVECTOR (coding_system_vector)->contents[4];
+ if (CONSP (val)
+ && VECTORP (XCONS (val)->car)
+ && VECTORP (XCONS (val)->cdr))
+ {
+ setup_ccl_program (&(coding->spec.ccl.decoder), XCONS (val)->car);
+ setup_ccl_program (&(coding->spec.ccl.encoder), XCONS (val)->cdr);
+ }
+ else
+ goto label_invalid_coding_system;
+ }
+ coding->require_flushing = 1;
+ break;
+
+ default:
+ if (EQ (type, Qt))
+ coding->type = coding_type_automatic;
+ else
+ coding->type = coding_type_no_conversion;
+ break;
+ }
+ return 0;
+
+ label_invalid_coding_system:
+ coding->type = coding_type_no_conversion;
+ return -1;
+}
+
+/* Emacs has a mechanism to automatically detect a coding system if it
+ is one of Emacs' internal format, ISO2022, SJIS, and BIG5. But,
+ it's impossible to distinguish some coding systems accurately
+ because they use the same range of codes. So, at first, coding
+ systems are categorized into 7, those are:
+
+ o coding-category-internal
+
+ The category for a coding system which has the same code range
+ as Emacs' internal format. Assigned the coding-system (Lisp
+ symbol) `coding-system-internal' by default.
+
+ o coding-category-sjis
+
+ The category for a coding system which has the same code range
+ as SJIS. Assigned the coding-system (Lisp
+ symbol) `coding-system-sjis' by default.
+
+ o coding-category-iso-7
+
+ The category for a coding system which has the same code range
+ as ISO2022 of 7-bit environment. Assigned the coding-system
+ (Lisp symbol) `coding-system-junet' by default.
+
+ o coding-category-iso-8-1
+
+ The category for a coding system which has the same code range
+ as ISO2022 of 8-bit environment and graphic plane 1 used only
+ for DIMENSION1 charset. Assigned the coding-system (Lisp
+ symbol) `coding-system-ctext' by default.
+
+ o coding-category-iso-8-2
+
+ The category for a coding system which has the same code range
+ as ISO2022 of 8-bit environment and graphic plane 1 used only
+ for DIMENSION2 charset. Assigned the coding-system (Lisp
+ symbol) `coding-system-euc-japan' by default.
+
+ o coding-category-iso-else
+
+ The category for a coding system which has the same code range
+ as ISO2022 but not belongs to any of the above three
+ categories. Assigned the coding-system (Lisp symbol)
+ `coding-system-iso-2022-ss2-7' by default.
+
+ o coding-category-big5
+
+ The category for a coding system which has the same code range
+ as BIG5. Assigned the coding-system (Lisp symbol)
+ `coding-system-big5' by default.
+
+ o coding-category-binary
+
+ The category for a coding system not categorized in any of the
+ above. Assigned the coding-system (Lisp symbol)
+ `coding-system-noconv' by default.
+
+ Each of them is a Lisp symbol and the value is an actual
+ `coding-system's (this is also a Lisp symbol) assigned by a user.
+ What Emacs does actually is to detect a category of coding system.
+ Then, it uses a `coding-system' assigned to it. If Emacs can't
+ decide only one possible category, it selects a category of the
+ highest priority. Priorities of categories are also specified by a
+ user in a Lisp variable `coding-category-list'.
+
+*/
+
+/* Detect how a text of length SRC_BYTES pointed by SRC is encoded.
+ If it detects possible coding systems, return an integer in which
+ appropriate flag bits are set. Flag bits are defined by macros
+ CODING_CATEGORY_MASK_XXX in `coding.h'. */
+
+int
+detect_coding_mask (src, src_bytes)
+ unsigned char *src;
+ int src_bytes;
+{
+ register unsigned char c;
+ unsigned char *src_end = src + src_bytes;
+ int mask;
+
+ /* At first, skip all ASCII characters and control characters except
+ for three ISO2022 specific control characters. */
+ while (src < src_end)
+ {
+ c = *src;
+ if (c >= 0x80
+ || (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO))
+ break;
+ src++;
+ }
+
+ if (src >= src_end)
+ /* We found nothing other than ASCII. There's nothing to do. */
+ return CODING_CATEGORY_MASK_ANY;
+
+ /* The text seems to be encoded in some multilingual coding system.
+ Now, try to find in which coding system the text is encoded. */
+ if (c < 0x80)
+ /* i.e. (c == ISO_CODE_ESC || c == ISO_CODE_SI || c == ISO_CODE_SO) */
+ /* C is an ISO2022 specific control code of C0. */
+ mask = detect_coding_iso2022 (src, src_end);
+
+ else if (c == ISO_CODE_SS2 || c == ISO_CODE_SS3 || c == ISO_CODE_CSI)
+ /* C is an ISO2022 specific control code of C1,
+ or the first byte of SJIS's 2-byte character code,
+ or a leading code of Emacs. */
+ mask = (detect_coding_iso2022 (src, src_end)
+ | detect_coding_sjis (src, src_end)
+ | detect_coding_internal (src, src_end));
+
+ else if (c < 0xA0)
+ /* C is the first byte of SJIS character code,
+ or a leading-code of Emacs. */
+ mask = (detect_coding_sjis (src, src_end)
+ | detect_coding_internal (src, src_end));
+
+ else
+ /* C is a character of ISO2022 in graphic plane right,
+ or a SJIS's 1-byte character code (i.e. JISX0201),
+ or the first byte of BIG5's 2-byte code. */
+ mask = (detect_coding_iso2022 (src, src_end)
+ | detect_coding_sjis (src, src_end)
+ | detect_coding_big5 (src, src_end));
+
+ return mask;
+}
+
+/* Detect how a text of length SRC_BYTES pointed by SRC is encoded.
+ The information of the detected coding system is set in CODING. */
+
+void
+detect_coding (coding, src, src_bytes)
+ struct coding_system *coding;
+ unsigned char *src;
+ int src_bytes;
+{
+ int mask = detect_coding_mask (src, src_bytes);
+ int idx;
+
+ if (mask == CODING_CATEGORY_MASK_ANY)
+ /* We found nothing other than ASCII. There's nothing to do. */
+ return;
+
+ if (!mask)
+ /* The source text seems to be encoded in unknown coding system.
+ Emacs regards the category of such a kind of coding system as
+ `coding-category-binary'. We assume that a user has assigned
+ an appropriate coding system for a `coding-category-binary'. */
+ idx = CODING_CATEGORY_IDX_BINARY;
+ else
+ {
+ /* We found some plausible coding systems. Let's use a coding
+ system of the highest priority. */
+ Lisp_Object val = Vcoding_category_list;
+
+ if (CONSP (val))
+ while (!NILP (val))
+ {
+ idx = XFASTINT (Fget (XCONS (val)->car, Qcoding_category_index));
+ if ((idx < CODING_CATEGORY_IDX_MAX) && (mask & (1 << idx)))
+ break;
+ val = XCONS (val)->cdr;
+ }
+ else
+ val = Qnil;
+
+ if (NILP (val))
+ {
+ /* For unknown reason, `Vcoding_category_list' contains none
+ of found categories. Let's use any of them. */
+ for (idx = 0; idx < CODING_CATEGORY_IDX_MAX; idx++)
+ if (mask & (1 << idx))
+ break;
+ }
+ }
+ setup_coding_system (XSYMBOL (coding_category_table[idx])->value, coding);
+}
+
+/* Detect how end-of-line of a text of length SRC_BYTES pointed by SRC
+ is encoded. Return one of CODING_EOL_LF, CODING_EOL_CRLF,
+ CODING_EOL_CR, and CODING_EOL_AUTOMATIC. */
+
+int
+detect_eol_type (src, src_bytes)
+ unsigned char *src;
+ int src_bytes;
+{
+ unsigned char *src_end = src + src_bytes;
+ unsigned char c;
+
+ while (src < src_end)
+ {
+ c = *src++;
+ if (c == '\n')
+ return CODING_EOL_LF;
+ else if (c == '\r')
+ {
+ if (src < src_end && *src == '\n')
+ return CODING_EOL_CRLF;
+ else
+ return CODING_EOL_CR;
+ }
+ }
+ return CODING_EOL_AUTOMATIC;
+}
+
+/* Detect how end-of-line of a text of length SRC_BYTES pointed by SRC
+ is encoded. If it detects an appropriate format of end-of-line, it
+ sets the information in *CODING. */
+
+void
+detect_eol (coding, src, src_bytes)
+ struct coding_system *coding;
+ unsigned char *src;
+ int src_bytes;
+{
+ Lisp_Object val;
+ int eol_type = detect_eol_type (src, src_bytes);
+
+ if (eol_type == CODING_EOL_AUTOMATIC)
+ /* We found no end-of-line in the source text. */
+ return;
+
+ val = Fget (coding->symbol, Qeol_type);
+ if (VECTORP (val) && XVECTOR (val)->size == 3)
+ setup_coding_system (XVECTOR (val)->contents[eol_type], coding);
+}
+
+/* See "GENERAL NOTES about `decode_coding_XXX ()' functions". Before
+ decoding, it may detect coding system and format of end-of-line if
+ those are not yet decided. */
+
+int
+decode_coding (coding, source, destination, src_bytes, dst_bytes, consumed)
+ struct coding_system *coding;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+{
+ int produced;
+
+ if (src_bytes <= 0)
+ {
+ *consumed = 0;
+ return 0;
+ }
+
+ if (coding->type == coding_type_automatic)
+ detect_coding (coding, source, src_bytes);
+
+ if (coding->eol_type == CODING_EOL_AUTOMATIC)
+ detect_eol (coding, source, src_bytes);
+
+ coding->carryover_size = 0;
+ switch (coding->type)
+ {
+ case coding_type_no_conversion:
+ label_no_conversion:
+ produced = (src_bytes > dst_bytes) ? dst_bytes : src_bytes;
+ bcopy (source, destination, produced);
+ *consumed = produced;
+ break;
+
+ case coding_type_internal:
+ case coding_type_automatic:
+ if (coding->eol_type == CODING_EOL_LF
+ || coding->eol_type == CODING_EOL_AUTOMATIC)
+ goto label_no_conversion;
+ produced = decode_eol (coding, source, destination,
+ src_bytes, dst_bytes, consumed);
+ break;
+
+ case coding_type_sjis:
+ produced = decode_coding_sjis_big5 (coding, source, destination,
+ src_bytes, dst_bytes, consumed,
+ 1);
+ break;
+
+ case coding_type_iso2022:
+ produced = decode_coding_iso2022 (coding, source, destination,
+ src_bytes, dst_bytes, consumed);
+ break;
+
+ case coding_type_big5:
+ produced = decode_coding_sjis_big5 (coding, source, destination,
+ src_bytes, dst_bytes, consumed,
+ 0);
+ break;
+
+ case coding_type_ccl:
+ produced = ccl_driver (&coding->spec.ccl.decoder, source, destination,
+ src_bytes, dst_bytes, consumed);
+ break;
+ }
+
+ return produced;
+}
+
+/* See "GENERAL NOTES about `encode_coding_XXX ()' functions". */
+
+int
+encode_coding (coding, source, destination, src_bytes, dst_bytes, consumed)
+ struct coding_system *coding;
+ unsigned char *source, *destination;
+ int src_bytes, dst_bytes;
+ int *consumed;
+{
+ int produced;
+
+ coding->carryover_size = 0;
+ switch (coding->type)
+ {
+ case coding_type_no_conversion:
+ label_no_conversion:
+ produced = (src_bytes > dst_bytes) ? dst_bytes : src_bytes;
+ if (produced > 0)
+ {
+ bcopy (source, destination, produced);
+ if (coding->selective)
+ {
+ unsigned char *p = destination, *pend = destination + produced;
+ while (p < pend)
+ if (*p++ = '\015') p[-1] = '\n';
+ }
+ }
+ *consumed = produced;
+ break;
+
+ case coding_type_internal:
+ case coding_type_automatic:
+ if (coding->eol_type == CODING_EOL_LF
+ || coding->eol_type == CODING_EOL_AUTOMATIC)
+ goto label_no_conversion;
+ produced = encode_eol (coding, source, destination,
+ src_bytes, dst_bytes, consumed);
+ break;
+
+ case coding_type_sjis:
+ produced = encode_coding_sjis_big5 (coding, source, destination,
+ src_bytes, dst_bytes, consumed,
+ 1);
+ break;
+
+ case coding_type_iso2022:
+ produced = encode_coding_iso2022 (coding, source, destination,
+ src_bytes, dst_bytes, consumed);
+ break;
+
+ case coding_type_big5:
+ produced = encode_coding_sjis_big5 (coding, source, destination,
+ src_bytes, dst_bytes, consumed,
+ 0);
+ break;
+
+ case coding_type_ccl:
+ produced = ccl_driver (&coding->spec.ccl.encoder, source, destination,
+ src_bytes, dst_bytes, consumed);
+ break;
+ }
+
+ return produced;
+}
+
+#define CONVERSION_BUFFER_EXTRA_ROOM 256
+
+/* Return maximum size (bytes) of a buffer enough for decoding
+ SRC_BYTES of text encoded in CODING. */
+
+int
+decoding_buffer_size (coding, src_bytes)
+ struct coding_system *coding;
+ int src_bytes;
+{
+ int magnification;
+
+ if (coding->type == coding_type_iso2022)
+ magnification = 3;
+ else if (coding->type == coding_type_ccl)
+ magnification = coding->spec.ccl.decoder.buf_magnification;
+ else
+ magnification = 2;
+
+ return (src_bytes * magnification + CONVERSION_BUFFER_EXTRA_ROOM);
+}
+
+/* Return maximum size (bytes) of a buffer enough for encoding
+ SRC_BYTES of text to CODING. */
+
+int
+encoding_buffer_size (coding, src_bytes)
+ struct coding_system *coding;
+ int src_bytes;
+{
+ int magnification;
+
+ if (coding->type == coding_type_ccl)
+ magnification = coding->spec.ccl.encoder.buf_magnification;
+ else
+ magnification = 3;
+
+ return (src_bytes * magnification + CONVERSION_BUFFER_EXTRA_ROOM);
+}
+
+#ifndef MINIMUM_CONVERSION_BUFFER_SIZE
+#define MINIMUM_CONVERSION_BUFFER_SIZE 1024
+#endif
+
+char *conversion_buffer;
+int conversion_buffer_size;
+
+/* Return a pointer to a SIZE bytes of buffer to be used for encoding
+ or decoding. Sufficient memory is allocated automatically. If we
+ run out of memory, return NULL. */
+
+char *
+get_conversion_buffer (size)
+ int size;
+{
+ if (size > conversion_buffer_size)
+ {
+ char *buf;
+ int real_size = conversion_buffer_size * 2;
+
+ while (real_size < size) real_size *= 2;
+ buf = (char *) xmalloc (real_size);
+ xfree (conversion_buffer);
+ conversion_buffer = buf;
+ conversion_buffer_size = real_size;
+ }
+ return conversion_buffer;
+}
+
+
+#ifdef emacs
+/*** 7. Emacs Lisp library functions ***/
+
+DEFUN ("coding-system-vector", Fcoding_system_vector, Scoding_system_vector,
+ 1, 1, 0,
+ "Return coding-vector of CODING-SYSTEM.\n\
+If CODING-SYSTEM is not a valid coding-system, return nil.")
+ (obj)
+ Lisp_Object obj;
+{
+ while (SYMBOLP (obj) && !NILP (obj))
+ obj = Fget (obj, Qcoding_system);
+ return ((NILP (obj) || !VECTORP (obj) || XVECTOR (obj)->size != 5)
+ ? Qnil : obj);
+}
+
+DEFUN ("coding-system-p", Fcoding_system_p, Scoding_system_p, 1, 1, 0,
+ "Return t if OBJECT is nil or a coding-system.\n\
+See document of make-coding-system for coding-system object.")
+ (obj)
+ Lisp_Object obj;
+{
+ return ((NILP (obj) || !NILP (Fcoding_system_vector (obj))) ? Qt : Qnil);
+}
+
+DEFUN ("read-non-nil-coding-system",
+ Fread_non_nil_coding_system, Sread_non_nil_coding_system, 1, 1, 0,
+ "Read a coding-system from the minibuffer, prompting with string PROMPT.")
+ (prompt)
+ Lisp_Object prompt;
+{
+ return Fintern (Fcompleting_read (prompt, Vobarray, Qcoding_system_vector,
+ Qt, Qnil, Qnil),
+ Qnil);
+}
+
+DEFUN ("read-coding-system", Fread_coding_system, Sread_coding_system, 1, 1, 0,
+ "Read a coding-system or nil from the minibuffer, prompting with string PROMPT.")
+ (prompt)
+ Lisp_Object prompt;
+{
+ return Fintern (Fcompleting_read (prompt, Vobarray, Qcoding_system_p,
+ Qt, Qnil, Qnil),
+ Qnil);
+}
+
+DEFUN ("check-coding-system", Fcheck_coding_system, Scheck_coding_system,
+ 1, 1, 0,
+ "Check validity of CODING-SYSTEM.\n\
+If valid, return CODING-SYSTEM, else `coding-system-error' is signaled.\n\
+CODING-SYSTEM is valid if it is a symbol and has \"coding-system\" property.\n\
+The value of property should be a vector of length 5.")
+ (coding_system)
+ Lisp_Object coding_system;
+{
+ CHECK_SYMBOL (coding_system, 0);
+ if (!NILP (Fcoding_system_p (coding_system)))
+ return coding_system;
+ while (1)
+ Fsignal (Qcoding_system_error, coding_system);
+}
+
+DEFUN ("detect-coding-region", Fdetect_coding_region, Sdetect_coding_region,
+ 2, 2, 0,
+ "Detect coding-system of the text in the region between START and END.\n\
+Return a list of possible coding-systems ordered by priority.\n\
+If only ASCII characters are found, it returns `coding-system-automatic'\n\
+ or its subsidiary coding-system according to a detected end-of-line format.")
+ (b, e)
+ Lisp_Object b, e;
+{
+ int coding_mask, eol_type;
+ Lisp_Object val;
+ int beg, end;
+
+ validate_region (&b, &e);
+ beg = XINT (b), end = XINT (e);
+ if (beg < GPT && end >= GPT) move_gap (end);
+
+ coding_mask = detect_coding_mask (POS_ADDR (beg), end - beg);
+ eol_type = detect_eol_type (POS_ADDR (beg), end - beg);
+
+ if (coding_mask == CODING_CATEGORY_MASK_ANY)
+ {
+ val = intern ("coding-system-automatic");
+ if (eol_type != CODING_EOL_AUTOMATIC)
+ {
+ Lisp_Object val2 = Fget (val, Qeol_type);
+ if (VECTORP (val2))
+ val = XVECTOR (val2)->contents[eol_type];
+ }
+ }
+ else
+ {
+ Lisp_Object val2;
+
+ /* At first, gather possible coding-systems in VAL in a reverse
+ order. */
+ val = Qnil;
+ for (val2 = Vcoding_category_list;
+ !NILP (val2);
+ val2 = XCONS (val2)->cdr)
+ {
+ int idx
+ = XFASTINT (Fget (XCONS (val2)->car, Qcoding_category_index));
+ if (coding_mask & (1 << idx))
+ val = Fcons (Fsymbol_value (XCONS (val2)->car), val);
+ }
+
+ /* Then, change the order of the list, while getting subsidiary
+ coding-systems. */
+ val2 = val;
+ val = Qnil;
+ for (; !NILP (val2); val2 = XCONS (val2)->cdr)
+ {
+ if (eol_type == CODING_EOL_AUTOMATIC)
+ val = Fcons (XCONS (val2)->car, val);
+ else
+ {
+ Lisp_Object val3 = Fget (XCONS (val2)->car, Qeol_type);
+ if (VECTORP (val3))
+ val = Fcons (XVECTOR (val3)->contents[eol_type], val);
+ else
+ val = Fcons (XCONS (val2)->car, val);
+ }
+ }
+ }
+
+ return val;
+}
+
+/* Scan text in the region between *BEGP and *ENDP, skip characters
+ which we never have to encode to (iff ENCODEP is 1) or decode from
+ coding system CODING at the head and tail, then set BEGP and ENDP
+ to the addresses of start and end of the text we actually convert. */
+
+void
+shrink_conversion_area (begp, endp, coding, encodep)
+ unsigned char **begp, **endp;
+ struct coding_system *coding;
+ int encodep;
+{
+ register unsigned char *beg_addr = *begp, *end_addr = *endp;
+
+ if (coding->eol_type != CODING_EOL_LF
+ && coding->eol_type != CODING_EOL_AUTOMATIC)
+ /* Since we anyway have to convert end-of-line format, it is not
+ worth skipping at most 100 bytes or so. */
+ return;
+
+ if (encodep) /* for encoding */
+ {
+ switch (coding->type)
+ {
+ case coding_type_no_conversion:
+ case coding_type_internal:
+ case coding_type_automatic:
+ /* We need no conversion. */
+ *begp = *endp;
+ return;
+ case coding_type_ccl:
+ /* We can't skip any data. */
+ return;
+ default:
+ /* We can skip all ASCII characters at the head and tail. */
+ while (beg_addr < end_addr && *beg_addr < 0x80) beg_addr++;
+ while (beg_addr < end_addr && *(end_addr - 1) < 0x80) end_addr--;
+ break;
+ }
+ }
+ else /* for decoding */
+ {
+ switch (coding->type)
+ {
+ case coding_type_no_conversion:
+ /* We need no conversion. */
+ *begp = *endp;
+ return;
+ case coding_type_internal:
+ if (coding->eol_type == CODING_EOL_LF)
+ {
+ /* We need no conversion. */
+ *begp = *endp;
+ return;
+ }
+ /* We can skip all but carriage-return. */
+ while (beg_addr < end_addr && *beg_addr != '\r') beg_addr++;
+ while (beg_addr < end_addr && *(end_addr - 1) != '\r') end_addr--;
+ break;
+ case coding_type_sjis:
+ case coding_type_big5:
+ /* We can skip all ASCII characters at the head. */
+ while (beg_addr < end_addr && *beg_addr < 0x80) beg_addr++;
+ /* We can skip all ASCII characters at the tail except for
+ the second byte of SJIS or BIG5 code. */
+ while (beg_addr < end_addr && *(end_addr - 1) < 0x80) end_addr--;
+ if (end_addr != *endp)
+ end_addr++;
+ break;
+ case coding_type_ccl:
+ /* We can't skip any data. */
+ return;
+ default: /* i.e. case coding_type_iso2022: */
+ {
+ unsigned char c;
+
+ /* We can skip all ASCII characters except for a few
+ control codes at the head. */
+ while (beg_addr < end_addr && (c = *beg_addr) < 0x80
+ && c != ISO_CODE_CR && c != ISO_CODE_SO
+ && c != ISO_CODE_SI && c != ISO_CODE_ESC)
+ beg_addr++;
+ }
+ break;
+ }
+ }
+ *begp = beg_addr;
+ *endp = end_addr;
+ return;
+}
+
+/* Encode to (iff ENCODEP is 1) or decode form coding system CODING a
+ text between B and E. B and E are buffer position. */
+
+Lisp_Object
+code_convert_region (b, e, coding, encodep)
+ Lisp_Object b, e;
+ struct coding_system *coding;
+ int encodep;
+{
+ int beg, end, len, consumed, produced;
+ char *buf;
+ unsigned char *begp, *endp;
+ int pos = PT;
+
+ validate_region (&b, &e);
+ beg = XINT (b), end = XINT (e);
+ if (beg < GPT && end >= GPT)
+ move_gap (end);
+
+ if (encodep && !NILP (coding->pre_write_conversion))
+ {
+ /* We must call a pre-conversion function which may put a new
+ text to be converted in a new buffer. */
+ struct buffer *old = current_buffer, *new;
+
+ TEMP_SET_PT (beg);
+ call2 (coding->pre_write_conversion, b, e);
+ if (old != current_buffer)
+ {
+ /* Replace the original text by the text just generated. */
+ len = ZV - BEGV;
+ new = current_buffer;
+ set_buffer_internal (old);
+ del_range (beg, end);
+ insert_from_buffer (new, 1, len, 0);
+ end = beg + len;
+ }
+ }
+
+ /* We may be able to shrink the conversion region. */
+ begp = POS_ADDR (beg); endp = begp + (end - beg);
+ shrink_conversion_area (&begp, &endp, coding, encodep);
+
+ if (begp == endp)
+ /* We need no conversion. */
+ len = end - beg;
+ else
+ {
+ beg += begp - POS_ADDR (beg);
+ end = beg + (endp - begp);
+
+ if (encodep)
+ len = encoding_buffer_size (coding, end - beg);
+ else
+ len = decoding_buffer_size (coding, end - beg);
+ buf = get_conversion_buffer (len);
+
+ coding->last_block = 1;
+ produced = (encodep
+ ? encode_coding (coding, POS_ADDR (beg), buf, end - beg, len,
+ &consumed)
+ : decode_coding (coding, POS_ADDR (beg), buf, end - beg, len,
+ &consumed));
+
+ len = produced + (beg - XINT (b)) + (XINT (e) - end);
+
+ TEMP_SET_PT (beg);
+ insert (buf, produced);
+ del_range (PT, PT + end - beg);
+ if (pos >= end)
+ pos = PT + (pos - end);
+ else if (pos > beg)
+ pos = beg;
+ TEMP_SET_PT (pos);
+ }
+
+ if (!encodep && !NILP (coding->post_read_conversion))
+ {
+ /* We must call a post-conversion function which may alter
+ the text just converted. */
+ Lisp_Object insval;
+
+ beg = XINT (b);
+ TEMP_SET_PT (beg);
+ insval = call1 (coding->post_read_conversion, make_number (len));
+ CHECK_NUMBER (insval, 0);
+ len = XINT (insval);
+ }
+
+ return make_number (len);
+}
+
+Lisp_Object
+code_convert_string (str, coding, encodep)
+ Lisp_Object str;
+ struct coding_system *coding;
+ int encodep;
+{
+ int len, consumed, produced;
+ char *buf;
+ unsigned char *begp, *endp;
+ int head_skip, tail_skip;
+ struct gcpro gcpro1;
+
+ if (encodep && !NILP (coding->pre_write_conversion)
+ || !encodep && !NILP (coding->post_read_conversion))
+ {
+ /* Since we have to call Lisp functions which assume target text
+ is in a buffer, after setting a temporary buffer, call
+ code_convert_region. */
+ int count = specpdl_ptr - specpdl;
+ int len = XSTRING (str)->size;
+ Lisp_Object result;
+ struct buffer *old = current_buffer;
+
+ record_unwind_protect (Fset_buffer, Fcurrent_buffer ());
+ temp_output_buffer_setup (" *code-converting-work*");
+ set_buffer_internal (XBUFFER (Vstandard_output));
+ insert_from_string (str, 0, len, 0);
+ code_convert_region (make_number (BEGV), make_number (ZV),
+ coding, encodep);
+ result = make_buffer_string (BEGV, ZV, 0);
+ set_buffer_internal (old);
+ return unbind_to (count, result);
+ }
+
+ /* We may be able to shrink the conversion region. */
+ begp = XSTRING (str)->data;
+ endp = begp + XSTRING (str)->size;
+ shrink_conversion_area (&begp, &endp, coding, encodep);
+
+ if (begp == endp)
+ /* We need no conversion. */
+ return str;
+
+ head_skip = begp - XSTRING (str)->data;
+ tail_skip = XSTRING (str)->size - head_skip - (endp - begp);
+
+ GCPRO1 (str);
+
+ if (encodep)
+ len = encoding_buffer_size (coding, endp - begp);
+ else
+ len = decoding_buffer_size (coding, endp - begp);
+ buf = get_conversion_buffer (len + head_skip + tail_skip);
+
+ bcopy (XSTRING (str)->data, buf, head_skip);
+ coding->last_block = 1;
+ produced = (encodep
+ ? encode_coding (coding, XSTRING (str)->data + head_skip,
+ buf + head_skip, endp - begp, len, &consumed)
+ : decode_coding (coding, XSTRING (str)->data + head_skip,
+ buf + head_skip, endp - begp, len, &consumed));
+ bcopy (XSTRING (str)->data + head_skip + (endp - begp),
+ buf + head_skip + produced,
+ tail_skip);
+
+ UNGCPRO;
+
+ return make_string (buf, head_skip + produced + tail_skip);
+}
+
+DEFUN ("decode-coding-region", Fdecode_coding_region, Sdecode_coding_region,
+ 3, 3, 0,
+ "Decode the text between START and END which is encoded in CODING-SYSTEM.\n\
+Return length of decoded text.")
+ (b, e, coding_system)
+ Lisp_Object b, e, coding_system;
+{
+ struct coding_system coding;
+
+ CHECK_NUMBER_COERCE_MARKER (b, 0);
+ CHECK_NUMBER_COERCE_MARKER (e, 1);
+ CHECK_SYMBOL (coding_system, 2);
+
+ if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
+ error ("Invalid coding-system: %s", XSYMBOL (coding_system)->name->data);
+
+ return code_convert_region (b, e, &coding, 0);
+}
+
+DEFUN ("encode-coding-region", Fencode_coding_region, Sencode_coding_region,
+ 3, 3, 0,
+ "Encode the text between START and END to CODING-SYSTEM.\n\
+Return length of encoded text.")
+ (b, e, coding_system)
+ Lisp_Object b, e, coding_system;
+{
+ struct coding_system coding;
+
+ CHECK_NUMBER_COERCE_MARKER (b, 0);
+ CHECK_NUMBER_COERCE_MARKER (e, 1);
+ CHECK_SYMBOL (coding_system, 2);
+
+ if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
+ error ("Invalid coding-system: %s", XSYMBOL (coding_system)->name->data);
+
+ return code_convert_region (b, e, &coding, 1);
+}
+
+DEFUN ("decode-coding-string", Fdecode_coding_string, Sdecode_coding_string,
+ 2, 2, 0,
+ "Decode STRING which is encoded in CODING-SYSTEM, and return the result.")
+ (string, coding_system)
+ Lisp_Object string, coding_system;
+{
+ struct coding_system coding;
+
+ CHECK_STRING (string, 0);
+ CHECK_SYMBOL (coding_system, 1);
+
+ if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
+ error ("Invalid coding-system: %s", XSYMBOL (coding_system)->name->data);
+
+ return code_convert_string (string, &coding, 0);
+}
+
+DEFUN ("encode-coding-string", Fencode_coding_string, Sencode_coding_string,
+ 2, 2, 0,
+ "Encode STRING to CODING-SYSTEM, and return the result.")
+ (string, coding_system)
+ Lisp_Object string, coding_system;
+{
+ struct coding_system coding;
+
+ CHECK_STRING (string, 0);
+ CHECK_SYMBOL (coding_system, 1);
+
+ if (setup_coding_system (Fcheck_coding_system (coding_system), &coding) < 0)
+ error ("Invalid coding-system: %s", XSYMBOL (coding_system)->name->data);
+
+ return code_convert_string (string, &coding, 1);
+}
+
+DEFUN ("decode-sjis-char", Fdecode_sjis_char, Sdecode_sjis_char, 1, 1, 0,
+ "Decode a JISX0208 character of SJIS coding-system-sjis.\n\
+CODE is the character code in SJIS.\n\
+Return the corresponding character.")
+ (code)
+ Lisp_Object code;
+{
+ unsigned char c1, c2, s1, s2;
+ Lisp_Object val;
+
+ CHECK_NUMBER (code, 0);
+ s1 = (XFASTINT (code)) >> 8, s2 = (XFASTINT (code)) & 0xFF;
+ DECODE_SJIS (s1, s2, c1, c2);
+ XSETFASTINT (val, MAKE_NON_ASCII_CHAR (charset_jisx0208, c1, c2));
+ return val;
+}
+
+DEFUN ("encode-sjis-char", Fencode_sjis_char, Sencode_sjis_char, 1, 1, 0,
+ "Encode a JISX0208 character CHAR to SJIS coding-system.\n\
+Return the corresponding character code in SJIS.")
+ (ch)
+ Lisp_Object ch;
+{
+ int charset;
+ unsigned char c1, c2, s1, s2;
+ Lisp_Object val;
+
+ CHECK_NUMBER (ch, 0);
+ SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
+ if (charset == charset_jisx0208)
+ {
+ ENCODE_SJIS (c1, c2, s1, s2);
+ XSETFASTINT (val, ((int)s1 << 8) | s2);
+ }
+ else
+ XSETFASTINT (val, 0);
+ return val;
+}
+
+DEFUN ("decode-big5-char", Fdecode_big5_char, Sdecode_big5_char, 1, 1, 0,
+ "Decode a Big5 character CODE of BIG5 coding-system.\n\
+CODE is the character code in BIG5.\n\
+Return the corresponding character.")
+ (code)
+ Lisp_Object code;
+{
+ int charset;
+ unsigned char b1, b2, c1, c2;
+ Lisp_Object val;
+
+ CHECK_NUMBER (code, 0);
+ b1 = (XFASTINT (code)) >> 8, b2 = (XFASTINT (code)) & 0xFF;
+ DECODE_BIG5 (b1, b2, charset, c1, c2);
+ XSETFASTINT (val, MAKE_NON_ASCII_CHAR (charset, c1, c2));
+ return val;
+}
+
+DEFUN ("encode-big5-char", Fencode_big5_char, Sencode_big5_char, 1, 1, 0,
+ "Encode the Big5 character CHAR to BIG5 coding-system.\n\
+Return the corresponding character code in Big5.")
+ (ch)
+ Lisp_Object ch;
+{
+ int charset;
+ unsigned char c1, c2, b1, b2;
+ Lisp_Object val;
+
+ CHECK_NUMBER (ch, 0);
+ SPLIT_CHAR (XFASTINT (ch), charset, c1, c2);
+ if (charset == charset_big5_1 || charset == charset_big5_2)
+ {
+ ENCODE_BIG5 (charset, c1, c2, b1, b2);
+ XSETFASTINT (val, ((int)b1 << 8) | b2);
+ }
+ else
+ XSETFASTINT (val, 0);
+ return val;
+}
+
+DEFUN ("set-terminal-coding-system",
+ Fset_terminal_coding_system, Sset_terminal_coding_system, 1, 1,
+ "zCoding-system for terminal display: ",
+ "Set coding-system of your terminal to CODING-SYSTEM.\n\
+All outputs to terminal are encoded to this coding-system.")
+ (coding_system)
+ Lisp_Object coding_system;
+{
+ CHECK_SYMBOL (coding_system, 0);
+ setup_coding_system (Fcheck_coding_system (coding_system), &terminal_coding);
+ update_mode_lines++;
+ if (!NILP (Finteractive_p ()))
+ Fredraw_display ();
+ return Qnil;
+}
+
+DEFUN ("terminal-coding-system",
+ Fterminal_coding_system, Sterminal_coding_system, 0, 0, 0,
+ "Return coding-system of your terminal.")
+ ()
+{
+ return terminal_coding.symbol;
+}
+
+DEFUN ("set-keyboard-coding-system",
+ Fset_keyboard_coding_system, Sset_keyboard_coding_system, 1, 1,
+ "zCoding-system for keyboard input: ",
+ "Set coding-system of what is sent from terminal keyboard to CODING-SYSTEM.\n\
+All inputs from terminal are decoded from this coding-system.")
+ (coding_system)
+ Lisp_Object coding_system;
+{
+ CHECK_SYMBOL (coding_system, 0);
+ setup_coding_system (Fcheck_coding_system (coding_system), &keyboard_coding);
+ return Qnil;
+}
+
+DEFUN ("keyboard-coding-system",
+ Fkeyboard_coding_system, Skeyboard_coding_system, 0, 0, 0,
+ "Return coding-system of what is sent from terminal keyboard.")
+ ()
+{
+ return keyboard_coding.symbol;
+}
+
+
+DEFUN ("find-coding-system", Ffind_coding_system, Sfind_coding_system,
+ 1, MANY, 0,
+ "Return a cons of coding systems for I/O primitive OPERATION.\n\
+Remaining arguments are for OPERATION.\n\
+OPERATION is one of the following Emacs I/O primitives:\n\
+ For file I/O, insert-file-contents or write-region.\n\
+ For process I/O, call-process, call-process-region, or start-process.\n\
+ For network I/O, open-network-stream.\n\
+For each OPERATION, TARGET is selected from the arguments as below:\n\
+ For file I/O, TARGET is a file name.\n\
+ For process I/O, TARGET is a process name.\n\
+ For network I/O, TARGET is a service name or a port number\n\
+\n\
+The return value is a cons of coding systems for decoding and encoding\n\
+registered in nested alist `coding-system-alist' (which see) at a slot\n\
+corresponding to OPERATION and TARGET.
+If a function symbol is at the slot, return a result of the function call.\n\
+The function is called with one argument, a list of all the arguments.")
+ (nargs, args)
+ int nargs;
+ Lisp_Object *args;
+{
+ Lisp_Object operation, target_idx, target, val;
+ register Lisp_Object chain;
+
+ if (nargs < 2)
+ error ("Too few arguments");
+ operation = args[0];
+ if (!SYMBOLP (operation)
+ || !INTEGERP (target_idx = Fget (operation, Qtarget_idx)))
+ error ("Invalid first arguement");
+ if (nargs < 1 + XINT (target_idx))
+ error ("Too few arguments for operation: %s",
+ XSYMBOL (operation)->name->data);
+ target = args[XINT (target_idx) + 1];
+ if (!(STRINGP (target)
+ || (EQ (operation, Qopen_network_stream) && INTEGERP (target))))
+ error ("Invalid %dth argument", XINT (target_idx) + 1);
+
+ chain = Fassq (operation, Vcoding_system_alist);
+ if (NILP (chain))
+ return Qnil;
+
+ for (chain = XCONS (chain)->cdr; CONSP (chain); chain = XCONS (chain)->cdr)
+ {
+ Lisp_Object elt = XCONS (chain)->car;
+
+ if (CONSP (elt)
+ && ((STRINGP (target)
+ && STRINGP (XCONS (elt)->car)
+ && fast_string_match (XCONS (elt)->car, target) >= 0)
+ || (INTEGERP (target) && EQ (target, XCONS (elt)->car))))
+ return (CONSP (val = XCONS (elt)->cdr)
+ ? val
+ : ((SYMBOLP (val) && Fboundp (val)
+ ? call2 (val, Flist (nargs, args))
+ : Qnil)));
+ }
+ return Qnil;
+}
+
+#endif /* emacs */
+
+
+/*** 8. Post-amble ***/
+
+init_coding_once ()
+{
+ int i;
+
+ /* Emacs internal format specific initialize routine. */
+ for (i = 0; i <= 0x20; i++)
+ emacs_code_class[i] = EMACS_control_code;
+ emacs_code_class[0x0A] = EMACS_linefeed_code;
+ emacs_code_class[0x0D] = EMACS_carriage_return_code;
+ for (i = 0x21 ; i < 0x7F; i++)
+ emacs_code_class[i] = EMACS_ascii_code;
+ emacs_code_class[0x7F] = EMACS_control_code;
+ emacs_code_class[0x80] = EMACS_leading_code_composition;
+ for (i = 0x81; i < 0xFF; i++)
+ emacs_code_class[i] = EMACS_invalid_code;
+ emacs_code_class[LEADING_CODE_PRIVATE_11] = EMACS_leading_code_3;
+ emacs_code_class[LEADING_CODE_PRIVATE_12] = EMACS_leading_code_3;
+ emacs_code_class[LEADING_CODE_PRIVATE_21] = EMACS_leading_code_4;
+ emacs_code_class[LEADING_CODE_PRIVATE_22] = EMACS_leading_code_4;
+
+ /* ISO2022 specific initialize routine. */
+ for (i = 0; i < 0x20; i++)
+ iso_code_class[i] = ISO_control_code;
+ for (i = 0x21; i < 0x7F; i++)
+ iso_code_class[i] = ISO_graphic_plane_0;
+ for (i = 0x80; i < 0xA0; i++)
+ iso_code_class[i] = ISO_control_code;
+ for (i = 0xA1; i < 0xFF; i++)
+ iso_code_class[i] = ISO_graphic_plane_1;
+ iso_code_class[0x20] = iso_code_class[0x7F] = ISO_0x20_or_0x7F;
+ iso_code_class[0xA0] = iso_code_class[0xFF] = ISO_0xA0_or_0xFF;
+ iso_code_class[ISO_CODE_CR] = ISO_carriage_return;
+ iso_code_class[ISO_CODE_SO] = ISO_shift_out;
+ iso_code_class[ISO_CODE_SI] = ISO_shift_in;
+ iso_code_class[ISO_CODE_SS2_7] = ISO_single_shift_2_7;
+ iso_code_class[ISO_CODE_ESC] = ISO_escape;
+ iso_code_class[ISO_CODE_SS2] = ISO_single_shift_2;
+ iso_code_class[ISO_CODE_SS3] = ISO_single_shift_3;
+ iso_code_class[ISO_CODE_CSI] = ISO_control_sequence_introducer;
+
+ Qcoding_system = intern ("coding-system");
+ staticpro (&Qcoding_system);
+
+ Qeol_type = intern ("eol-type");
+ staticpro (&Qeol_type);
+
+ Qbuffer_file_coding_system = intern ("buffer-file-coding-system");
+ staticpro (&Qbuffer_file_coding_system);
+
+ Qpost_read_conversion = intern ("post-read-conversion");
+ staticpro (&Qpost_read_conversion);
+
+ Qpre_write_conversion = intern ("pre-write-conversion");
+ staticpro (&Qpre_write_conversion);
+
+ Qcoding_system_vector = intern ("coding-system-vector");
+ staticpro (&Qcoding_system_vector);
+
+ Qcoding_system_p = intern ("coding-system-p");
+ staticpro (&Qcoding_system_p);
+
+ Qcoding_system_error = intern ("coding-system-error");
+ staticpro (&Qcoding_system_error);
+
+ Fput (Qcoding_system_error, Qerror_conditions,
+ Fcons (Qcoding_system_error, Fcons (Qerror, Qnil)));
+ Fput (Qcoding_system_error, Qerror_message,
+ build_string ("Coding-system error"));
+
+ Qcoding_category_index = intern ("coding-category-index");
+ staticpro (&Qcoding_category_index);
+
+ {
+ int i;
+ for (i = 0; i < CODING_CATEGORY_IDX_MAX; i++)
+ {
+ coding_category_table[i] = intern (coding_category_name[i]);
+ staticpro (&coding_category_table[i]);
+ Fput (coding_category_table[i], Qcoding_category_index,
+ make_number (i));
+ }
+ }
+
+ conversion_buffer_size = MINIMUM_CONVERSION_BUFFER_SIZE;
+ conversion_buffer = (char *) xmalloc (MINIMUM_CONVERSION_BUFFER_SIZE);
+
+ setup_coding_system (Qnil, &keyboard_coding);
+ setup_coding_system (Qnil, &terminal_coding);
+}
+
+#ifdef emacs
+
+syms_of_coding ()
+{
+ Qtarget_idx = intern ("target-idx");
+ staticpro (&Qtarget_idx);
+
+ Fput (Qinsert_file_contents, Qtarget_idx, make_number (0));
+ Fput (Qwrite_region, Qtarget_idx, make_number (2));
+
+ Qcall_process = intern ("call-process");
+ staticpro (&Qcall_process);
+ Fput (Qcall_process, Qtarget_idx, make_number (0));
+
+ Qcall_process_region = intern ("call-process-region");
+ staticpro (&Qcall_process_region);
+ Fput (Qcall_process_region, Qtarget_idx, make_number (2));
+
+ Qstart_process = intern ("start-process");
+ staticpro (&Qstart_process);
+ Fput (Qstart_process, Qtarget_idx, make_number (2));
+
+ Qopen_network_stream = intern ("open-network-stream");
+ staticpro (&Qopen_network_stream);
+ Fput (Qopen_network_stream, Qtarget_idx, make_number (3));
+
+ defsubr (&Scoding_system_vector);
+ defsubr (&Scoding_system_p);
+ defsubr (&Sread_coding_system);
+ defsubr (&Sread_non_nil_coding_system);
+ defsubr (&Scheck_coding_system);
+ defsubr (&Sdetect_coding_region);
+ defsubr (&Sdecode_coding_region);
+ defsubr (&Sencode_coding_region);
+ defsubr (&Sdecode_coding_string);
+ defsubr (&Sencode_coding_string);
+ defsubr (&Sdecode_sjis_char);
+ defsubr (&Sencode_sjis_char);
+ defsubr (&Sdecode_big5_char);
+ defsubr (&Sencode_big5_char);
+ defsubr (&Sset_terminal_coding_system);
+ defsubr (&Sterminal_coding_system);
+ defsubr (&Sset_keyboard_coding_system);
+ defsubr (&Skeyboard_coding_system);
+ defsubr (&Sfind_coding_system);
+
+ DEFVAR_LISP ("coding-category-list", &Vcoding_category_list,
+ "List of coding-categories (symbols) ordered by priority.");
+ {
+ int i;
+
+ Vcoding_category_list = Qnil;
+ for (i = CODING_CATEGORY_IDX_MAX - 1; i >= 0; i--)
+ Vcoding_category_list
+ = Fcons (coding_category_table[i], Vcoding_category_list);
+ }
+
+ DEFVAR_LISP ("coding-system-for-read", &Vcoding_system_for_read,
+ "A variable of internal use only.\n\
+If the value is a coding system, it is used for decoding on read operation.\n\
+If not, an appropriate element in `coding-system-alist' (which see) is used.");
+ Vcoding_system_for_read = Qnil;
+
+ DEFVAR_LISP ("coding-system-for-write", &Vcoding_system_for_write,
+ "A variable of internal use only.\n\
+If the value is a coding system, it is used for encoding on write operation.\n\
+If not, an appropriate element in `coding-system-alist' (which see) is used.");
+ Vcoding_system_for_write = Qnil;
+
+ DEFVAR_LISP ("last-coding-system-used", &Vlast_coding_system_used,
+ "Coding-system used in the latest file or process I/O.");
+ Vlast_coding_system_used = Qnil;
+
+ DEFVAR_LISP ("coding-system-alist", &Vcoding_system_alist,
+ "Nested alist to decide a coding system for a specific I/O operation.\n\
+The format is ((OPERATION . ((REGEXP . CODING-SYSTEMS) ...)) ...).\n\
+
+OPERATION is one of the following Emacs I/O primitives:\n\
+ For file I/O, insert-file-contents and write-region.\n\
+ For process I/O, call-process, call-process-region, and start-process.\n\
+ For network I/O, open-network-stream.\n\
+In addition, for process I/O, `process-argument' can be specified for\n\
+encoding arguments of the process.\n\
+\n\
+REGEXP is a regular expression matching a target of OPERATION, where\n\
+target is a file name for file I/O operations, a process name for\n\
+process I/O operations, or a service name for network I/O\n\
+operations. REGEXP might be a port number for network I/O operation.\n\
+\n\
+CODING-SYSTEMS is a cons of coding systems to encode and decode\n\
+character code on OPERATION, or a function symbol returning the cons.\n\
+See the documentation of `find-coding-system' for more detail.");
+ Vcoding_system_alist = Qnil;
+
+ DEFVAR_INT ("eol-mnemonic-unix", &eol_mnemonic_unix,
+ "Mnemonic character indicating UNIX-like end-of-line format (i.e. LF) .");
+ eol_mnemonic_unix = '.';
+
+ DEFVAR_INT ("eol-mnemonic-dos", &eol_mnemonic_dos,
+ "Mnemonic character indicating DOS-like end-of-line format (i.e. CRLF).");
+ eol_mnemonic_dos = ':';
+
+ DEFVAR_INT ("eol-mnemonic-mac", &eol_mnemonic_mac,
+ "Mnemonic character indicating MAC-like end-of-line format (i.e. CR).");
+ eol_mnemonic_mac = '\'';
+
+ DEFVAR_INT ("eol-mnemonic-undecided", &eol_mnemonic_undecided,
+ "Mnemonic character indicating end-of-line format is not yet decided.");
+ eol_mnemonic_undecided = '-';
+
+ DEFVAR_LISP ("alternate-charset-table", &Valternate_charset_table,
+ "Alist of charsets vs the alternate charsets.\n\
+While decoding, if a charset (car part of an element) is found,\n\
+decode it as the alternate charset (cdr part of the element).");
+ Valternate_charset_table = Qnil;
+
+ DEFVAR_LISP ("charset-revision-table", &Vcharset_revision_alist,
+ "Alist of charsets vs revision numbers.\n\
+While encoding, if a charset (car part of an element) is found,\n\
+designate it with the escape sequence identifing revision (cdr part of the element).");
+ Vcharset_revision_alist = Qnil;
+}
+
+#endif /* emacs */
diff --git a/src/coding.h b/src/coding.h
new file mode 100644
index 00000000000..3ec2fcc32f3
--- /dev/null
+++ b/src/coding.h
@@ -0,0 +1,409 @@
+/* Header for coding system handler.
+ Ver.1.0
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef _CODING_H
+#define _CODING_H
+
+#ifndef _CCL_H
+#include "../src/ccl.h"
+#endif
+
+/*** EMACS' INTERNAL FORMAT section ***/
+
+/* All code (1-byte) of Emacs' internal format is classified into one
+ of the followings. See also `charset.h'. */
+enum emacs_code_class_type
+ {
+ EMACS_control_code, /* Control codes in the range
+ 0x00..0x1F and 0x7F except for the
+ following two codes. */
+ EMACS_linefeed_code, /* 0x0A (linefeed) to denote
+ end-of-line. */
+ EMACS_carriage_return_code, /* 0x0D (carriage-return) to be used
+ in selective display mode. */
+ EMACS_ascii_code, /* ASCII characters. */
+ EMACS_leading_code_composition, /* Leading code of a composite
+ character. */
+ EMACS_leading_code_2, /* Base leading code of official
+ TYPE9N character. */
+ EMACS_leading_code_3, /* Base leading code of private TYPE9N
+ or official TYPE9Nx9N character. */
+ EMACS_leading_code_4, /* Base leading code of private
+ TYPE9Nx9N character. */
+ EMACS_invalid_code /* Invalid code, i.e. a base leading
+ code not yet assigned to any
+ charset, or a code of the range
+ 0xA0..0xFF. */
+ };
+
+extern enum emacs_code_class_type emacs_code_class[256];
+
+/*** ISO2022 section ***/
+
+/* Macros to define code of control characters for ISO2022's functions. */
+ /* code */ /* function */
+#define ISO_CODE_LF 0x0A /* line-feed */
+#define ISO_CODE_CR 0x0D /* carriage-return */
+#define ISO_CODE_SO 0x0E /* shift-out */
+#define ISO_CODE_SI 0x0F /* shift-in */
+#define ISO_CODE_SS2_7 0x19 /* single-shift-2 for 7-bit code */
+#define ISO_CODE_ESC 0x1B /* escape */
+#define ISO_CODE_SS2 0x8E /* single-shift-2 */
+#define ISO_CODE_SS3 0x8F /* single-shift-3 */
+#define ISO_CODE_CSI 0x9B /* control-sequence-introduce */
+
+/* All code (1-byte) of ISO2022 is classified into one of the
+ followings. */
+enum iso_code_class_type
+ {
+ ISO_control_code, /* Control codes in the range
+ 0x00..0x1F, 0x7F, and 0x80..0x9F,
+ except for the following seven
+ codes. */
+ ISO_carriage_return, /* ISO_CODE_CR (0x0D) */
+ ISO_shift_out, /* ISO_CODE_SO (0x0E) */
+ ISO_shift_in, /* ISO_CODE_SI (0x0F) */
+ ISO_single_shift_2_7, /* ISO_CODE_SS2_7 (0x19) */
+ ISO_escape, /* ISO_CODE_SO (0x1B) */
+ ISO_single_shift_2, /* ISO_CODE_SS2 (0x8E) */
+ ISO_single_shift_3, /* ISO_CODE_SS3 (0x8F) */
+ ISO_control_sequence_introducer, /* ISO_CODE_CSI (0x9B) */
+ ISO_0x20_or_0x7F, /* Codes of the values 0x20 or 0x7F. */
+ ISO_graphic_plane_0, /* Graphic codes in the range 0x21..0x7E. */
+ ISO_0xA0_or_0xFF, /* Codes of the values 0xA0 or 0xFF. */
+ ISO_graphic_plane_1 /* Graphic codes in the range 0xA1..0xFE. */
+ };
+
+/** The macros CODING_FLAG_ISO_XXX defines a flag bit of the `flags'
+ element in the structure `coding_system'. This information is used
+ while encoding a text to ISO2022. **/
+
+/* If set, produce short-form designation sequence (e.g. ESC $ A)
+ instead of long-form sequence (e.g. ESC $ ( A). */
+#define CODING_FLAG_ISO_SHORT_FORM 0x0001
+
+/* If set, reset graphic planes and registers at end-of-line to the
+ initial state. */
+#define CODING_FLAG_ISO_RESET_AT_EOL 0x0002
+
+/* If set, reset graphic planes and registers before any control
+ characters to the initial state. */
+#define CODING_FLAG_ISO_RESET_AT_CNTL 0x0004
+
+/* If set, encode by 7-bit environment. */
+#define CODING_FLAG_ISO_SEVEN_BITS 0x0008
+
+/* If set, use locking-shift function. */
+#define CODING_FLAG_ISO_LOCKING_SHIFT 0x0010
+
+/* If set, use single-shift function. Overwrite
+ CODING_FLAG_ISO_LOCKING_SHIFT. */
+#define CODING_FLAG_ISO_SINGLE_SHIFT 0x0020
+
+/* If set, designate JISX0201-Roman instead of ASCII. */
+#define CODING_FLAG_ISO_USE_ROMAN 0x0040
+
+/* If set, designate JISX0208-1978 instead of JISX0208-1983. */
+#define CODING_FLAG_ISO_USE_OLDJIS 0x0080
+
+/* If set, do not produce ISO6429's direction specifying sequence. */
+#define CODING_FLAG_ISO_NO_DIRECTION 0x0100
+
+/* Structure of the field `spec.iso2022' in the structure `coding_system'. */
+struct iso2022_spec
+{
+ /* The current graphic register invoked to each graphic plane. */
+ int current_invocation[2];
+
+ /* The current charset designated to each graphic register. */
+ int current_designation[4];
+
+ /* A charset initially designated to each graphic register. */
+ int initial_designation[4];
+
+ /* A graphic register to which each charset should be designated. */
+ int requested_designation[MAX_CHARSET];
+
+ /* Set to 1 temporarily only when graphic register 2 or 3 is invoked
+ by single-shift while encoding. */
+ int single_shifting;
+};
+
+/* Macros to access each field in the structure `spec.iso2022'. */
+#define CODING_SPEC_ISO_INVOCATION(coding, plane) \
+ coding->spec.iso2022.current_invocation[plane]
+#define CODING_SPEC_ISO_DESIGNATION(coding, reg) \
+ coding->spec.iso2022.current_designation[reg]
+#define CODING_SPEC_ISO_INITIAL_DESIGNATION(coding, reg) \
+ coding->spec.iso2022.initial_designation[reg]
+#define CODING_SPEC_ISO_REQUESTED_DESIGNATION(coding, charset) \
+ coding->spec.iso2022.requested_designation[charset]
+
+/* Set to 1 temporarily only when encoding a character with
+ single-shift function. */
+#define CODING_SPEC_ISO_SINGLE_SHIFTING(coding) \
+ coding->spec.iso2022.single_shifting
+
+/* Return a charset which is currently designated to the graphic plane
+ PLANE in the coding-system CODING. */
+#define CODING_SPEC_ISO_PLANE_CHARSET(coding, plane) \
+ CODING_SPEC_ISO_DESIGNATION \
+ (coding, CODING_SPEC_ISO_INVOCATION (coding, plane))
+
+/*** BIG5 section ***/
+
+/* Macros to denote each type of BIG5 coding system. */
+#define CODING_FLAG_BIG5_HKU 0x00 /* BIG5-HKU is one of variants of
+ BIG5 developed by Hong Kong
+ University. */
+#define CODING_FLAG_BIG5_ETEN 0x01 /* BIG5_ETen is one of variants
+ of BIG5 developed by the
+ company ETen in Taiwan. */
+
+/*** GENERAL section ***/
+
+/* Types of coding system. */
+enum coding_type
+ {
+ coding_type_no_conversion, /* A coding system which requires no
+ conversion for reading and writing
+ including end-of-line format. */
+ coding_type_internal, /* A coding system used in Emacs'
+ buffer and string. Requires no
+ conversion for reading and writing
+ except for end-of-line format. */
+ coding_type_automatic, /* A coding system which requires
+ automatic detection of a real
+ coding system. */
+ coding_type_sjis, /* SJIS coding system for Japanese. */
+ coding_type_iso2022, /* Any coding system of ISO2022
+ variants. */
+ coding_type_big5, /* BIG5 coding system for Chinese. */
+ coding_type_ccl /* The coding system of which decoder
+ and encoder are written in CCL. */
+ };
+
+/* Formats of end-of-line. */
+#define CODING_EOL_LF 0 /* Line-feed only, same as Emacs'
+ internal format. */
+#define CODING_EOL_CRLF 1 /* Sequence of carriage-return and
+ line-feed. */
+#define CODING_EOL_CR 2 /* Carriage-return only. */
+#define CODING_EOL_AUTOMATIC 3 /* This value is used to denote the
+ eol-type is not yet decided. */
+
+/* Character composition status while encoding/decoding. */
+#define COMPOSING_NO 0 /* not composing */
+#define COMPOSING_WITH_RULE_HEAD 1 /* 1st char of with-rule composing follow */
+#define COMPOSING_NO_RULE_HEAD 2 /* 1st char of no-rule composing follow */
+#define COMPOSING_WITH_RULE_TAIL 3 /* Nth char of with-rule composing follow */
+#define COMPOSING_NO_RULE_TAIL 4 /* Nth char of no-rule composing follow */
+#define COMPOSING_WITH_RULE_RULE 5 /* composition rule follow */
+
+/* 1 iff composing. */
+#define COMPOSING_P(composing) (composing)
+/* 1 iff 1st char of composing element follows. */
+#define COMPOSING_HEAD_P(composing) \
+ ((composing) && (composing) <= COMPOSING_NO_RULE_HEAD)
+/* 1 iff composing with embeded composition rule. */
+#define COMPOSING_WITH_RULE_P(composing) ((composing) & 1)
+
+struct coding_system
+{
+ /* Type of the coding system. */
+ enum coding_type type;
+
+ /* If the coding system requires specific code to be attached at the
+ tail of converted text, this value should be set to `1'. */
+ int require_flushing;
+
+ /* Flag bits of the coding system. The meaning of each bit depends
+ on the type of the coding system. */
+ unsigned int flags;
+
+ /* Type of end-of-line format (LF, CRLF, or CR) of the coding system. */
+ int eol_type;
+
+ /* Non-zero means that the current source text is the last block of the
+ whole text to be converted. */
+ int last_block;
+
+ /* Non-zero means that characters are being composed currently while
+ decoding or encoding. See macros COMPOSING_XXXX above for the
+ meaing of each non-zero value. */
+ int composing;
+
+ /* 0 (left-to-right) or 1 (right-to-left): the direction of the text
+ being processed currently. */
+ int direction;
+
+ /* Non-zero means that the current source text is in a buffer which
+ enables selective display. */
+ int selective;
+
+ /* Detailed information specific to each type of coding system. */
+ union spec
+ {
+ struct iso2022_spec iso2022;
+ struct ccl_spec ccl; /* Defined in ccl.h. */
+ } spec;
+
+ /* Backward pointer to the Lisp symbol of the coding system. */
+ Lisp_Object symbol;
+
+ /* Lisp function (symbol) to be called after decoding to do
+ additional conversion. */
+ Lisp_Object post_read_conversion;
+
+ /* Lisp function (symbol) to be called before encoding to do
+ additional conversion. */
+ Lisp_Object pre_write_conversion;
+
+ /* Carryover yielded by decoding/encoding incomplete source. No
+ coding-system yields more than 7-byte of carryover. This does
+ not include a text which is not processed because of short of
+ output buffer. */
+ char carryover[8];
+
+ /* Actual data length in the above array. */
+ int carryover_size;
+};
+
+/* Return 1 if the coding-system CODING requires conversion of
+ representation of a visible character (text). */
+#define CODING_REQUIRE_TEXT_CONVERSION(coding) \
+ ((coding)->type != coding_type_no_conversion \
+ && (coding)->type != coding_type_internal)
+
+/* Return 1 if the coding-system CODING requires conversion of the
+ format of end-of-line. */
+#define CODING_REQUIRE_EOL_CONVERSION(coding) \
+ ((coding)->eol_type != CODING_EOL_AUTOMATIC \
+ && (coding)->eol_type != CODING_EOL_LF)
+
+/* Return 1 if the coding-system CODING requires some conversion. */
+#define CODING_REQUIRE_CONVERSION(coding) \
+ (CODING_REQUIRE_TEXT_CONVERSION (coding) \
+ || CODING_REQUIRE_EOL_CONVERSION (coding))
+
+/* Index for each coding category in `coding_category_table' */
+#define CODING_CATEGORY_IDX_INTERNAL 0
+#define CODING_CATEGORY_IDX_SJIS 1
+#define CODING_CATEGORY_IDX_ISO_7 2
+#define CODING_CATEGORY_IDX_ISO_8_1 3
+#define CODING_CATEGORY_IDX_ISO_8_2 4
+#define CODING_CATEGORY_IDX_ISO_ELSE 5
+#define CODING_CATEGORY_IDX_BIG5 6
+#define CODING_CATEGORY_IDX_BINARY 7
+#define CODING_CATEGORY_IDX_MAX 8
+
+/* Definitions of flag bits returned by the function
+ detect_coding_mask (). */
+#define CODING_CATEGORY_MASK_INTERNAL (1 << CODING_CATEGORY_IDX_INTERNAL)
+#define CODING_CATEGORY_MASK_SJIS (1 << CODING_CATEGORY_IDX_SJIS)
+#define CODING_CATEGORY_MASK_ISO_7 (1 << CODING_CATEGORY_IDX_ISO_7)
+#define CODING_CATEGORY_MASK_ISO_8_1 (1 << CODING_CATEGORY_IDX_ISO_8_1)
+#define CODING_CATEGORY_MASK_ISO_8_2 (1 << CODING_CATEGORY_IDX_ISO_8_2)
+#define CODING_CATEGORY_MASK_ISO_ELSE (1 << CODING_CATEGORY_IDX_ISO_ELSE)
+#define CODING_CATEGORY_MASK_BIG5 (1 << CODING_CATEGORY_IDX_BIG5)
+
+/* This value is returned if detect_coding_mask () find nothing other
+ than ASCII characters. */
+#define CODING_CATEGORY_MASK_ANY \
+ ( CODING_CATEGORY_MASK_INTERNAL \
+ | CODING_CATEGORY_MASK_SJIS \
+ | CODING_CATEGORY_MASK_ISO_7 \
+ | CODING_CATEGORY_MASK_ISO_8_1 \
+ | CODING_CATEGORY_MASK_ISO_8_2 \
+ | CODING_CATEGORY_MASK_ISO_ELSE \
+ | CODING_CATEGORY_MASK_BIG5)
+
+/* Macros to decode or encode a character of JISX0208 in SJIS. S1 and
+ S2 are the 1st and 2nd position-codes of JISX0208 in SJIS coding
+ system. C1 and C2 are the 1st and 2nd position codes of Emacs'
+ internal format. */
+
+#define DECODE_SJIS(s1, s2, c1, c2) \
+ do { \
+ if (s2 >= 0x9F) \
+ c1 = s1 * 2 - (s1 >= 0xE0 ? 0x160 : 0xE0), \
+ c2 = s2 - 0x7E; \
+ else \
+ c1 = s1 * 2 - ((s1 >= 0xE0) ? 0x161 : 0xE1), \
+ c2 = s2 - ((s2 >= 0x7F) ? 0x20 : 0x1F); \
+ } while (0)
+
+#define ENCODE_SJIS(c1, c2, s1, s2) \
+ do { \
+ if (c1 & 1) \
+ s1 = c1 / 2 + ((c1 < 0x5F) ? 0x71 : 0xB1), \
+ s2 = c2 + ((c2 >= 0x60) ? 0x20 : 0x1F); \
+ else \
+ s1 = c1 / 2 + ((c1 < 0x5F) ? 0x70 : 0xB0), \
+ s2 = c2 + 0x7E; \
+ } while (0)
+
+/* Extern declarations. */
+extern int decode_coding (), encode_coding ();
+extern int decoding_buffer_size (), encoding_buffer_size ();
+extern int conversion_buffer_size;
+extern char *conversion_buffer, *get_conversion_buffer ();
+extern Lisp_Object Fcheck_coding_system ();
+extern Lisp_Object Qcoding_system, Qeol_type, Qcoding_category_index;
+extern Lisp_Object Qbuffer_file_coding_system;
+extern Lisp_Object Vcoding_category_list;
+
+/* Mnemonic character to indicate each type of end-of-line. */
+extern int eol_mnemonic_unix, eol_mnemonic_dos, eol_mnemonic_mac;
+/* Mnemonic character to indicate type of end-of-line is not yet decided. */
+extern int eol_mnemonic_undecided;
+
+/* Table of coding-systems currently assigned to each coding-category. */
+extern Lisp_Object coding_category_table[CODING_CATEGORY_IDX_MAX];
+/* Table of names of symbol for each coding-category. */
+extern char *coding_category_name[CODING_CATEGORY_IDX_MAX];
+
+#ifdef emacs
+extern Lisp_Object Qfile_coding_system;
+extern Lisp_Object Qcall_process, Qcall_process_region, Qprocess_argument;
+extern Lisp_Object Qstart_process, Qopen_network_stream;
+
+/* Coding-system for reading files and receiving data from process. */
+extern Lisp_Object Vcoding_system_for_read;
+/* Coding-system for writing files and sending data to process. */
+extern Lisp_Object Vcoding_system_for_write;
+/* Coding-system actually used in the latest I/O. */
+extern Lisp_Object Vlast_coding_system_used;
+
+/* Coding-system to be used for encoding terminal output. This
+ structure contains information of a coding-system specified by the
+ function `set-terminal-coding-system'. */
+extern struct coding_system terminal_coding;
+
+/* Coding-system of what is sent from terminal keyboard. This
+ structure contains information of a coding-system specified by the
+ function `set-keyboard-coding-system'. */
+extern struct coding_system keyboard_coding;
+
+extern Lisp_Object Vcoding_system_alist;
+
+#endif
+
+#endif /* _CODING_H */
diff --git a/src/fontset.c b/src/fontset.c
new file mode 100644
index 00000000000..7d88e90ae89
--- /dev/null
+++ b/src/fontset.c
@@ -0,0 +1,819 @@
+/* Fontset handler.
+ Ver.1.0
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#include <config.h>
+#if HAVE_ALLOCA_H
+#include <alloca.h>
+#endif /* HAVE_ALLOCA_H */
+#include "lisp.h"
+#include "charset.h"
+#include "ccl.h"
+#include "fontset.h"
+#include "frame.h"
+
+Lisp_Object Vglobal_fontset_alist;
+
+Lisp_Object Vfont_encoding_alist;
+
+/* We had better have our own strcasecmp function because some system
+ doesn't have it. */
+static char my_strcasetbl[256];
+
+/* Compare two strings S0 and S1 while ignoring differences in case.
+ Return 1 if they differ, else return 0. */
+static int
+my_strcasecmp (s0, s1)
+ unsigned char *s0, *s1;
+{
+ while (*s0)
+ if (my_strcasetbl[*s0++] != my_strcasetbl[*s1++]) return 1;
+ return (int) *s1;
+}
+
+/* The following six are window system dependent functions. See
+ the comments in src/fontset.h for more detail. */
+
+/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
+struct font_info *(*get_font_info_func) (/* FRAME_PTR f; int font_idx */);
+
+/* Return a list of font names which matches PATTERN. See the document of
+ `x-list-fonts' for more detail. */
+Lisp_Object (*list_fonts_func) (/* Lisp_Object pattern, face, frame, width */);
+
+/* Load a font named NAME for frame F and return a pointer to the
+ information of the loaded font. If loading is failed, return 0. */
+struct font_info *(*load_font_func) (/* FRAME_PTR f; char *name */);
+
+/* Return a pointer to struct font_info of a font named NAME for frame F. */
+struct font_info *(*query_font_func) (/* FRAME_PTR f; char *name */);
+
+/* Additional function for setting fontset or changing fontset
+ contents of frame F. */
+void (*set_frame_fontset_func) (/* FRAME_PTR f; Lisp_Object arg, oldval */);
+
+/* Check if any window system is used now. */
+void (*check_window_system_func) ();
+
+struct fontset_data *
+alloc_fontset_data ()
+{
+ struct fontset_data *fontset_data
+ = (struct fontset_data *) xmalloc (sizeof (struct fontset_data));
+
+ bzero (fontset_data, sizeof (struct fontset_data));
+
+ return fontset_data;
+}
+
+void
+free_fontset_data (fontset_data)
+ struct fontset_data *fontset_data;
+{
+ int i;
+
+ for (i = 0; i < fontset_data->n_fontsets; i++)
+ {
+ int j;
+
+ xfree (fontset_data->fontset_table[i]->name);
+ for (j = 0; j < MAX_CHARSET; j++)
+ if (fontset_data->fontset_table[i]->fontname[j])
+ xfree (fontset_data->fontset_table[i]->fontname[j]);
+ xfree (fontset_data->fontset_table[i]);
+ }
+ xfree (fontset_data->fontset_table);
+
+ xfree (fontset_data);
+}
+
+/* Load a font named FONTNAME for displaying CHARSET on frame F.
+ All fonts for frame F is stored in a table pointed by FONT_TABLE.
+ Return a pointer to the struct font_info of the loaded font.
+ If loading fails, return 0;
+ If FONTNAME is NULL, the name is taken from the information of FONTSET.
+ If FONTSET is given, try to load a font whose size matches that of
+ FONTSET, and, the font index is stored in the table for FONTSET. */
+
+struct font_info *
+fs_load_font (f, font_table, charset, fontname, fontset)
+ FRAME_PTR f;
+ struct font_info *font_table;
+ int charset, fontset;
+ char *fontname;
+{
+ Lisp_Object font_list;
+ Lisp_Object list, elt;
+ int font_idx;
+ int size = 0;
+ struct fontset_info *fontsetp = 0;
+ struct font_info *fontp;
+
+ if (fontset >= 0 && fontset < FRAME_FONTSET_DATA (f)->n_fontsets)
+ {
+ fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
+ font_idx = fontsetp->font_indexes[charset];
+ if (font_idx >= 0)
+ /* We have already loaded a font. */
+ return font_table + font_idx;
+ else if (font_idx == FONT_NOT_FOUND)
+ /* We have already tried loading a font and failed. */
+ return 0;
+ if (!fontname)
+ fontname = fontsetp->fontname[charset];
+ }
+
+ if (!fontname)
+ /* No way to get fontname. */
+ return 0;
+
+ /* If a fontset is specified and we have already loaded some fonts
+ in the fontset, we need a font of appropriate size to be used
+ with the fonts. */
+ if (fontsetp && fontsetp->size)
+ size = fontsetp->size * CHARSET_WIDTH (charset);
+
+ fontp = (*load_font_func) (f, fontname, size);
+
+ if (!fontp)
+ {
+ if (fontsetp)
+ fontsetp->font_indexes[charset] = FONT_NOT_FOUND;
+ return 0;
+ }
+
+ /* Fill in fields (CHARSET, ENCODING, and FONT_ENCODER) which are
+ not set by (*load_font_func). */
+ fontp->charset = charset;
+
+ if (fontp->encoding[1] >= 0)
+ {
+ /* The font itself tells which code points to be used. Use this
+ encoding for all other charsets. */
+ int i;
+
+ fontp->encoding[0] = fontp->encoding[1];
+ for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i < MAX_CHARSET; i++)
+ fontp->encoding[i] = fontp->encoding[1];
+ }
+ else
+ {
+ /* The font itself doesn't tell which code points to be used. */
+ int i;
+
+ /* At first, set 1 (means 0xA0..0xFF) as the default. */
+ fontp->encoding[0] = 1;
+ for (i = MIN_CHARSET_OFFICIAL_DIMENSION1; i < MAX_CHARSET; i++)
+ fontp->encoding[i] = 1;
+ /* Then override them by a specification in Vfont_encoding_alist. */
+ for (list = Vfont_encoding_alist; CONSP (list); list = XCONS (list)->cdr)
+ {
+ elt = XCONS (list)->car;
+ if (CONSP (elt)
+ && STRINGP (XCONS (elt)->car) && CONSP (XCONS (elt)->cdr)
+ && (fast_string_match_ignore_case (XCONS (elt)->car, fontname)
+ >= 0))
+ {
+ Lisp_Object tmp;
+
+ for (tmp = XCONS (elt)->cdr; CONSP (tmp); tmp = XCONS (tmp)->cdr)
+ if (CONSP (XCONS (tmp)->car)
+ && INTEGERP (XCONS (XCONS (tmp)->car)->car)
+ && ((i = get_charset_id (XCONS (XCONS (tmp)->car)->car))
+ >= 0)
+ && INTEGERP (XCONS (XCONS (tmp)->car)->cdr)
+ && XFASTINT (XCONS (XCONS (tmp)->car)->cdr) < 4)
+ fontp->encoding[i]
+ = XFASTINT (XCONS (XCONS (tmp)->car)->cdr);
+ }
+ }
+ }
+
+ fontp->font_encoder = (struct ccl_program *) 0;
+ for (list = Vfont_ccl_encoder_alist; CONSP (list); list = XCONS (list)->cdr)
+ {
+ elt = XCONS (list)->car;
+ if (CONSP (elt)
+ && STRINGP (XCONS (elt)->car) && VECTORP (XCONS (elt)->cdr)
+ && fast_string_match_ignore_case (XCONS (elt)->car, fontname) >= 0)
+ {
+ fontp->font_encoder
+ = (struct ccl_program *) xmalloc (sizeof (struct ccl_program));
+ setup_ccl_program (fontp->font_encoder, XCONS (elt)->cdr);
+ break;
+ }
+ }
+
+ if (fontsetp)
+ {
+ fontsetp->font_indexes[charset] = fontp->font_idx;
+ if (fontsetp->size == 0)
+ fontsetp->size = fontp->size / CHARSET_WIDTH (charset);
+
+ if (charset == CHARSET_ASCII
+ && fontsetp->size != fontp->size)
+ {
+ /* When loading ASCII font of the different size from the
+ size of FONTSET, we have to update the size of FONTSET.
+ Since changing the size of FONTSET may make some fonts
+ already loaded inappropriate to be used in FONTSET, we
+ must delete the record of such fonts. In that case, we
+ also have to calculate the height of FONTSET from the
+ remaining fonts. */
+ int i;
+
+ fontsetp->size = fontp->size;
+ fontsetp->height = fontp->height;
+ for (i = CHARSET_ASCII + 1; i < MAX_CHARSET; i++)
+ {
+ font_idx = fontsetp->font_indexes[i];
+ if (font_idx >= 0)
+ {
+ struct font_info *fontp2 = font_table + font_idx;
+
+ if (fontp2->size != fontp->size * CHARSET_WIDTH (i))
+ fontsetp->font_indexes[i] = FONT_NOT_OPENED;
+ else if (fontsetp->height < fontp->height)
+ fontsetp->height = fontp->height;
+ }
+ }
+ }
+ else if (fontsetp->height < fontp->height)
+ fontsetp->height = fontp->height;
+ }
+
+ return fontp;
+}
+
+/* Return ID of the fontset named NAME on frame F. */
+
+int
+fs_query_fontset (f, name)
+ FRAME_PTR f;
+ char *name;
+{
+ struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f);
+ int i;
+
+ for (i = 0; i < fontset_data->n_fontsets; i++)
+ if (!my_strcasecmp(name, fontset_data->fontset_table[i]->name))
+ return i;
+ return -1;
+}
+
+/* Register a fontset specified by FONTSET_INFO for frame FRAME.
+ Return the fontset ID if successfully registered, else return -1.
+ FONTSET_INFO is a cons of name of the fontset and FONTLIST, where
+ FONTLIST is an alist of charsets vs fontnames. */
+
+int
+fs_register_fontset (f, fontset_info)
+ FRAME_PTR f;
+ Lisp_Object fontset_info;
+{
+ struct fontset_data *fontset_data = FRAME_FONTSET_DATA (f);
+ Lisp_Object name, fontlist;
+ int fontset;
+ struct fontset_info *fontsetp;
+ int i;
+
+ if (!CONSP (fontset_info)
+ || !STRINGP (XCONS (fontset_info)->car)
+ || !CONSP (XCONS (fontset_info)->cdr))
+ /* Invalid data in FONTSET_INFO. */
+ return -1;
+
+ name = XCONS (fontset_info)->car;
+ if ((fontset = fs_query_fontset (f, XSTRING (name)->data)) >= 0)
+ /* This fontset already exists on frame F. */
+ return fontset;
+
+ fontsetp = (struct fontset_info *) xmalloc (sizeof (struct fontset_info));
+
+ fontsetp->name = (char *) xmalloc (XSTRING (name)->size + 1);
+ bcopy(XSTRING (name)->data, fontsetp->name, XSTRING (name)->size + 1);
+
+ fontsetp->size = fontsetp->height = 0;
+
+ for (i = 0; i < MAX_CHARSET; i++)
+ {
+ fontsetp->fontname[i] = (char *) 0;
+ fontsetp->font_indexes[i] = FONT_NOT_OPENED;
+ }
+
+ for (fontlist = XCONS (fontset_info)->cdr; CONSP (fontlist);
+ fontlist = XCONS (fontlist)->cdr)
+ {
+ Lisp_Object tem = Fcar (fontlist);
+ int charset;
+
+ if (CONSP (tem)
+ && (charset = get_charset_id (XCONS (tem)->car)) >= 0
+ && STRINGP (XCONS (tem)->cdr))
+ {
+ fontsetp->fontname[charset]
+ = (char *) xmalloc (XSTRING (XCONS (tem)->cdr)->size + 1);
+ bcopy (XSTRING (XCONS (tem)->cdr)->data,
+ fontsetp->fontname[charset],
+ XSTRING (XCONS (tem)->cdr)->size + 1);
+ }
+ else
+ /* Broken or invalid data structure. */
+ return -1;
+ }
+
+ /* Do we need to create the table? */
+ if (fontset_data->fontset_table_size == 0)
+ {
+ fontset_data->fontset_table_size = 8;
+ fontset_data->fontset_table
+ = (struct fontset_info **) xmalloc (fontset_data->fontset_table_size
+ * sizeof (struct fontset_info *));
+ }
+ /* Do we need to grow the table? */
+ else if (fontset_data->n_fontsets >= fontset_data->fontset_table_size)
+ {
+ fontset_data->fontset_table_size += 8;
+ fontset_data->fontset_table
+ = (struct fontset_info **) xrealloc (fontset_data->fontset_table,
+ fontset_data->fontset_table_size
+ * sizeof (struct fontset_info *));
+ }
+ fontset = fontset_data->n_fontsets++;
+ fontset_data->fontset_table[fontset] = fontsetp;
+
+ return fontset;
+}
+
+/* Cache data used by fontset_pattern_regexp. The car part is a
+ pattern string containing at least one wild card, the cdr part is
+ the corresponding regular expression. */
+static Lisp_Object Vcached_fontset_data;
+
+#define CACHED_FONTSET_NAME (XSTRING (XCONS (Vcached_fontset_data)->car)->data)
+#define CACHED_FONTSET_REGEX (XCONS (Vcached_fontset_data)->cdr)
+
+/* If fontset name PATTERN contains any wild card, return regular
+ expression corresponding to PATTERN. */
+
+Lisp_Object
+fontset_pattern_regexp (pattern)
+ Lisp_Object pattern;
+{
+ int nickname = 0;
+
+ if (!index (XSTRING (pattern)->data, '*')
+ && !index (XSTRING (pattern)->data, '?'))
+ /* PATTERN does not contain any wild cards. */
+ {
+ if (XSTRING (pattern)->size > 8
+ && ! bcmp (XSTRING (pattern)->data, "fontset-", 8))
+ /* Just a nickname of a fontset is specified. */
+ nickname = 1;
+ else
+ return Qnil;
+ }
+
+ if (!CONSP (Vcached_fontset_data)
+ || strcmp (XSTRING (pattern)->data, CACHED_FONTSET_NAME))
+ {
+ /* We must at first update the cached data. */
+ char *regex = (char *) alloca (XSTRING (pattern)->size * 2 + 3);
+ char *p0, *p1 = regex;
+
+ if (nickname)
+ {
+ /* Just prepend ".*-" to PATTERN. */
+ *p1++= '.'; *p1++= '*', *p1++= '-';
+ bcopy (XSTRING (pattern)->data, p1, XSTRING (pattern)->size);
+ p1 += XSTRING (pattern)->size;
+ }
+ else
+ {
+ /* Convert "*" to ".*", "?" to ".". */
+ *p1++ = '^';
+ for (p0 = XSTRING (pattern)->data; *p0; p0++)
+ {
+ if (*p0 == '*')
+ {
+ *p1++ = '.';
+ *p1++ = '*';
+ }
+ else if (*p0 == '?')
+ *p1++ == '.';
+ else
+ *p1++ = *p0;
+ }
+ }
+ *p1++ = '$';
+ *p1++ = 0;
+
+ Vcached_fontset_data = Fcons (build_string (XSTRING (pattern)->data),
+ build_string (regex));
+ }
+
+ return CACHED_FONTSET_REGEX;
+}
+
+DEFUN ("query-fontset", Fquery_fontset, Squery_fontset, 1, 1, 0,
+ "Return a fontset name which matches PATTERN, nil if no matching fontset.\n\
+PATTERN can contain `*' or `?' as a wild card\n\
+just like X's font name matching algorithm allows.")
+ (pattern)
+ Lisp_Object pattern;
+{
+ Lisp_Object regexp, tem;
+
+ (*check_window_system_func) ();
+
+ CHECK_STRING (pattern, 0);
+
+ if (XSTRING (pattern)->size == 0)
+ return Qnil;
+
+ regexp = fontset_pattern_regexp (pattern);
+
+ for (tem = Vglobal_fontset_alist; CONSP (tem); tem = XCONS (tem)->cdr)
+ {
+ Lisp_Object fontset_name = XCONS (XCONS (tem)->car)->car;
+ if (!NILP (regexp))
+ {
+ if (fast_string_match_ignore_case (regexp,
+ XSTRING (fontset_name)->data)
+ >= 0)
+ return fontset_name;
+ }
+ else
+ {
+ if (!my_strcasecmp (XSTRING (pattern)->data,
+ XSTRING (fontset_name)->data))
+ return fontset_name;
+ }
+ }
+
+ return Qnil;
+}
+
+Lisp_Object Fframe_char_width ();
+
+/* Return a list of names of available fontsets matching PATTERN on
+ frame F. If SIZE is not 0, it is the size (maximum bound width) of
+ fontsets to be listed. */
+
+Lisp_Object
+list_fontsets (f, pattern, size)
+ FRAME_PTR f;
+ Lisp_Object pattern;
+ int size;
+{
+ int i;
+ Lisp_Object regexp, val;
+
+ regexp = fontset_pattern_regexp (pattern);
+
+ val = Qnil;
+ for (i = 0; i < FRAME_FONTSET_DATA (f)->n_fontsets; i++)
+ {
+ struct fontset_info *fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[i];
+ int name_matched = 0;
+ int size_matched = 0;
+
+ if (!NILP (regexp))
+ {
+ if (fast_string_match_ignore_case (regexp, fontsetp->name) >= 0)
+ name_matched = 1;
+ }
+ else
+ {
+ if (!my_strcasecmp (XSTRING (pattern)->data, fontsetp->name))
+ name_matched = 1;
+ }
+
+ if (name_matched)
+ {
+ if (!size || fontsetp->size == size)
+ size_matched = 1;
+ else if (fontsetp->size == 0)
+ {
+ /* No font of this fontset has loaded yet. Try loading
+ one with SIZE. */
+ int j;
+
+ for (j = 0; j < MAX_CHARSET; j++)
+ if (fontsetp->fontname[j])
+ {
+ if ((*load_font_func) (f, fontsetp->fontname[j], size))
+ size_matched = 1;
+ break;
+ }
+ }
+
+ if (size_matched)
+ val = Fcons (build_string (fontsetp->name), val);
+ }
+ }
+
+ return val;
+}
+
+DEFUN ("new-fontset", Fnew_fontset, Snew_fontset, 2, 2, 0,
+ "Create a new fontset NAME which contains fonts in FONTLIST.\n\
+FONTLIST is an alist of charsets vs corresponding font names.")
+ (name, fontlist)
+ Lisp_Object name, fontlist;
+{
+ Lisp_Object fullname, fontset_info;
+ Lisp_Object tail;
+
+ (*check_window_system_func) ();
+
+ CHECK_STRING (name, 0);
+ CHECK_LIST (fontlist, 1);
+
+ fullname = Fquery_fontset (name);
+ if (!NILP (fullname))
+ error ("Fontset \"%s\" matches the existing fontset \"%s\"",
+ XSTRING (name)->data, XSTRING (fullname)->data);
+
+ /* Check the validity of FONTLIST. */
+ for (tail = fontlist; CONSP (tail); tail = XCONS (tail)->cdr)
+ {
+ Lisp_Object tem = XCONS (tail)->car;
+ int charset;
+
+ if (!CONSP (tem)
+ || (charset = get_charset_id (XCONS (tem)->car)) < 0
+ || !STRINGP (XCONS (tem)->cdr))
+ error ("Elements of fontlist must be a cons of charset and font name");
+ }
+
+ fontset_info = Fcons (name, fontlist);
+ Vglobal_fontset_alist = Fcons (fontset_info, Vglobal_fontset_alist);
+
+ /* Register this fontset for all existing frames. */
+ {
+ Lisp_Object framelist, frame;
+
+ FOR_EACH_FRAME (framelist, frame)
+ if (!FRAME_TERMCAP_P (XFRAME (frame)))
+ fs_register_fontset (XFRAME (frame), fontset_info);
+ }
+
+ return Qnil;
+}
+
+extern Lisp_Object Fframe_parameters ();
+extern Lisp_Object Qfont;
+Lisp_Object Qfontset;
+
+DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 4, 0,
+ "Set FONTNAME for a font of CHARSET in fontset NAME on frame FRAME.\n\
+If FRAME is omitted or nil, all frames are affected.")
+ (name, charset_symbol, fontname, frame)
+ Lisp_Object name, charset_symbol, fontname, frame;
+{
+ int charset;
+ Lisp_Object fullname, fontlist;
+
+ (*check_window_system_func) ();
+
+ CHECK_STRING (name, 0);
+ CHECK_SYMBOL (charset_symbol, 1);
+ CHECK_STRING (fontname, 2);
+ if (!NILP (frame))
+ CHECK_LIVE_FRAME (frame, 3);
+
+ if ((charset = get_charset_id (charset_symbol)) < 0)
+ error ("Invalid charset: %s", XSYMBOL (charset_symbol)->name->data);
+
+ fullname = Fquery_fontset (name);
+ if (NILP (fullname))
+ error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
+
+ /* If FRAME is not specified, we must, at first, update contents of
+ `global-fontset-alist' for a frame created in the future. */
+ if (NILP (frame))
+ {
+ Lisp_Object fontset_info = Fassoc (fullname, Vglobal_fontset_alist);
+ Lisp_Object tem = Fassq (charset, XCONS (fontset_info)->cdr);
+
+ if (NILP (tem))
+ XCONS (fontset_info)->cdr
+ = Fcons (Fcons (charset, fontname), XCONS (fontset_info)->cdr);
+ else
+ XCONS (tem)->cdr = fontname;
+ }
+
+ /* Then, update information in the specified frame or all existing
+ frames. */
+ {
+ Lisp_Object framelist, tem;
+
+ FOR_EACH_FRAME (framelist, tem)
+ if (!FRAME_TERMCAP_P (XFRAME (tem))
+ && (NILP (frame) || EQ (frame, tem)))
+ {
+ FRAME_PTR f = XFRAME (tem);
+ int fontset = fs_query_fontset (f, XSTRING (fullname)->data);
+ struct fontset_info *fontsetp
+ = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
+
+ if (fontsetp->fontname[XINT (charset)])
+ xfree (fontsetp->fontname[XINT (charset)]);
+ fontsetp->fontname[XINT (charset)]
+ = (char *) xmalloc (XSTRING (fontname)->size + 1);
+ bcopy (XSTRING (fontname)->data, fontsetp->fontname[XINT (charset)],
+ XSTRING (fontname)->size + 1);
+ fontsetp->font_indexes[XINT (charset)] = FONT_NOT_OPENED;
+
+ if (charset == CHARSET_ASCII)
+ {
+ Lisp_Object font_param = Fassq (Qfont, Fframe_parameters (tem));
+
+ if (set_frame_fontset_func
+ && !NILP (font_param)
+ && !strcmp (XSTRING (fullname)->data,
+ XSTRING (XCONS (font_param)->cdr)->data))
+ /* This fontset is the default fontset on frame TEM.
+ We may have to resize this frame because of new
+ ASCII font. */
+ (*set_frame_fontset_func) (f, fullname, Qnil);
+ }
+ }
+ }
+
+ return Qnil;
+}
+
+DEFUN ("font-info", Ffont_info, Sfont_info, 1, 2, 0,
+ "Return information about a font named NAME on frame FRAME.\n\
+If FRAME is omitted or nil, use the selected frame.\n\
+The returned value is a vector of OPENED-NAME, FULL-NAME, CHARSET, SIZE,\n\
+ HEIGHT, BASELINE-OFFSET, and RELATIVE-COMPOSE,\n\
+where\n\
+ OPENED-NAME is the name used for opening the font,\n\
+ FULL-NAME is the full name of the font,\n\
+ CHARSET is the charset displayed by the font,\n\
+ SIZE is the minimum bound width of the font,\n\
+ HEIGHT is the height of the font,\n\
+ BASELINE-OFFSET is the upward offset pixels from ASCII baseline,\n\
+ RELATIVE-COMPOSE is the number controlling how to compose characters.\n\
+If the named font is not yet loaded, return nil.")
+ (name, frame)
+ Lisp_Object name, frame;
+{
+ FRAME_PTR f;
+ struct font_info *fontp;
+ Lisp_Object info;
+
+ (*check_window_system_func) ();
+
+ CHECK_STRING (name, 0);
+ if (NILP (frame))
+ f = selected_frame;
+ else
+ {
+ CHECK_LIVE_FRAME (frame, 1);
+ f = XFRAME (frame);
+ }
+
+ if (!query_font_func)
+ error ("Font query function is not supported");
+
+ fontp = (*query_font_func) (f, XSTRING (name)->data);
+ if (!fontp)
+ return Qnil;
+
+ info = Fmake_vector (make_number (6), Qnil);
+
+ XVECTOR (info)->contents[0] = build_string (fontp->name);
+ XVECTOR (info)->contents[1] = build_string (fontp->full_name);
+ XVECTOR (info)->contents[2] = CHARSET_SYMBOL (fontp->charset);
+ XVECTOR (info)->contents[3] = make_number (fontp->size);
+ XVECTOR (info)->contents[4] = make_number (fontp->height);
+ XVECTOR (info)->contents[5] = make_number (fontp->baseline_offset);
+ XVECTOR (info)->contents[6] = make_number (fontp->relative_compose);
+
+ return info;
+}
+
+DEFUN ("fontset-info", Ffontset_info, Sfontset_info, 1, 2, 0,
+ "Return information about a fontset named NAME on frame FRAME.\n\
+If FRAME is omitted or nil, use the selected frame.\n\
+The returned value is a vector of SIZE, HEIGHT, and FONT-LIST,\n\
+where\n\
+ SIZE is the minimum bound width of ASCII font of the fontset,\n\
+ HEIGHT is the height of the tallest font in the fontset, and\n\
+ FONT-LIST is an alist of the format:\n\
+ (CHARSET REQUESTED-FONT-NAME LOADED-FONT-NAME).\n\
+LOADED-FONT-NAME t means the font is not yet loaded, nil means the\n\
+loading failed.")
+ (name, frame)
+ Lisp_Object name, frame;
+{
+ FRAME_PTR f;
+ int fontset;
+ struct fontset_info *fontsetp;
+ Lisp_Object info, val;
+ int i;
+
+ (*check_window_system_func) ();
+
+ CHECK_STRING(name, 0);
+ if (NILP (frame))
+ f = selected_frame;
+ else
+ {
+ CHECK_LIVE_FRAME (frame, 1);
+ f = XFRAME (frame);
+ }
+
+ fontset = fs_query_fontset (f, XSTRING (name)->data);
+ if (fontset < 0)
+ error ("Fontset \"%s\" does not exist", XSTRING (name)->data);
+
+ info = Fmake_vector (make_number (3), Qnil);
+
+ fontsetp = FRAME_FONTSET_DATA (f)->fontset_table[fontset];
+
+ XVECTOR (info)->contents[0] = make_number (fontsetp->size);
+ XVECTOR (info)->contents[1] = make_number (fontsetp->height);
+ val = Qnil;
+ for (i = 0; i < MAX_CHARSET; i++)
+ if (fontsetp->fontname[i])
+ {
+ int font_idx = fontsetp->font_indexes[i];
+ Lisp_Object loaded;
+
+ if (font_idx == FONT_NOT_OPENED)
+ loaded = Qt;
+ else if (font_idx == FONT_NOT_FOUND)
+ loaded = Qnil;
+ else
+ loaded
+ = build_string ((*get_font_info_func) (f, font_idx)->full_name);
+ val = Fcons (Fcons (CHARSET_SYMBOL (i),
+ Fcons (build_string (fontsetp->fontname[i]),
+ Fcons (loaded, Qnil))),
+ val);
+ }
+ XVECTOR (info)->contents[2] = val;
+ return info;
+}
+
+syms_of_fontset ()
+{
+ int i;
+
+ for (i = 0; i < 256; i++)
+ my_strcasetbl[i] = (i >= 'A' && i <= 'Z') ? i + 'a' - 'A' : i;
+
+ if (!load_font_func)
+ /* Window system initializer should have set proper functions. */
+ abort ();
+
+ staticpro (&Qfontset);
+
+ Vcached_fontset_data = Qnil;
+ staticpro (&Vcached_fontset_data);
+
+ DEFVAR_LISP ("global-fontset-alist", &Vglobal_fontset_alist,
+ "Internal data for fontset. Not for external use.\n\
+This is an alist associating fontset names with the lists of fonts\n\
+ contained in them.\n\
+Newly created frames make their own fontset database from here.");
+ Vglobal_fontset_alist = Qnil;
+
+ DEFVAR_LISP ("font-encoding-alist", &Vfont_encoding_alist,
+ "Alist of fontname patterns vs corresponding encoding info.\n\
+Each element looks like (REGEXP . ENCODING-INFO),\n\
+ where ENCODING-INFO is an alist of CHARSET vs ENCODING.\n\
+ENCODING is one of the following integer values:\n\
+ 0: code points 0x20..0x7F or 0x2020..0x7F7F are used,\n\
+ 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used,\n\
+ 2: code points 0x20A0..0x7FFF are used,\n\
+ 3: code points 0xA020..0xFF7F are used.");
+ Vfont_encoding_alist = Qnil;
+
+ defsubr (&Squery_fontset);
+ defsubr (&Snew_fontset);
+ defsubr (&Sset_fontset_font);
+ defsubr (&Sfont_info);
+ defsubr (&Sfontset_info);
+}
diff --git a/src/fontset.h b/src/fontset.h
new file mode 100644
index 00000000000..902f1691d6f
--- /dev/null
+++ b/src/fontset.h
@@ -0,0 +1,201 @@
+/* Header for fontset handler.
+ Ver.1.0
+
+ Copyright (C) 1995 Free Software Foundation, Inc.
+ Copyright (C) 1995 Electrotechnical Laboratory, JAPAN.
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
+
+#ifndef _FONTSET_H
+#define _FONTSET_H
+
+/*
+
+#define GENERIC_FONT_PTR void
+
+/* This data type is used for the font_table field of window system
+ depending data area (e.g. struct x_display_info on X window). */
+
+struct font_info
+{
+ /* Pointer to window system dependent font structure. On X window,
+ this value should be coerced to (XFontStruct *). */
+ void *font;
+
+ /* Index number of the font. */
+ int font_idx;
+
+ /* Name to be used to find the font. */
+ char *name;
+
+ /* Full name of the font given by a window system. */
+ char *full_name;
+
+ /* Charset of characters displayed by the font. */
+ int charset;
+
+ /* Maximum bound width over all existing characters of the font. On
+ X window, this is same as (font->max_bounds.width) */
+ int size;
+
+ /* Height of the font. On X window, this is same as (font->ascent
+ + font->descent). */
+ int height;
+
+ /* Encodings of the font indexed by CHARSET. The value an integer
+ 0, 1, 2, or 3:
+ 0: code points 0x20..0x7F or 0x2020..0x7F7F are used
+ 1: code points 0xA0..0xFF or 0xA0A0..0xFFFF are used
+ 2: code points 0x20A0..0x7FFF are used
+ 3: code points 0xA020..0xFF7F are used
+ For instance, ASCII and Latin-1 characters may use the same font
+ but different code points (ASCII uses 0x20..0x7F and Latin-1 uses
+ 0xA0..0xFF).
+
+ If the value can't be decided from information of the font, we
+ consult `font-encoding-alist' to get of the corresponding charset
+ whose default value is defined in lisp/fontset.el. Since there's
+ no charset whose id is 1, we use encoding[1] to store the
+ encoding information decided by the font itself. */
+ char encoding[MAX_CHARSET];
+
+ /* The baseline position of a font is normally `ascent' value of the
+ font. However, there exists many fonts which don't set `ascent'
+ an appropriate value to be used as baseline position. This is
+ typical in such ASCII fonts which are designed to be used with
+ Chinese, Japanese, Korean characters. When we use mixture of
+ such fonts and normal fonts (having correct `ascent' value), a
+ display line gets very ugly. Since we have no way to fix it
+ automatically, it is users responsibility to supply well designed
+ fonts or correct `ascent' value of fonts. But, the latter
+ requires heavy work (modifying all bitmap data in BDF files).
+ So, Emacs accepts a private font property
+ `_MULE_BASELINE_OFFSET'. If a font has this property, we
+ calculate the baseline position by subtracting the value from
+ `ascent'. In other words, the value indicates how many bits
+ higher we should draw a character of the font than normal ASCII
+ text for a better looking.
+
+ We also have to consider the fact that the concept of `baseline'
+ differs among languages to which each character belongs. For
+ instance, baseline should be at the bottom most position of all
+ glyphs for Chinese, Japanese, and Korean. But, many of existing
+ fonts for those characters doesn't have correct `ascent' values
+ because they are designed to be used with ASCII fonts. To
+ display characters of different language on the same line, the
+ best way will be to arrange them in the middle of the line. So,
+ in such a case, again, we utilize the font property
+ `_MULE_BASELINE_OFFSET'. If the value is larger than `ascent' we
+ calculate baseline so that a character is arranged in the middle
+ of a line. */
+
+ int baseline_offset;
+
+ /* Non zero means a character should be composed at a position
+ relative to the height (or depth) of previous glyphs in the
+ following cases:
+ (1) The bottom of the character is higher than this value. In
+ this case, the character is drawn above the previous glyphs.
+ (2) The top of the character is lower than 0 (i.e. baseline
+ height). In this case, the character is drawn beneath the
+ previous glyphs.
+
+ This value is take from a private font property
+ `_MULE_RELATIVE_COMPOSE' which is introduced by Emacs. */
+ int relative_compose;
+
+ /* CCL program to calculate code points of the font. */
+ struct ccl_program *font_encoder;
+};
+
+#define FONT_NOT_OPENED -1
+#define FONT_NOT_FOUND -2
+
+struct fontset_info
+{
+ /* Name of the fontset. */
+ char *name;
+
+ /* Size of the fontset. This is the same as the size of ASCII font
+ of this fontset. */
+ int size;
+
+ /* Height of the tallest font in the fontset. */
+ int height;
+
+ /* Table of font name for each character set. */
+ char *fontname[MAX_CHARSET];
+
+ /* Table of index numbers of fonts indexed by charset. If a font is
+ not yet loaded, the value is -1 (FONT_NOT_OPENED). If font
+ loading is failed, the value is -2 (FONT_NOT_FOUND). */
+ int font_indexes[MAX_CHARSET];
+};
+
+/* This data type is used for the fontset_data field of struct frame. */
+
+struct fontset_data
+{
+ /* A table of pointers to all the fontsets. */
+ struct fontset_info **fontset_table;
+
+ /* The current capacity of fontset_table. */
+ int fontset_table_size;
+
+ /* The number of fontsets actually stored in fontset_table.
+ fontset_table[n] is used and valid iff 0 <= n < n_fontsets.
+ 0 <= n_fontsets <= fontset_table_size. */
+ int n_fontsets;
+};
+
+/* The following six are window system dependent functions.
+ Initialization routine of each window system should set appropriate
+ functions to these variables. For instance, in case of X window,
+ x_term_init does this. */
+
+/* Return a pointer to struct font_info of font FONT_IDX of frame F. */
+extern struct font_info *(*get_font_info_func) (/* FRAME_PTR f;
+ int font_idx */);
+
+/* Return a list of font names which matches PATTERN. See the document of
+ `x-list-fonts' for more detail. */
+extern Lisp_Object (*list_fonts_func) (/* Lisp_Object pattern, face, frame,
+ width */);
+
+/* Load a font named NAME for frame F and return a pointer to the
+ information of the loaded font. If loading is failed, return -1. */
+extern struct font_info *(*load_font_func) (/* FRAME_PTR f; char *name */);
+
+/* Return a pointer to struct font_info of a font named NAME for frame F.
+ If no such font is loaded, return NULL. */
+extern struct font_info *(*query_font_func) (/* FRAME_PTR f; char *name */);
+
+/* Additional function for setting fontset or changing fontset
+ contents of frame F. This function may change the coordinate of
+ the frame. */
+extern void (*set_frame_fontset_func) (/* FRAME_PTR f; Lisp_Object arg, oldval */);
+
+/* Check if any window system is used now. */
+extern void (*check_window_system_func) ();
+
+extern struct fontset_data *alloc_fontset_data ();
+extern void free_fontset_data ();
+extern struct font_info *fs_load_font ();
+extern Lisp_Object list_fontsets ();
+extern Lisp_Object Vglobal_fontset_alist;
+
+extern Lisp_Object Qfontset;
+
+#endif /* _FONTSET_H */
View Lorry Controller Status