#include <config.h>
#include "lisp.h"
#include "buffer.h"
#include "charset.h"
#include "intervals.h"
Lisp_Object Qcomposition;
struct composition **composition_table;
static int composition_table_size;
int n_compositions;
Lisp_Object composition_hash_table;
Lisp_Object Vcompose_chars_after_function;
Lisp_Object Vcomposition_function_table;
Lisp_Object Qcomposition_function_table;
Lisp_Object composition_temp;
#define CHAR_WIDTH(c) \
(SINGLE_BYTE_CHAR_P (c) ? 1 : CHARSET_WIDTH (CHAR_CHARSET (c)))
#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX))
#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1)
int
get_composition_id (charpos, bytepos, nchars, prop, string)
int charpos, bytepos, nchars;
Lisp_Object prop, string;
{
Lisp_Object id, length, components, key, *key_contents;
int glyph_len;
struct Lisp_Hash_Table *hash_table = XHASH_TABLE (composition_hash_table);
int hash_index;
unsigned hash_code;
struct composition *cmp;
int i, ch;
if (nchars == 0 || !CONSP (prop))
goto invalid_composition;
id = XCAR (prop);
if (INTEGERP (id))
{
if (XINT (id) < 0 || XINT (id) >= n_compositions)
goto invalid_composition;
return XINT (id);
}
if (!CONSP (id))
goto invalid_composition;
length = XCAR (id);
if (!INTEGERP (length) || XINT (length) != nchars)
goto invalid_composition;
components = XCDR (id);
if (INTEGERP (components))
key = Fmake_vector (make_number (1), components);
else if (STRINGP (components) || CONSP (components))
key = Fvconcat (1, &components);
else if (VECTORP (components))
key = components;
else if (NILP (components))
{
key = Fmake_vector (make_number (nchars), Qnil);
if (STRINGP (string))
for (i = 0; i < nchars; i++)
{
FETCH_STRING_CHAR_ADVANCE (ch, string, charpos, bytepos);
XVECTOR (key)->contents[i] = make_number (ch);
}
else
for (i = 0; i < nchars; i++)
{
FETCH_CHAR_ADVANCE (ch, charpos, bytepos);
XVECTOR (key)->contents[i] = make_number (ch);
}
}
else
goto invalid_composition;
hash_index = hash_lookup (hash_table, key, &hash_code);
if (hash_index >= 0)
{
key = HASH_KEY (hash_table, hash_index);
id = HASH_VALUE (hash_table, hash_index);
XCAR (prop) = id;
XCDR (prop) = Fcons (make_number (nchars), Fcons (key, XCDR (prop)));
return XINT (id);
}
if (composition_table_size == 0)
{
composition_table_size = 256;
composition_table
= (struct composition **) xmalloc (sizeof (composition_table[0])
* composition_table_size);
}
else if (composition_table_size <= n_compositions)
{
composition_table_size += 256;
composition_table
= (struct composition **) xrealloc (composition_table,
sizeof (composition_table[0])
* composition_table_size);
}
key_contents = XVECTOR (key)->contents;
if (VECTORP (components) || CONSP (components))
{
int len = XVECTOR (key)->size;
if ((len % 2) == 0)
goto invalid_composition;
for (i = 0; i < len; i++)
{
if (!INTEGERP (key_contents[i]))
goto invalid_composition;
}
}
XSETFASTINT (id, n_compositions);
XCAR (prop) = id;
XCDR (prop) = Fcons (make_number (nchars), Fcons (key, XCDR (prop)));
hash_index = hash_put (hash_table, key, id, hash_code);
cmp = (struct composition *) xmalloc (sizeof (struct composition));
cmp->method = (NILP (components)
? COMPOSITION_RELATIVE
: ((INTEGERP (components) || STRINGP (components))
? COMPOSITION_WITH_ALTCHARS
: COMPOSITION_WITH_RULE_ALTCHARS));
cmp->hash_index = hash_index;
glyph_len = (cmp->method == COMPOSITION_WITH_RULE_ALTCHARS
? (XVECTOR (key)->size + 1) / 2
: XVECTOR (key)->size);
cmp->glyph_len = glyph_len;
cmp->offsets = (short *) xmalloc (sizeof (short) * glyph_len * 2);
cmp->font = NULL;
if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
{
cmp->width = 0;
for (i = 0; i < glyph_len; i++)
{
int this_width;
ch = XINT (key_contents[i]);
this_width = CHAR_WIDTH (ch);
if (cmp->width < this_width)
cmp->width = this_width;
}
}
else
{
float leftmost = 0.0, rightmost;
ch = XINT (key_contents[0]);
rightmost = CHAR_WIDTH (ch);
for (i = 1; i < glyph_len; i += 2)
{
int rule, gref, nref;
int this_width;
float this_left;
rule = XINT (key_contents[i]);
ch = XINT (key_contents[i + 1]);
this_width = CHAR_WIDTH (ch);
COMPOSITION_DECODE_RULE (rule, gref, nref);
this_left = (leftmost
+ (gref % 3) * (rightmost - leftmost) / 2.0
- (nref % 3) * this_width / 2.0);
if (this_left < leftmost)
leftmost = this_left;
if (this_left + this_width > rightmost)
rightmost = this_left + this_width;
}
cmp->width = rightmost - leftmost;
if (cmp->width < (rightmost - leftmost))
cmp->width++;
}
composition_table[n_compositions] = cmp;
return n_compositions++;
invalid_composition:
return -1;
}
int
find_composition (pos, limit, start, end, prop, object)
int pos, limit, *start, *end;
Lisp_Object *prop, object;
{
Lisp_Object val;
if (get_property_and_range (pos, Qcomposition, prop, start, end, object))
return 1;
if (limit < 0 || limit == pos)
return 0;
if (limit > pos)
{
val = Fnext_single_property_change (make_number (pos), Qcomposition,
object, make_number (limit));
pos = XINT (val);
if (pos == limit)
return 0;
}
else
{
if (get_property_and_range (pos - 1, Qcomposition, prop, start, end,
object))
return 1;
val = Fprevious_single_property_change (make_number (pos), Qcomposition,
object, make_number (limit));
pos = XINT (val);
if (pos == limit)
return 0;
pos--;
}
get_property_and_range (pos, Qcomposition, prop, start, end, object);
return 1;
}
static void
run_composition_function (from, to, prop)
int from, to;
Lisp_Object prop;
{
Lisp_Object func;
int start, end;
func = COMPOSITION_MODIFICATION_FUNC (prop);
if (from > BEGV
&& find_composition (from - 1, -1, &start, &end, &prop, Qnil)
&& !COMPOSITION_VALID_P (start, end, prop))
from = start;
if (to < ZV
&& find_composition (to, -1, &start, &end, &prop, Qnil)
&& !COMPOSITION_VALID_P (start, end, prop))
to = end;
if (!NILP (func))
call2 (func, make_number (from), make_number (to));
else if (!NILP (Ffboundp (Vcompose_chars_after_function)))
call3 (Vcompose_chars_after_function,
make_number (from), make_number (to), Qnil);
}
void
update_compositions (from, to, check_mask)
int from, to;
{
Lisp_Object prop;
int start, end;
if (inhibit_modification_hooks)
return;
if (! (BEGV <= from && from <= to && to <= ZV))
return;
if (check_mask & CHECK_HEAD)
{
if (from > BEGV
&& find_composition (from - 1, -1, &start, &end, &prop, Qnil))
{
if (from < end)
Fput_text_property (make_number (from), make_number (end),
Qcomposition,
Fcons (XCAR (prop), XCDR (prop)), Qnil);
run_composition_function (start, end, prop);
from = end;
}
else if (from < ZV
&& find_composition (from, -1, &start, &from, &prop, Qnil))
run_composition_function (start, from, prop);
}
if (check_mask & CHECK_INSIDE)
{
while (from < to - 1
&& find_composition (from, to, &start, &from, &prop, Qnil)
&& from < to - 1)
run_composition_function (start, from, prop);
}
if (check_mask & CHECK_TAIL)
{
if (from < to
&& find_composition (to - 1, -1, &start, &end, &prop, Qnil))
{
if (to < end)
Fput_text_property (make_number (start), make_number (to),
Qcomposition,
Fcons (XCAR (prop), XCDR (prop)), Qnil);
run_composition_function (start, end, prop);
}
else if (to < ZV
&& find_composition (to, -1, &start, &end, &prop, Qnil))
run_composition_function (start, end, prop);
}
}
void
make_composition_value_copy (list)
Lisp_Object list;
{
Lisp_Object plist, val;
for (; CONSP (list); list = XCDR (list))
{
plist = XCAR (XCDR (XCDR (XCAR (list))));
while (CONSP (plist) && CONSP (XCDR (plist)))
{
if (EQ (XCAR (plist), Qcomposition)
&& (val = XCAR (XCDR (plist)), CONSP (val)))
XCAR (XCDR (plist)) = Fcons (XCAR (val), XCDR (val));
plist = XCDR (XCDR (plist));
}
}
}
void
compose_text (start, end, components, modification_func, string)
int start, end;
Lisp_Object components, modification_func, string;
{
Lisp_Object prop;
prop = Fcons (Fcons (make_number (end - start), components),
modification_func);
Fput_text_property (make_number (start), make_number (end),
Qcomposition, prop, string);
}
void
compose_chars_in_text (start, end, string)
int start, end;
Lisp_Object string;
{
int count = 0;
struct gcpro gcpro1;
Lisp_Object tail, elt, val, to;
int skip_ascii;
int i, len, stop, c;
unsigned char *ptr, *pend;
if (! CHAR_TABLE_P (Vcomposition_function_table))
return;
if (STRINGP (string))
{
count = specpdl_ptr - specpdl;
GCPRO1 (string);
stop = end;
ptr = XSTRING (string)->data + string_char_to_byte (string, start);
pend = ptr + STRING_BYTES (XSTRING (string));
}
else
{
record_unwind_protect (save_excursion_restore, save_excursion_save ());
TEMP_SET_PT (start);
stop = (start < GPT && GPT < end ? GPT : end);
ptr = CHAR_POS_ADDR (start);
pend = CHAR_POS_ADDR (end);
}
record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil));
for (i = 0; i < 128; i++)
if (!NILP (CHAR_TABLE_REF (Vcomposition_function_table, i)))
break;
skip_ascii = (i == 128);
while (1)
{
if (skip_ascii)
while (start < stop && ASCII_BYTE_P (*ptr))
start++, ptr++;
if (start >= stop)
{
if (stop == end || start >= end)
break;
stop = end;
if (STRINGP (string))
ptr = XSTRING (string)->data + string_char_to_byte (string, start);
else
ptr = CHAR_POS_ADDR (start);
}
c = STRING_CHAR_AND_LENGTH (ptr, pend - ptr, len);
tail = CHAR_TABLE_REF (Vcomposition_function_table, c);
while (CONSP (tail))
{
elt = XCAR (tail);
if (CONSP (elt)
&& STRINGP (XCAR (elt))
&& !NILP (Ffboundp (XCDR (elt))))
{
if (STRINGP (string))
val = Fstring_match (XCAR (elt), string, make_number (start));
else
{
val = Flooking_at (XCAR (elt));
if (!NILP (val))
val = make_number (start);
}
if (INTEGERP (val) && XFASTINT (val) == start)
{
to = Fmatch_end (make_number (0));
val = call4 (XCDR (elt), val, to, XCAR (elt), string);
if (INTEGERP (val) && XINT (val) > 1)
{
start += XINT (val);
if (STRINGP (string))
ptr = XSTRING (string)->data + string_char_to_byte (string, start);
else
ptr = CHAR_POS_ADDR (start);
}
else
{
start++;
ptr += len;
}
break;
}
}
tail = XCDR (tail);
}
if (!CONSP (tail))
{
start++;
ptr += len;
}
}
unbind_to (count, Qnil);
if (STRINGP (string))
UNGCPRO;
}
DEFUN ("compose-region-internal", Fcompose_region_internal,
Scompose_region_internal, 2, 4, 0,
"Internal use only.\n\
\n\
Compose text in the region between START and END.\n\
Optional 3rd and 4th arguments are COMPONENTS and MODIFICATION-FUNC\n\
for the composition. See `compose-region' for more detial.")
(start, end, components, mod_func)
Lisp_Object start, end, components, mod_func;
{
validate_region (&start, &end);
if (!NILP (components)
&& !INTEGERP (components)
&& !CONSP (components)
&& !STRINGP (components))
CHECK_VECTOR (components, 2);
compose_text (XINT (start), XINT (end), components, mod_func, Qnil);
return Qnil;
}
DEFUN ("compose-string-internal", Fcompose_string_internal,
Scompose_string_internal, 3, 5, 0,
"Internal use only.\n\
\n\
Compose text between indices START and END of STRING.\n\
Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC\n\
for the composition. See `compose-string' for more detial.")
(string, start, end, components, mod_func)
Lisp_Object string, start, end, components, mod_func;
{
CHECK_STRING (string, 0);
CHECK_NUMBER (start, 1);
CHECK_NUMBER (end, 2);
if (XINT (start) < 0 ||
XINT (start) > XINT (end)
|| XINT (end) > XSTRING (string)->size)
args_out_of_range (start, end);
compose_text (XINT (start), XINT (end), components, mod_func, string);
return string;
}
DEFUN ("find-composition-internal", Ffind_composition_internal,
Sfind_composition_internal, 4, 4, 0,
"Internal use only.\n\
\n\
Return information about composition at or nearest to position POS.\n\
See `find-composition' for more detail.")
(pos, limit, string, detail_p)
Lisp_Object pos, limit, string, detail_p;
{
Lisp_Object prop, tail;
int start, end;
int id;
CHECK_NUMBER_COERCE_MARKER (pos, 0);
start = XINT (pos);
if (!NILP (limit))
{
CHECK_NUMBER_COERCE_MARKER (limit, 1);
end = XINT (limit);
}
else
end = -1;
if (!NILP (string))
{
CHECK_STRING (string, 2);
if (XINT (pos) < 0 || XINT (pos) > XSTRING (string)->size)
args_out_of_range (string, pos);
}
else
{
if (XINT (pos) < BEGV || XINT (pos) > ZV)
args_out_of_range (Fcurrent_buffer (), pos);
}
if (!find_composition (start, end, &start, &end, &prop, string))
return Qnil;
if (!COMPOSITION_VALID_P (start, end, prop))
return Fcons (make_number (start), Fcons (make_number (end),
Fcons (Qnil, Qnil)));
if (NILP (detail_p))
return Fcons (make_number (start), Fcons (make_number (end),
Fcons (Qt, Qnil)));
if (COMPOSITION_REGISTERD_P (prop))
id = COMPOSITION_ID (prop);
else
{
int start_byte = (NILP (string)
? CHAR_TO_BYTE (start)
: string_char_to_byte (string, start));
id = get_composition_id (start, start_byte, end - start, prop, string);
}
if (id >= 0)
{
Lisp_Object components, relative_p, mod_func;
enum composition_method method = COMPOSITION_METHOD (prop);
int width = composition_table[id]->width;
components = Fcopy_sequence (COMPOSITION_COMPONENTS (prop));
relative_p = (method == COMPOSITION_WITH_RULE_ALTCHARS
? Qnil : Qt);
mod_func = COMPOSITION_MODIFICATION_FUNC (prop);
tail = Fcons (components,
Fcons (relative_p,
Fcons (mod_func,
Fcons (make_number (width), Qnil))));
}
else
tail = Qnil;
return Fcons (make_number (start), Fcons (make_number (end), tail));
}
void
syms_of_composite ()
{
Qcomposition = intern ("composition");
staticpro (&Qcomposition);
{
Lisp_Object args[6];
extern Lisp_Object QCsize;
args[0] = QCtest;
args[1] = Qequal;
args[2] = QCweakness;
args[3] = Qnil;
args[4] = QCsize;
args[5] = make_number (311);
composition_hash_table = Fmake_hash_table (6, args);
staticpro (&composition_hash_table);
}
Vtext_property_default_nonsticky
= Fcons (Fcons (Qcomposition, Qt), Vtext_property_default_nonsticky);
DEFVAR_LISP ("compose-chars-after-function", &Vcompose_chars_after_function,
"Function to adjust composition of buffer text.\n\
\n\
The function is called with three arguments FROM, TO, and OBJECT.\n\
FROM and TO specify the range of text of which composition should be\n\
adjusted. OBJECT, if non-nil, is a string that contains the text.\n\
\n\
This function is called after a text with `composition' property is\n\
inserted or deleted to keep `composition' property of buffer text\n\
valid.\n\
\n\
The default value is the function `compose-chars-after'.");
Vcompose_chars_after_function = intern ("compose-chars-after");
Qcomposition_function_table = intern ("composition-function-table");
staticpro (&Qcomposition_function_table);
Qchar_table_extra_slots = intern ("char-table-extra-slots");
Fput (Qcomposition_function_table, Qchar_table_extra_slots, make_number (0));
DEFVAR_LISP ("composition-function-table", &Vcomposition_function_table,
"Char table of patterns and functions to make a composition.\n\
\n\
Each element is nil or an alist of PATTERNs vs FUNCs, where PATTERNs\n\
are regular expressions and FUNCs are functions. FUNC is responsible\n\
for composing text matching the corresponding PATTERN. FUNC is called\n\
with three arguments FROM, TO, and PATTERN. See the function\n\
`compose-chars-after' for more detail.\n\
\n\
This table is looked up by the first character of a composition when\n\
the composition gets invalid after a change in a buffer.");
Vcomposition_function_table
= Fmake_char_table (Qcomposition_function_table, Qnil);
defsubr (&Scompose_region_internal);
defsubr (&Scompose_string_internal);
defsubr (&Sfind_composition_internal);
}