/* Composite sequence support.
- Copyright (C) 2001-2013 Free Software Foundation, Inc.
+ Copyright (C) 2001-2014 Free Software Foundation, Inc.
Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
National Institute of Advanced Industrial Science and Technology (AIST)
Registration Number H14PRO021
#include <config.h>
-#define COMPOSITE_INLINE EXTERN_INLINE
-
#include "lisp.h"
#include "character.h"
#include "buffer.h"
cmp->method = method;
cmp->hash_index = hash_index;
cmp->glyph_len = glyph_len;
- cmp->offsets = xnmalloc (glyph_len, 2 * sizeof *cmp->offsets);
+ cmp->offsets = xnmalloc_atomic (glyph_len, 2 * sizeof *cmp->offsets);
cmp->font = NULL;
if (cmp->method != COMPOSITION_WITH_RULE_ALTCHARS)
}
if (min_pos < max_pos)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
specbind (Qinhibit_read_only, Qt);
specbind (Qinhibit_modification_hooks, Qt);
Fremove_list_of_text_properties (make_number (min_pos),
make_number (max_pos),
list1 (Qauto_composed), Qnil);
- unbind_to (count, Qnil);
+ dynwind_end ();
}
}
len = j;
}
- lint_assume (len <= TYPE_MAXIMUM (ptrdiff_t) - 2);
copy = Fmake_vector (make_number (len + 2), Qnil);
LGSTRING_SET_HEADER (copy, Fcopy_sequence (header));
for (i = 0; i < len; i++)
static Lisp_Object gstring_work_headers;
static Lisp_Object
-fill_gstring_header (Lisp_Object header, Lisp_Object start, Lisp_Object end,
- Lisp_Object font_object, Lisp_Object string)
+fill_gstring_header (Lisp_Object header, ptrdiff_t from, ptrdiff_t from_byte,
+ ptrdiff_t to, Lisp_Object font_object, Lisp_Object string)
{
- ptrdiff_t from, to, from_byte;
- ptrdiff_t len, i;
-
- if (NILP (string))
- {
- if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
- error ("Attempt to shape unibyte text");
- validate_region (&start, &end);
- from = XFASTINT (start);
- to = XFASTINT (end);
- from_byte = CHAR_TO_BYTE (from);
- }
- else
- {
- CHECK_STRING (string);
- if (! STRING_MULTIBYTE (string))
- error ("Attempt to shape unibyte text");
- /* The caller checks that START and END are nonnegative integers. */
- if (! (XINT (start) <= XINT (end) && XINT (end) <= SCHARS (string)))
- args_out_of_range_3 (string, start, end);
- from = XINT (start);
- to = XINT (end);
- from_byte = string_char_to_byte (string, from);
- }
+ ptrdiff_t len = to - from, i;
- len = to - from;
if (len == 0)
error ("Attempt to shape zero-length text");
if (VECTORP (header))
ptrdiff_t limit, struct window *win, struct face *face,
Lisp_Object string)
{
- ptrdiff_t count = SPECPDL_INDEX ();
+ dynwind_begin ();
struct frame *f = XFRAME (win->frame);
Lisp_Object pos = make_number (charpos);
ptrdiff_t to;
re = AREF (rule, 0);
if (NILP (re))
len = 1;
- else if (! STRINGP (re))
- return unbind_to (count, Qnil);
+ else if (! STRINGP (re)){
+
+ dynwind_end ();
+ return Qnil;
+ }
else if ((len = fast_looking_at (re, charpos, bytepos, limit, -1, string))
> 0)
{
else
len = string_byte_to_char (string, bytepos + len) - charpos;
}
- if (len <= 0)
- return unbind_to (count, Qnil);
+ if (len <= 0){
+
+ dynwind_end ();
+ return Qnil;
+ }
to = limit = charpos + len;
#ifdef HAVE_WINDOW_SYSTEM
if (FRAME_WINDOW_P (f))
if (! FONT_OBJECT_P (font_object)
|| (! NILP (re)
&& to < limit
- && (fast_looking_at (re, charpos, bytepos, to, -1, string) <= 0)))
- return unbind_to (count, Qnil);
+ && (fast_looking_at (re, charpos, bytepos, to, -1, string) <= 0))){
+
+ dynwind_end ();
+ return Qnil;
+ }
}
else
#endif /* not HAVE_WINDOW_SYSTEM */
lgstring = safe_call (6, Vauto_composition_function, AREF (rule, 2),
pos, make_number (to), font_object, string);
}
- return unbind_to (count, lgstring);
+ dynwind_end ();
+ return lgstring;
}
-static Lisp_Object _work_val;
-
/* 1 iff the character C is composable. Characters of general
category Z? or C? are not composable except for ZWNJ and ZWJ. */
-#define CHAR_COMPOSABLE_P(C) \
- ((C) > ' ' \
- && ((C) == 0x200C || (C) == 0x200D \
- || (_work_val = CHAR_TABLE_REF (Vunicode_category_table, (C)), \
- (INTEGERP (_work_val) \
- && (XINT (_work_val) <= UNICODE_CATEGORY_So)))))
+static bool
+char_composable_p (int c)
+{
+ Lisp_Object val;
+ return (c > ' '
+ && (c == 0x200C || c == 0x200D
+ || (val = CHAR_TABLE_REF (Vunicode_category_table, c),
+ (INTEGERP (val) && (XINT (val) <= UNICODE_CATEGORY_So)))));
+}
/* Update cmp_it->stop_pos to the next position after CHARPOS (and
BYTEPOS) where character composition may happen. If BYTEPOS is
p = SDATA (string) + bytepos;
c = STRING_CHAR_AND_LENGTH (p, len);
limit = bytepos + len;
- while (CHAR_COMPOSABLE_P (c))
+ while (char_composable_p (c))
{
val = CHAR_TABLE_REF (Vcomposition_function_table, c);
if (! NILP (val))
/* Skip all uncomposable characters. */
if (NILP (string))
{
- while (charpos - 1 > endpos && ! CHAR_COMPOSABLE_P (c))
+ while (charpos - 1 > endpos && ! char_composable_p (c))
{
DEC_BOTH (charpos, bytepos);
c = FETCH_MULTIBYTE_CHAR (bytepos);
}
else
{
- while (charpos - 1 > endpos && ! CHAR_COMPOSABLE_P (c))
+ while (charpos - 1 > endpos && ! char_composable_p (c))
{
p--;
while (! CHAR_HEAD_P (*p))
/* Check if the character at CHARPOS (and BYTEPOS) is composed
(possibly with the following characters) on window W. ENDPOS limits
- characters to be composed. FACE, in non-NULL, is a base face of
+ characters to be composed. FACE, if non-NULL, is a base face of
the character. If STRING is not nil, it is a string containing the
character to check, and CHARPOS and BYTEPOS are indices in the
string. In that case, FACE must not be NULL.
cmp_it->width = 0;
for (i = cmp_it->nchars - 1; i >= 0; i--)
{
- c = XINT (LGSTRING_CHAR (gstring, i));
+ c = XINT (LGSTRING_CHAR (gstring, from + i));
cmp_it->nbytes += CHAR_BYTES (c);
cmp_it->width += CHAR_WIDTH (c);
}
|-B-|-C-|--D--|
Here, it is known that characters after positions 1 and 9 can
- never be composed (i.e. ! CHAR_COMPOSABLE_P (CH)), and
+ never be composed (i.e. ! char_composable_p (CH)), and
composition A is an invalid one because it's partially covered by
the valid composition C. And to know whether a composition is
valid or not, the only way is to start searching forward from a
while (1)
{
c = STRING_CHAR (cur.p);
- if (! CHAR_COMPOSABLE_P (c))
+ if (! char_composable_p (c))
{
if (limit <= pos) /* case (1) */
{
return 0;
BACKWARD_CHAR (cur, stop);
c = STRING_CHAR (cur.p);
- } while (! CHAR_COMPOSABLE_P (c));
+ } while (! char_composable_p (c));
fore_check_limit = cur.pos + 1;
}
else /* case (2) */
prev = cur;
BACKWARD_CHAR (cur, stop);
c = STRING_CHAR (cur.p);
- if (! CHAR_COMPOSABLE_P (c))
+ if (! char_composable_p (c))
{
cur = prev;
break;
frame, or nil for the selected frame's terminal device.
If the optional 4th argument STRING is not nil, it is a string
-containing the target characters between indices FROM and TO.
+containing the target characters between indices FROM and TO,
+which are treated as in `substring'. Otherwise FROM and TO are
+character positions in current buffer; they can be in either order,
+and can be integers or markers.
A glyph-string is a vector containing information about how to display
a specific character sequence. The format is:
(Lisp_Object from, Lisp_Object to, Lisp_Object font_object, Lisp_Object string)
{
Lisp_Object gstring, header;
- ptrdiff_t frompos, topos;
+ ptrdiff_t frompos, frombyte, topos;
- CHECK_NATNUM (from);
- CHECK_NATNUM (to);
if (! FONT_OBJECT_P (font_object))
{
struct coding_system *coding;
font_object = CODING_ID_NAME (coding->id);
}
- header = fill_gstring_header (Qnil, from, to, font_object, string);
+ if (NILP (string))
+ {
+ if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
+ error ("Attempt to shape unibyte text");
+ validate_region (&from, &to);
+ frompos = XFASTINT (from);
+ topos = XFASTINT (to);
+ frombyte = CHAR_TO_BYTE (frompos);
+ }
+ else
+ {
+ CHECK_STRING (string);
+ validate_subarray (string, from, to, SCHARS (string), &frompos, &topos);
+ if (! STRING_MULTIBYTE (string))
+ error ("Attempt to shape unibyte text");
+ frombyte = string_char_to_byte (string, frompos);
+ }
+
+ header = fill_gstring_header (Qnil, frompos, frombyte,
+ topos, font_object, string);
gstring = gstring_lookup_cache (header);
if (! NILP (gstring))
return gstring;
- frompos = XINT (from);
- topos = XINT (to);
if (LGSTRING_GLYPH_LEN (gstring_work) < topos - frompos)
gstring_work = Fmake_vector (make_number (topos - frompos + 2), Qnil);
LGSTRING_SET_HEADER (gstring_work, header);
Scompose_string_internal, 3, 5, 0,
doc: /* Internal use only.
-Compose text between indices START and END of STRING.
-Optional 4th and 5th arguments are COMPONENTS and MODIFICATION-FUNC
+Compose text between indices START and END of STRING, where
+START and END are treated as in `substring'. Optional 4th
+and 5th arguments are COMPONENTS and MODIFICATION-FUNC
for the composition. See `compose-string' for more details. */)
- (Lisp_Object string, Lisp_Object start, Lisp_Object end, Lisp_Object components, Lisp_Object modification_func)
+ (Lisp_Object string, Lisp_Object start, Lisp_Object end,
+ Lisp_Object components, Lisp_Object modification_func)
{
- CHECK_STRING (string);
- CHECK_NUMBER (start);
- CHECK_NUMBER (end);
-
- if (XINT (start) < 0 ||
- XINT (start) > XINT (end)
- || XINT (end) > SCHARS (string))
- args_out_of_range (start, end);
+ ptrdiff_t from, to;
- compose_text (XINT (start), XINT (end), components, modification_func, string);
+ CHECK_STRING (string);
+ validate_subarray (string, start, end, SCHARS (string), &from, &to);
+ compose_text (from, to, components, modification_func, string);
return string;
}
if (NILP (detail_p))
return list3 (make_number (start), make_number (end), Qt);
- if (COMPOSITION_REGISTERD_P (prop))
+ if (composition_registered_p (prop))
id = COMPOSITION_ID (prop);
else
{
{
int i;
+#include "composite.x"
+
DEFSYM (Qcomposition, "composition");
/* Make a hash table for static composition. */
See also the documentation of `auto-composition-mode'. */);
Vcomposition_function_table = Fmake_char_table (Qnil, Qnil);
-
- defsubr (&Scompose_region_internal);
- defsubr (&Scompose_string_internal);
- defsubr (&Sfind_composition_internal);
- defsubr (&Scomposition_get_gstring);
}
HCoop / bpt / emacs.git / blobdiff