void
record_insert (ptrdiff_t beg, ptrdiff_t length)
{
Lisp_Object lbeg, lend;
if (EQ (BVAR (current_buffer, undo_list), Qt))
return;
record_point (beg);
/* If this is following another insertion and consecutive with it
in the buffer, combine the two. */
if (CONSP (BVAR (current_buffer, undo_list)))
{
Lisp_Object elt;
elt = XCAR (BVAR (current_buffer, undo_list));
if (CONSP (elt)
&& INTEGERP (XCAR (elt))
&& INTEGERP (XCDR (elt))
&& XINT (XCDR (elt)) == beg)
{
XSETCDR (elt, make_number (beg + length));
return;
}
}
XSETFASTINT (lbeg, beg);
XSETINT (lend, beg + length);
bset_undo_list (current_buffer,
Fcons (Fcons (lbeg, lend), BVAR (current_buffer, undo_list)));
}
/* _%get-mvalues-val */
obj_t BGl__z52getzd2mvalueszd2valz52zz__r5_control_features_6_4z00(obj_t
BgL_envz00_906, obj_t BgL_nz00_907)
{
AN_OBJECT;
{ /* Ieee/control5.scm 78 */
{ /* Ieee/control5.scm 79 */
int BgL_nz00_927;
{ /* Ieee/control5.scm 79 */
obj_t BgL_auxz00_952;
if (INTEGERP(BgL_nz00_907))
{ /* Ieee/control5.scm 79 */
BgL_auxz00_952 = BgL_nz00_907;
}
else
{
obj_t BgL_auxz00_955;
BgL_auxz00_955 =
BGl_typezd2errorzd2zz__errorz00
(BGl_string1520z00zz__r5_control_features_6_4z00,
BINT(((long) 3056)),
BGl_string1523z00zz__r5_control_features_6_4z00,
BGl_string1522z00zz__r5_control_features_6_4z00, BgL_nz00_907);
FAILURE(BgL_auxz00_955, BFALSE, BFALSE);
}
BgL_nz00_927 = CINT(BgL_auxz00_952);
}
return BGL_MVALUES_VAL(BgL_nz00_927);
}
}
}
static int
parse_sound (Lisp_Object sound, Lisp_Object *attrs)
{
/* SOUND must be a list starting with the symbol `sound'. */
if (!CONSP (sound) || !EQ (XCAR (sound), Qsound))
return 0;
sound = XCDR (sound);
attrs[SOUND_FILE] = Fplist_get (sound, QCfile);
attrs[SOUND_DATA] = Fplist_get (sound, QCdata);
attrs[SOUND_DEVICE] = Fplist_get (sound, QCdevice);
attrs[SOUND_VOLUME] = Fplist_get (sound, QCvolume);
#ifndef WINDOWSNT
/* File name or data must be specified. */
if (!STRINGP (attrs[SOUND_FILE])
&& !STRINGP (attrs[SOUND_DATA]))
return 0;
#else /* WINDOWSNT */
/*
Data is not supported in Windows. Therefore a
File name MUST be supplied.
*/
if (!STRINGP (attrs[SOUND_FILE]))
{
return 0;
}
#endif /* WINDOWSNT */
/* Volume must be in the range 0..100 or unspecified. */
if (!NILP (attrs[SOUND_VOLUME]))
{
if (INTEGERP (attrs[SOUND_VOLUME]))
{
if (XINT (attrs[SOUND_VOLUME]) < 0
|| XINT (attrs[SOUND_VOLUME]) > 100)
return 0;
}
else if (FLOATP (attrs[SOUND_VOLUME]))
{
if (XFLOAT_DATA (attrs[SOUND_VOLUME]) < 0
|| XFLOAT_DATA (attrs[SOUND_VOLUME]) > 1)
return 0;
}
else
return 0;
}
#ifndef WINDOWSNT
/* Device must be a string or unspecified. */
if (!NILP (attrs[SOUND_DEVICE])
&& !STRINGP (attrs[SOUND_DEVICE]))
return 0;
#endif /* WINDOWSNT */
/*
Since device is ignored in Windows, it does not matter
what it is.
*/
return 1;
}
char* whatis(Lisp_Object object) {
debug_print_buf[0] = '\0';
debug_print_buf[80] = '\0';
if (STRINGP(object)) {
snprintf(debug_print_buf, 80, "String %s", SSDATA(object));
return debug_print_buf;
} else if (INTEGERP(object)) {
int x = XINT(object);
snprintf(debug_print_buf, 80, "Number %d", x);
return debug_print_buf;
} else if (FLOATP(object)) {
struct Lisp_Float* floater = XFLOAT(object);
return "It's a float number!";
} else if (Qnil == object)
return "It's a lisp null";
else if (Qt == object)
return "It's a lisp 't'";
else if (SYMBOLP(object)) {
snprintf(debug_print_buf, 80, "Symbol named %s", SYMBOL_NAME(object));
return debug_print_buf;
} else if (CONSP(object))
return "It's a list!";
else if (MISCP(object))
return "It's a lisp misc!";
else if (VECTORLIKEP(object))
return "It's some kind of vector like thingie!";
else
return "I don't know what it is.";
}
// concatenate two symbols, or a symbol and a string or a symbol and an integer
// the result is a symbol in the module of the first symbol
symbol *append_symbol(symbol *s1, OID s2)
{ OID i;
char *ss1 = s1->name;
ClEnv->bufferStart();
for (i = 0; ss1[i] != '\0'; i++) ClEnv->pushChar(ss1[i]);
if INTEGERP(s2) ClEnv->pushInteger(s2);
else {if (OWNER(s2) == Kernel._symbol) ss1 = OBJECT(symbol,s2)->name;
/* _%set-mvalues-val! */
obj_t BGl__z52setzd2mvalueszd2valz12z40zz__r5_control_features_6_4z00(obj_t
BgL_envz00_908, obj_t BgL_nz00_909, obj_t BgL_oz00_910)
{
AN_OBJECT;
{ /* Ieee/control5.scm 84 */
{ /* Ieee/control5.scm 85 */
int BgL_nz00_928;
{ /* Ieee/control5.scm 85 */
obj_t BgL_auxz00_962;
if (INTEGERP(BgL_nz00_909))
{ /* Ieee/control5.scm 85 */
BgL_auxz00_962 = BgL_nz00_909;
}
else
{
obj_t BgL_auxz00_965;
BgL_auxz00_965 =
BGl_typezd2errorzd2zz__errorz00
(BGl_string1520z00zz__r5_control_features_6_4z00,
BINT(((long) 3343)),
BGl_string1524z00zz__r5_control_features_6_4z00,
BGl_string1522z00zz__r5_control_features_6_4z00, BgL_nz00_909);
FAILURE(BgL_auxz00_965, BFALSE, BFALSE);
}
BgL_nz00_928 = CINT(BgL_auxz00_962);
}
return BGL_MVALUES_VAL_SET(BgL_nz00_928, BgL_oz00_910);
}
}
}
static void
xftfont_add_rendering_parameters (FcPattern *pat, Lisp_Object entity)
{
Lisp_Object tail;
int ival;
for (tail = AREF (entity, FONT_EXTRA_INDEX); CONSP (tail); tail = XCDR (tail))
{
Lisp_Object key = XCAR (XCAR (tail));
Lisp_Object val = XCDR (XCAR (tail));
if (EQ (key, QCantialias))
FcPatternAddBool (pat, FC_ANTIALIAS, NILP (val) ? FcFalse : FcTrue);
else if (EQ (key, QChinting))
FcPatternAddBool (pat, FC_HINTING, NILP (val) ? FcFalse : FcTrue);
else if (EQ (key, QCautohint))
FcPatternAddBool (pat, FC_AUTOHINT, NILP (val) ? FcFalse : FcTrue);
else if (EQ (key, QChintstyle))
{
if (INTEGERP (val))
FcPatternAddInteger (pat, FC_HINT_STYLE, XINT (val));
else if (SYMBOLP (val)
&& FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival))
FcPatternAddInteger (pat, FC_HINT_STYLE, ival);
}
else if (EQ (key, QCrgba))
{
if (INTEGERP (val))
FcPatternAddInteger (pat, FC_RGBA, XINT (val));
else if (SYMBOLP (val)
&& FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival))
FcPatternAddInteger (pat, FC_RGBA, ival);
}
else if (EQ (key, QClcdfilter))
{
if (INTEGERP (val))
FcPatternAddInteger (pat, FC_LCD_FILTER, ival = XINT (val));
else if (SYMBOLP (val)
&& FcNameConstant (SDATA (SYMBOL_NAME (val)), &ival))
FcPatternAddInteger (pat, FC_LCD_FILTER, ival);
}
#ifdef FC_EMBOLDEN
else if (EQ (key, QCembolden))
FcPatternAddBool (pat, FC_EMBOLDEN, NILP (val) ? FcFalse : FcTrue);
#endif
}
}
static void
record_backtrace (log_t *log, EMACS_INT count)
{
Lisp_Object backtrace;
ptrdiff_t index;
if (!INTEGERP (log->next_free))
/* FIXME: transfer the evicted counts to a special entry rather
than dropping them on the floor. */
evict_lower_half (log);
index = XINT (log->next_free);
/* Get a "working memory" vector. */
backtrace = HASH_KEY (log, index);
get_backtrace (backtrace);
{ /* We basically do a `gethash+puthash' here, except that we have to be
careful to avoid memory allocation since we're in a signal
handler, and we optimize the code to try and avoid computing the
hash+lookup twice. See fns.c:Fputhash for reference. */
EMACS_UINT hash;
ptrdiff_t j = hash_lookup (log, backtrace, &hash);
if (j >= 0)
{
EMACS_INT old_val = XINT (HASH_VALUE (log, j));
EMACS_INT new_val = saturated_add (old_val, count);
set_hash_value_slot (log, j, make_number (new_val));
}
else
{ /* BEWARE! hash_put in general can allocate memory.
But currently it only does that if log->next_free is nil. */
int j;
eassert (!NILP (log->next_free));
j = hash_put (log, backtrace, make_number (count), hash);
/* Let's make sure we've put `backtrace' right where it
already was to start with. */
eassert (index == j);
/* FIXME: If the hash-table is almost full, we should set
some global flag so that some Elisp code can offload its
data elsewhere, so as to avoid the eviction code.
There are 2 ways to do that, AFAICT:
- Set a flag checked in QUIT, such that QUIT can then call
Fprofiler_cpu_log and stash the full log for later use.
- Set a flag check in post-gc-hook, so that Elisp code can call
profiler-cpu-log. That gives us more flexibility since that
Elisp code can then do all kinds of fun stuff like write
the log to disk. Or turn it right away into a call tree.
Of course, using Elisp is generally preferable, but it may
take longer until we get a chance to run the Elisp code, so
there's more risk that the table will get full before we
get there. */
}
}
}
static intmax_t
module_extract_integer (emacs_env *env, emacs_value n)
{
MODULE_FUNCTION_BEGIN (0);
Lisp_Object l = value_to_lisp (n);
if (! INTEGERP (l))
{
module_wrong_type (env, Qintegerp, l);
return 0;
}
return XINT (l);
}
static void
store_function_docstring (Lisp_Object obj, ptrdiff_t offset)
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
{
intptr_t negative_offset = - offset;
XSUBR (fun)->doc = (char *) negative_offset;
}
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
{
Lisp_Object tem;
tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
/* FIXME: This modifies typically pure hash-cons'd data, so its
correctness is quite delicate. */
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset);
}
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
else
{
AUTO_STRING (format, "No docstring slot for %s");
CALLN (Fmessage, format,
(SYMBOLP (obj)
? SYMBOL_NAME (obj)
: build_string ("<anonymous>")));
}
}
}
max_value self_forward(value x)
{
struct obj *obj;
if (ATOMP(x) || INTEGERP(x) || !x)
return (max_value)x;
obj = x;
if (obj->forwarded)
return obj->size;
save_copy_and_scan(&self_layout, obj, obj->size);
}
static LispObject Abs(LispObject args)
{
CHECK_NUMBER(args);
if (FLOATP(args)) {
double r = fabs(LFLOAT(args)->value);
return MakeFloat(r);
}
if (INTEGERP(args)) {
int r = abs(LINTEGER(args));
return MakeInteger(r);
}
return Qnil;
}
/* _process-send-signal */
obj_t BGl__processzd2sendzd2signalz00zz__processz00(obj_t BgL_envz00_1484,
obj_t BgL_procz00_1485, obj_t BgL_signalz00_1486)
{
AN_OBJECT;
{ /* Llib/process.scm 177 */
{ /* Llib/process.scm 178 */
obj_t BgL_procz00_1539;
int BgL_signalz00_1540;
if (PROCESSP(BgL_procz00_1485))
{ /* Llib/process.scm 178 */
BgL_procz00_1539 = BgL_procz00_1485;
}
else
{
obj_t BgL_auxz00_1638;
BgL_auxz00_1638 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2202z00zz__processz00,
BINT(((long) 7794)), BGl_string2211z00zz__processz00,
BGl_string2204z00zz__processz00, BgL_procz00_1485);
FAILURE(BgL_auxz00_1638, BFALSE, BFALSE);
}
{ /* Llib/process.scm 178 */
obj_t BgL_auxz00_1642;
if (INTEGERP(BgL_signalz00_1486))
{ /* Llib/process.scm 178 */
BgL_auxz00_1642 = BgL_signalz00_1486;
}
else
{
obj_t BgL_auxz00_1645;
BgL_auxz00_1645 =
BGl_typezd2errorzd2zz__errorz00(BGl_string2202z00zz__processz00,
BINT(((long) 7794)), BGl_string2211z00zz__processz00,
BGl_string2212z00zz__processz00, BgL_signalz00_1486);
FAILURE(BgL_auxz00_1645, BFALSE, BFALSE);
}
BgL_signalz00_1540 = CINT(BgL_auxz00_1642);
}
return c_process_send_signal(BgL_procz00_1539, BgL_signalz00_1540);
}
}
}
int
lookup_fringe_bitmap (Lisp_Object bitmap)
{
int bn;
bitmap = Fget (bitmap, Qfringe);
if (!INTEGERP (bitmap))
return 0;
bn = XINT (bitmap);
if (bn > NO_FRINGE_BITMAP
&& bn < max_used_fringe_bitmap
&& (bn < MAX_STANDARD_FRINGE_BITMAPS
|| fringe_bitmaps[bn] != NULL))
return bn;
return 0;
}
static void
store_function_docstring (Lisp_Object obj, EMACS_INT offset)
/* Use EMACS_INT because we get offset from pointer subtraction. */
{
/* Don't use indirect_function here, or defaliases will apply their
docstrings to the base functions (Bug#2603). */
Lisp_Object fun = SYMBOLP (obj) ? XSYMBOL (obj)->function : obj;
/* The type determines where the docstring is stored. */
/* Lisp_Subrs have a slot for it. */
if (SUBRP (fun))
{
intptr_t negative_offset = - offset;
XSUBR (fun)->doc = (char *) negative_offset;
}
/* If it's a lisp form, stick it in the form. */
else if (CONSP (fun))
{
Lisp_Object tem;
tem = XCAR (fun);
if (EQ (tem, Qlambda) || EQ (tem, Qautoload)
|| (EQ (tem, Qclosure) && (fun = XCDR (fun), 1)))
{
tem = Fcdr (Fcdr (fun));
if (CONSP (tem) && INTEGERP (XCAR (tem)))
XSETCAR (tem, make_number (offset));
}
else if (EQ (tem, Qmacro))
store_function_docstring (XCDR (fun), offset);
}
/* Bytecode objects sometimes have slots for it. */
else if (COMPILEDP (fun))
{
/* This bytecode object must have a slot for the
docstring, since we've found a docstring for it. */
if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_DOC_STRING)
ASET (fun, COMPILED_DOC_STRING, make_number (offset));
}
}
static void print_object(l_object obj)
{
extern char iobuf[];
if (NILP(obj)) {
writestr("nil");
} else if (INTEGERP(obj)) {
snprintf(iobuf, IOBUF_SIZE, "%d", (int) XINT(obj));
writestr(iobuf);
} else if (SYMBOLP(obj)) {
writestr(XSYMBOL(obj)->name);
} else if (CONSP(obj)) {
writestr("(");
print_list(obj);
writestr(")");
} else {
abort();
}
}
static max_value avr_forward(value x)
{
struct obj *obj;
if (ATOMP(x))
return AVR_MAKE_ATOM(ATOM_VALUE(x));
if (INTEGERP(x))
return (avr_value)x; /* Warning: implicit mod operation */
if (!x)
return 0;
obj = x;
if (obj->forwarded)
return obj->size;
save_copy_and_scan(&avr_layout, obj);
return obj->size;
}
/*---------------------------------------------------------------------*/
BGL_EXPORTED_DEF
long
obj_to_cobj( obj_t obj ) {
if( INTEGERP( obj ) )
return (long)CINT( obj );
if( BOOLEANP( obj ) )
return (long)((long)CBOOL( obj ));
if( STRINGP( obj ) )
return (long)BSTRING_TO_STRING( obj );
if( CHARP( obj ) )
return (long)((long)CCHAR( obj ));
if( FOREIGNP( obj ) )
return (long)FOREIGN_TO_COBJ( obj );
if( REALP( obj ) )
return (long)the_failure( string_to_bstring( "obj->cobj" ),
string_to_bstring( "Can't cast a real to foreign" ),
obj);
else
return (long)the_failure( string_to_bstring( "obj->cobj" ),
string_to_bstring( "Illegal object type" ),
obj);
}
/* _%set-mvalues-number! */
obj_t BGl__z52setzd2mvalueszd2numberz12z40zz__r5_control_features_6_4z00(obj_t
BgL_envz00_904, obj_t BgL_nz00_905)
{
AN_OBJECT;
{ /* Ieee/control5.scm 72 */
{ /* Ieee/control5.scm 73 */
int BgL_auxz00_940;
{ /* Ieee/control5.scm 73 */
int BgL_nz00_926;
{ /* Ieee/control5.scm 73 */
obj_t BgL_auxz00_941;
if (INTEGERP(BgL_nz00_905))
{ /* Ieee/control5.scm 73 */
BgL_auxz00_941 = BgL_nz00_905;
}
else
{
obj_t BgL_auxz00_944;
BgL_auxz00_944 =
BGl_typezd2errorzd2zz__errorz00
(BGl_string1520z00zz__r5_control_features_6_4z00,
BINT(((long) 2768)),
BGl_string1521z00zz__r5_control_features_6_4z00,
BGl_string1522z00zz__r5_control_features_6_4z00,
BgL_nz00_905);
FAILURE(BgL_auxz00_944, BFALSE, BFALSE);
}
BgL_nz00_926 = CINT(BgL_auxz00_941);
}
BgL_auxz00_940 = BGL_MVALUES_NUMBER_SET(BgL_nz00_926);
}
return BINT(BgL_auxz00_940);
}
}
}
/* expand-assert */
BGL_EXPORTED_DEF obj_t BGl_expandzd2assertzd2zzexpand_assertz00(obj_t
BgL_xz00_15, obj_t BgL_ez00_16)
{
AN_OBJECT;
{ /* Expand/assert.scm 26 */
{
obj_t BgL_varsz00_205;
obj_t BgL_predz00_206;
obj_t BgL_varsz00_202;
obj_t BgL_bodyz00_203;
if (PAIRP(BgL_xz00_15))
{ /* Expand/assert.scm 27 */
obj_t BgL_cdrzd21399zd2_211;
BgL_cdrzd21399zd2_211 = CDR(BgL_xz00_15);
if (PAIRP(BgL_cdrzd21399zd2_211))
{ /* Expand/assert.scm 27 */
obj_t BgL_cdrzd21403zd2_213;
BgL_cdrzd21403zd2_213 = CDR(BgL_cdrzd21399zd2_211);
if ((CAR(BgL_cdrzd21399zd2_211) == CNST_TABLE_REF(((long) 2))))
{ /* Expand/assert.scm 27 */
if (PAIRP(BgL_cdrzd21403zd2_213))
{ /* Expand/assert.scm 27 */
obj_t BgL_carzd21406zd2_216;
BgL_carzd21406zd2_216 = CAR(BgL_cdrzd21403zd2_213);
if (PAIRP(BgL_carzd21406zd2_216))
{ /* Expand/assert.scm 27 */
BgL_varsz00_202 = BgL_carzd21406zd2_216;
BgL_bodyz00_203 = CDR(BgL_cdrzd21403zd2_213);
{ /* Expand/assert.scm 30 */
obj_t BgL_newz00_233;
{ /* Expand/assert.scm 30 */
obj_t BgL_arg1623z00_234;
obj_t BgL_arg1624z00_235;
BgL_arg1623z00_234 = CNST_TABLE_REF(((long) 0));
{ /* Expand/assert.scm 30 */
obj_t BgL_arg1625z00_236;
BgL_arg1625z00_236 =
BGl_eappendzd22zd2zz__r4_pairs_and_lists_6_3z00
(BgL_bodyz00_203, BNIL);
{ /* Expand/assert.scm 30 */
obj_t BgL_list1626z00_237;
BgL_list1626z00_237 =
MAKE_PAIR(BgL_arg1625z00_236, BNIL);
BgL_arg1624z00_235 =
BGl_consza2za2zz__r4_pairs_and_lists_6_3z00
(BgL_varsz00_202, BgL_list1626z00_237);
}}
BgL_newz00_233 =
MAKE_PAIR(BgL_arg1623z00_234,
BgL_arg1624z00_235);
}
BGl_replacez12z12zztools_miscz00(BgL_xz00_15,
BgL_newz00_233);
return PROCEDURE_ENTRY(BgL_ez00_16) (BgL_ez00_16,
BgL_xz00_15, BgL_ez00_16, BEOA);
}
}
else
{ /* Expand/assert.scm 27 */
obj_t BgL_carzd21419zd2_220;
BgL_carzd21419zd2_220 = CAR(BgL_cdrzd21399zd2_211);
if (BGl_listzf3zf3zz__r4_pairs_and_lists_6_3z00
(BgL_carzd21419zd2_220))
{ /* Expand/assert.scm 27 */
BgL_varsz00_205 = BgL_carzd21419zd2_220;
BgL_predz00_206 = CDR(BgL_cdrzd21399zd2_211);
BgL_tagzd21390zd2_207:
{ /* Expand/assert.scm 34 */
bool_t BgL_testz00_446;
{ /* Expand/assert.scm 34 */
bool_t BgL_testz00_447;
if (INTEGERP
(BGl_za2compilerzd2debugza2zd2zzengine_paramz00))
{ /* Expand/assert.scm 34 */
BgL_testz00_447 =
(
(long)
CINT
(BGl_za2compilerzd2debugza2zd2zzengine_paramz00)
>= ((long) 1));
}
else
{ /* Expand/assert.scm 34 */
BgL_testz00_447 = ((bool_t) 0);
}
if (BgL_testz00_447)
{ /* Expand/assert.scm 34 */
BgL_testz00_446 = ((bool_t) 1);
}
else
{ /* Expand/assert.scm 35 */
obj_t BgL__andtest_1594z00_241;
{ /* Expand/assert.scm 35 */
obj_t BgL_arg1630z00_243;
obj_t BgL_arg1631z00_244;
BgL_arg1630z00_243 =
CNST_TABLE_REF(((long) 1));
{ /* Expand/assert.scm 35 */
obj_t BgL_arg1632z00_245;
BgL_arg1632z00_245 =
BGl_thezd2backendzd2zzbackend_backendz00
();
{
BgL_backendz00_bglt
BgL_auxz00_454;
BgL_auxz00_454 =
(BgL_backendz00_bglt)
(BgL_arg1632z00_245);
BgL_arg1631z00_244 =
(((BgL_backendz00_bglt)
CREF(BgL_auxz00_454))->
BgL_debugzd2supportzd2);
}}
BgL__andtest_1594z00_241 =
BGl_memqz00zz__r4_pairs_and_lists_6_3z00
(BgL_arg1630z00_243,
BgL_arg1631z00_244);
}
if (CBOOL(BgL__andtest_1594z00_241))
{ /* Expand/assert.scm 35 */
if (INTEGERP
(BGl_za2bdbzd2debugza2zd2zzengine_paramz00))
{ /* Expand/assert.scm 36 */
BgL_testz00_446 =
(
(long)
CINT
(BGl_za2bdbzd2debugza2zd2zzengine_paramz00)
>= ((long) 1));
}
else
{ /* Expand/assert.scm 36 */
BgL_testz00_446 = ((bool_t) 0);
}
}
else
{ /* Expand/assert.scm 35 */
BgL_testz00_446 = ((bool_t) 0);
}
}
}
if (BgL_testz00_446)
{ /* Expand/assert.scm 34 */
return
BGl_replacez12z12zztools_miscz00
(BgL_xz00_15,
BGl_makezd2onezd2assertz00zzexpand_assertz00
(BgL_ez00_16, BgL_xz00_15,
BgL_varsz00_205, BgL_predz00_206));
}
else
{ /* Expand/assert.scm 34 */
return BUNSPEC;
}
}
}
else
{ /* Expand/assert.scm 27 */
BgL_tagzd21391zd2_208:
return
BGl_errorz00zz__errorz00(BFALSE,
BGl_string1720z00zzexpand_assertz00,
BgL_xz00_15);
}
}
}
else
{ /* Expand/assert.scm 27 */
obj_t BgL_carzd21432zd2_224;
BgL_carzd21432zd2_224 = CAR(BgL_cdrzd21399zd2_211);
if (BGl_listzf3zf3zz__r4_pairs_and_lists_6_3z00
(BgL_carzd21432zd2_224))
{
obj_t BgL_predz00_472;
obj_t BgL_varsz00_471;
BgL_varsz00_471 = BgL_carzd21432zd2_224;
BgL_predz00_472 = CDR(BgL_cdrzd21399zd2_211);
BgL_predz00_206 = BgL_predz00_472;
BgL_varsz00_205 = BgL_varsz00_471;
goto BgL_tagzd21390zd2_207;
}
else
{ /* Expand/assert.scm 27 */
goto BgL_tagzd21391zd2_208;
}
}
}
else
{ /* Expand/assert.scm 27 */
obj_t BgL_carzd21445zd2_228;
BgL_carzd21445zd2_228 = CAR(BgL_cdrzd21399zd2_211);
if (BGl_listzf3zf3zz__r4_pairs_and_lists_6_3z00
(BgL_carzd21445zd2_228))
{
obj_t BgL_predz00_478;
obj_t BgL_varsz00_477;
BgL_varsz00_477 = BgL_carzd21445zd2_228;
BgL_predz00_478 = CDR(BgL_cdrzd21399zd2_211);
BgL_predz00_206 = BgL_predz00_478;
BgL_varsz00_205 = BgL_varsz00_477;
goto BgL_tagzd21390zd2_207;
}
else
{ /* Expand/assert.scm 27 */
goto BgL_tagzd21391zd2_208;
}
}
}
else
{ /* Expand/assert.scm 27 */
goto BgL_tagzd21391zd2_208;
}
}
else
{ /* Expand/assert.scm 27 */
goto BgL_tagzd21391zd2_208;
}
}
}
}
void
compute_fringe_widths (struct frame *f, int redraw)
{
int o_left = FRAME_LEFT_FRINGE_WIDTH (f);
int o_right = FRAME_RIGHT_FRINGE_WIDTH (f);
int o_cols = FRAME_FRINGE_COLS (f);
Lisp_Object left_fringe = Fassq (Qleft_fringe, f->param_alist);
Lisp_Object right_fringe = Fassq (Qright_fringe, f->param_alist);
int left_fringe_width, right_fringe_width;
if (!NILP (left_fringe))
left_fringe = Fcdr (left_fringe);
if (!NILP (right_fringe))
right_fringe = Fcdr (right_fringe);
left_fringe_width = ((NILP (left_fringe) || !INTEGERP (left_fringe)) ? 8 :
XINT (left_fringe));
right_fringe_width = ((NILP (right_fringe) || !INTEGERP (right_fringe)) ? 8 :
XINT (right_fringe));
if (left_fringe_width || right_fringe_width)
{
int left_wid = left_fringe_width >= 0 ? left_fringe_width : -left_fringe_width;
int right_wid = right_fringe_width >= 0 ? right_fringe_width : -right_fringe_width;
int conf_wid = left_wid + right_wid;
int font_wid = FRAME_COLUMN_WIDTH (f);
int cols = (left_wid + right_wid + font_wid-1) / font_wid;
int real_wid = cols * font_wid;
if (left_wid && right_wid)
{
if (left_fringe_width < 0)
{
/* Left fringe width is fixed, adjust right fringe if necessary */
FRAME_LEFT_FRINGE_WIDTH (f) = left_wid;
FRAME_RIGHT_FRINGE_WIDTH (f) = real_wid - left_wid;
}
else if (right_fringe_width < 0)
{
/* Right fringe width is fixed, adjust left fringe if necessary */
FRAME_LEFT_FRINGE_WIDTH (f) = real_wid - right_wid;
FRAME_RIGHT_FRINGE_WIDTH (f) = right_wid;
}
else
{
/* Adjust both fringes with an equal amount.
Note that we are doing integer arithmetic here, so don't
lose a pixel if the total width is an odd number. */
int fill = real_wid - conf_wid;
FRAME_LEFT_FRINGE_WIDTH (f) = left_wid + fill/2;
FRAME_RIGHT_FRINGE_WIDTH (f) = right_wid + fill - fill/2;
}
}
else if (left_fringe_width)
{
FRAME_LEFT_FRINGE_WIDTH (f) = real_wid;
FRAME_RIGHT_FRINGE_WIDTH (f) = 0;
}
else
{
FRAME_LEFT_FRINGE_WIDTH (f) = 0;
FRAME_RIGHT_FRINGE_WIDTH (f) = real_wid;
}
FRAME_FRINGE_COLS (f) = cols;
}
else
{
FRAME_LEFT_FRINGE_WIDTH (f) = 0;
FRAME_RIGHT_FRINGE_WIDTH (f) = 0;
FRAME_FRINGE_COLS (f) = 0;
}
if (redraw && FRAME_VISIBLE_P (f))
if (o_left != FRAME_LEFT_FRINGE_WIDTH (f) ||
o_right != FRAME_RIGHT_FRINGE_WIDTH (f) ||
o_cols != FRAME_FRINGE_COLS (f))
redraw_frame (f);
}
static int
nt_spawnve (char *exe, char **argv, char *env, struct TTY_Process *process)
{
STARTUPINFO start;
SECURITY_ATTRIBUTES sec_attrs;
SECURITY_DESCRIPTOR sec_desc;
DWORD flags;
char dir[ MAXPATHLEN ];
int pid;
int is_gui, use_cmd;
char *cmdline, *parg, **targ;
int do_quoting = 0;
char escape_char;
int arglen;
/* we have to do some conjuring here to put argv and envp into the
form CreateProcess wants... argv needs to be a space separated/null
terminated list of parameters, and envp is a null
separated/double-null terminated list of parameters.
Additionally, zero-length args and args containing whitespace or
quote chars need to be wrapped in double quotes - for this to work,
embedded quotes need to be escaped as well. The aim is to ensure
the child process reconstructs the argv array we start with
exactly, so we treat quotes at the beginning and end of arguments
as embedded quotes.
Note that using backslash to escape embedded quotes requires
additional special handling if an embedded quote is already
preceded by backslash, or if an arg requiring quoting ends with
backslash. In such cases, the run of escape characters needs to be
doubled. For consistency, we apply this special handling as long
as the escape character is not quote.
Since we have no idea how large argv and envp are likely to be we
figure out list lengths on the fly and allocate them. */
if (!NILP (Vw32_quote_process_args))
{
do_quoting = 1;
/* Override escape char by binding w32-quote-process-args to
desired character, or use t for auto-selection. */
if (INTEGERP (Vw32_quote_process_args))
escape_char = XINT (Vw32_quote_process_args);
else
escape_char = '\\';
}
/* do argv... */
arglen = 0;
targ = argv;
while (*targ)
{
char *p = *targ;
int need_quotes = 0;
int escape_char_run = 0;
if (*p == 0)
need_quotes = 1;
for ( ; *p; p++)
{
if (*p == '"')
{
/* allow for embedded quotes to be escaped */
arglen++;
need_quotes = 1;
/* handle the case where the embedded quote is already escaped */
if (escape_char_run > 0)
{
/* To preserve the arg exactly, we need to double the
preceding escape characters (plus adding one to
escape the quote character itself). */
arglen += escape_char_run;
}
}
else if (*p == ' ' || *p == '\t')
{
need_quotes = 1;
}
if (*p == escape_char && escape_char != '"')
escape_char_run++;
else
escape_char_run = 0;
}
if (need_quotes)
{
arglen += 2;
/* handle the case where the arg ends with an escape char - we
must not let the enclosing quote be escaped. */
if (escape_char_run > 0)
arglen += escape_char_run;
}
arglen += strlen (*targ) + 1;
targ++;
}
is_gui = is_gui_app (argv[0]);
use_cmd = FALSE;
if (is_gui == -1) {
/* could not determine application type. Try launching with "cmd /c" */
is_gui = FALSE;
arglen += 7;
use_cmd = TRUE;
}
cmdline = (char*)malloc (arglen + 1);
targ = argv;
parg = cmdline;
if (use_cmd == TRUE) {
strcpy (parg, "cmd /c ");
parg += 7;
}
while (*targ)
{
char * p = *targ;
int need_quotes = 0;
if (*p == 0)
need_quotes = 1;
if (do_quoting)
{
for ( ; *p; p++)
if (*p == ' ' || *p == '\t' || *p == '"')
need_quotes = 1;
}
if (need_quotes)
{
int escape_char_run = 0;
char * first;
char * last;
p = *targ;
first = p;
last = p + strlen (p) - 1;
*parg++ = '"';
for ( ; *p; p++)
{
if (*p == '"')
{
/* double preceding escape chars if any */
while (escape_char_run > 0)
{
*parg++ = escape_char;
escape_char_run--;
}
/* escape all quote chars, even at beginning or end */
*parg++ = escape_char;
}
*parg++ = *p;
if (*p == escape_char && escape_char != '"')
escape_char_run++;
else
escape_char_run = 0;
}
/* double escape chars before enclosing quote */
while (escape_char_run > 0)
{
*parg++ = escape_char;
escape_char_run--;
}
*parg++ = '"';
}
else
{
strcpy (parg, *targ);
parg += strlen (*targ);
}
*parg++ = ' ';
targ++;
}
*--parg = '\0';
memset (&start, 0, sizeof (start));
start.cb = sizeof (start);
if (process->usePipe == TRUE) {
start.dwFlags = STARTF_USESTDHANDLES;
start.hStdInput = process->w_forkin;
start.hStdOutput = process->w_forkout;
/* child's stderr is always redirected to outfd */
start.hStdError = process->w_forkout;
} else {
start.dwFlags = STARTF_USESTDHANDLES;
/* We only need to redirect stderr/stdout here. Stdin will be forced to
the spawned process console by explaunch */
start.hStdInput = NULL;
start.hStdOutput = process->w_forkout;
start.hStdError = process->w_forkout;
}
/* Explicitly specify no security */
if (!InitializeSecurityDescriptor (&sec_desc, SECURITY_DESCRIPTOR_REVISION))
goto EH_Fail;
if (!SetSecurityDescriptorDacl (&sec_desc, TRUE, NULL, FALSE))
goto EH_Fail;
sec_attrs.nLength = sizeof (sec_attrs);
sec_attrs.lpSecurityDescriptor = &sec_desc;
sec_attrs.bInheritHandle = FALSE;
/* creating a new console allow easier close. Do not use
CREATE_NEW_PROCESS_GROUP as this results in disabling Ctrl+C */
flags = CREATE_NEW_CONSOLE;
if (NILP (Vw32_start_process_inherit_error_mode))
flags |= CREATE_DEFAULT_ERROR_MODE;
/* if app is not a gui application, hide the console */
if (is_gui == FALSE) {
start.dwFlags |= STARTF_USESHOWWINDOW;
start.wShowWindow = SW_HIDE;
}
/* Set initial directory to null character to use current directory */
if (!CreateProcess (NULL, cmdline, &sec_attrs, NULL, TRUE,
flags, env, NULL, &start, &process->procinfo))
goto EH_Fail;
pid = (int) process->procinfo.hProcess;
process->pid=pid;
return pid;
EH_Fail:
return -1;
}
void bgl_odbc_sql_set_connect_attr(SQLHANDLE dbc,
obj_t attribute,
obj_t value)
{
SQLRETURN v;
SQLUINTEGER uintval = 0;
SQLPOINTER valueptr = 0;
SQLINTEGER stringlength = 0;
SQLINTEGER attr = 0;
if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "access-mode"))
{
attr = SQL_ATTR_ACCESS_MODE;
if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "read-only"))
{
uintval = SQL_MODE_READ_ONLY;
valueptr = (SQLPOINTER)uintval;
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "read-write"))
{
uintval = SQL_MODE_READ_WRITE;
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "asynch-enable"))
{
attr = SQL_ATTR_ASYNC_ENABLE;
if(TRUEP( value ))
{
uintval = SQL_ASYNC_ENABLE_ON;
valueptr = (SQLPOINTER)uintval;
}
else
{
uintval = SQL_ASYNC_ENABLE_OFF;
valueptr = (SQLPOINTER)uintval;
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "auto-ipd"))
{
attr = SQL_ATTR_AUTO_IPD;
if(TRUEP( value ))
{
uintval = SQL_TRUE;
valueptr = (SQLPOINTER)uintval;
}
else
{
uintval = SQL_FALSE;
valueptr = (SQLPOINTER)uintval;
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "autocommit"))
{
attr = SQL_ATTR_AUTOCOMMIT;
if(TRUEP( value ))
{
uintval = SQL_AUTOCOMMIT_OFF;
valueptr = (SQLPOINTER)uintval;
}
else
{
uintval = SQL_AUTOCOMMIT_ON;
valueptr = (SQLPOINTER)uintval;
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "connection-timeout"))
{
attr = SQL_ATTR_CONNECTION_TIMEOUT;
if(INTEGERP( value ))
{
uintval = CINT(value);
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "login-timeout"))
{
attr = SQL_ATTR_LOGIN_TIMEOUT;
if(INTEGERP( value ))
{
uintval = CINT(value);
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "current-catalog"))
{
attr = SQL_ATTR_CURRENT_CATALOG;
if(STRINGP( value ))
{
valueptr = (SQLPOINTER)BSTRING_TO_STRING(value);
stringlength = strlen(BSTRING_TO_STRING(value));
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "metadata-id"))
{
attr = SQL_ATTR_METADATA_ID;
if(TRUEP( value ))
{
uintval = SQL_TRUE;
valueptr = (SQLPOINTER)uintval;
}
else
{
uintval = SQL_FALSE;
valueptr = (SQLPOINTER)uintval;
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "odbc-cursor"))
{
attr = SQL_ATTR_ODBC_CURSORS;
if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "use-if-needed"))
{
uintval = SQL_CUR_USE_IF_NEEDED;
valueptr = (SQLPOINTER)uintval;
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "use-odbc"))
{
uintval = SQL_CUR_USE_ODBC;
valueptr = (SQLPOINTER)uintval;
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "use-driver"))
{
uintval = SQL_CUR_USE_DRIVER;
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else
{
odbc_error("bgl_odbc_sql_set_connect_attr",
"Invalid Or Unsupported attribute",
MAKE_PAIR(attribute, value));
}
v = SQLSetConnectAttr(dbc,
attr,
valueptr,
stringlength);
if(!SQL_SUCCEEDED(v))
{
report_odbc_error("bgl_odbc_sql_set_connect_attr",
SQL_HANDLE_DBC,
dbc);
}
}
void bgl_odbc_sql_set_env_attr(SQLHENV env,
obj_t attribute,
obj_t value)
{
SQLRETURN v;
SQLUINTEGER uintval = 0;
SQLPOINTER valueptr = 0;
SQLINTEGER stringlength = 0;
SQLINTEGER attr = 0;
if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "connection-pooling"))
{
attr = SQL_ATTR_CONNECTION_POOLING;
if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(value)), "off"))
{
uintval = SQL_CP_OFF;
valueptr = (SQLPOINTER)uintval;
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(value)), "one-per-driver"))
{
uintval = SQL_CP_ONE_PER_DRIVER;
valueptr = (SQLPOINTER)uintval;
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(value)), "one-per-environment"))
{
uintval = SQL_CP_ONE_PER_HENV;
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_env_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "match"))
{
attr = SQL_ATTR_CP_MATCH;
if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(value)), "strict"))
{
uintval = SQL_CP_STRICT_MATCH;
valueptr = (SQLPOINTER)uintval;
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(value)), "relaxed"))
{
uintval = SQL_CP_ONE_PER_DRIVER;
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_env_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "odbc-version"))
{
attr = SQL_ATTR_ODBC_VERSION;
if(INTEGERP(value))
{
uintval = (SQLUINTEGER)CINT(value);
valueptr = (SQLPOINTER)uintval;
}
else
{
odbc_error("bgl_odbc_sql_set_env_attr",
"Invalid attribute value",
MAKE_PAIR(attribute, value));
}
}
else if(0 == strcmp(BSTRING_TO_STRING(SYMBOL_TO_STRING(attribute)), "output-nts"))
{
attr = SQL_ATTR_OUTPUT_NTS;
if(TRUEP(value))
{
uintval = SQL_TRUE;
valueptr = (SQLPOINTER)uintval;
}
else
{
uintval = SQL_FALSE;
valueptr = (SQLPOINTER)uintval;
}
}
else
{
odbc_error("bgl_odbc_sql_set_env_attr",
"Invalid or Unsupported attribute ",
attribute);
}
v = SQLSetEnvAttr(env,
attr,
valueptr,
stringlength);
if(!SQL_SUCCEEDED(v))
{
report_odbc_error("bgl_odbc_sql_set_env_attr",
SQL_HANDLE_ENV,
env);
}
}
Lisp_Object
get_doc_string (Lisp_Object filepos, bool unibyte, bool definition)
{
char *from, *to, *name, *p, *p1;
int fd;
int offset;
EMACS_INT position;
Lisp_Object file, tem, pos;
ptrdiff_t count;
USE_SAFE_ALLOCA;
if (INTEGERP (filepos))
{
file = Vdoc_file_name;
pos = filepos;
}
else if (CONSP (filepos))
{
file = XCAR (filepos);
pos = XCDR (filepos);
}
else
return Qnil;
position = eabs (XINT (pos));
if (!STRINGP (Vdoc_directory))
return Qnil;
if (!STRINGP (file))
return Qnil;
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
file = ENCODE_FILE (file);
Lisp_Object docdir
= NILP (tem) ? ENCODE_FILE (Vdoc_directory) : empty_unibyte_string;
ptrdiff_t docdir_sizemax = SBYTES (docdir) + 1;
#ifndef CANNOT_DUMP
docdir_sizemax = max (docdir_sizemax, sizeof sibling_etc);
#endif
name = SAFE_ALLOCA (docdir_sizemax + SBYTES (file));
lispstpcpy (lispstpcpy (name, docdir), file);
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
{
#ifndef CANNOT_DUMP
if (!NILP (Vpurify_flag))
{
/* Preparing to dump; DOC file is probably not installed.
So check in ../etc. */
lispstpcpy (stpcpy (name, sibling_etc), file);
fd = emacs_open (name, O_RDONLY, 0);
}
#endif
if (fd < 0)
{
if (errno == EMFILE || errno == ENFILE)
report_file_error ("Read error on documentation file", file);
SAFE_FREE ();
AUTO_STRING (cannot_open, "Cannot open doc string file \"");
AUTO_STRING (quote_nl, "\"\n");
return concat3 (cannot_open, file, quote_nl);
}
}
count = SPECPDL_INDEX ();
record_unwind_protect_int (close_file_unwind, fd);
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
so we can check the leading text for consistency. */
offset = min (position, max (1024, position % (8 * 1024)));
if (TYPE_MAXIMUM (off_t) < position
|| lseek (fd, position - offset, 0) < 0)
error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
p = get_doc_string_buffer;
while (1)
{
ptrdiff_t space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
int nread;
/* Allocate or grow the buffer if we need to. */
if (space_left <= 0)
{
ptrdiff_t in_buffer = p - get_doc_string_buffer;
get_doc_string_buffer
= xpalloc (get_doc_string_buffer, &get_doc_string_buffer_size,
16 * 1024, -1, 1);
p = get_doc_string_buffer + in_buffer;
space_left = (get_doc_string_buffer_size - 1
- (p - get_doc_string_buffer));
}
/* Read a disk block at a time.
If we read the same block last time, maybe skip this? */
if (space_left > 1024 * 8)
space_left = 1024 * 8;
nread = emacs_read (fd, p, space_left);
if (nread < 0)
report_file_error ("Read error on documentation file", file);
p[nread] = 0;
if (!nread)
break;
if (p == get_doc_string_buffer)
p1 = strchr (p + offset, '\037');
else
p1 = strchr (p, '\037');
if (p1)
{
*p1 = 0;
p = p1;
break;
}
p += nread;
}
unbind_to (count, Qnil);
SAFE_FREE ();
/* Sanity checking. */
if (CONSP (filepos))
{
int test = 1;
/* A dynamic docstring should be either at the very beginning of a "#@
comment" or right after a dynamic docstring delimiter (in case we
pack several such docstrings within the same comment). */
if (get_doc_string_buffer[offset - test] != '\037')
{
if (get_doc_string_buffer[offset - test++] != ' ')
return Qnil;
while (get_doc_string_buffer[offset - test] >= '0'
&& get_doc_string_buffer[offset - test] <= '9')
test++;
if (get_doc_string_buffer[offset - test++] != '@'
|| get_doc_string_buffer[offset - test] != '#')
return Qnil;
}
}
else
{
int test = 1;
if (get_doc_string_buffer[offset - test++] != '\n')
return Qnil;
while (get_doc_string_buffer[offset - test] > ' ')
test++;
if (get_doc_string_buffer[offset - test] != '\037')
return Qnil;
}
/* Scan the text and perform quoting with ^A (char code 1).
^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
from = get_doc_string_buffer + offset;
to = get_doc_string_buffer + offset;
while (from != p)
{
if (*from == 1)
{
int c;
from++;
c = *from++;
if (c == 1)
*to++ = c;
else if (c == '0')
*to++ = 0;
else if (c == '_')
*to++ = 037;
else
{
unsigned char uc = c;
error ("\
Invalid data in documentation file -- %c followed by code %03o",
1, uc);
}
}
else
*to++ = *from++;
}
/* If DEFINITION, read from this buffer
the same way we would read bytes from a file. */
if (definition)
{
read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
return Fread (Qlambda);
}
if (unibyte)
return make_unibyte_string (get_doc_string_buffer + offset,
to - (get_doc_string_buffer + offset));
else
{
/* The data determines whether the string is multibyte. */
ptrdiff_t nchars
= multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
+ offset),
to - (get_doc_string_buffer + offset));
return make_string_from_bytes (get_doc_string_buffer + offset,
nchars,
to - (get_doc_string_buffer + offset));
}
}
/* This is the callback function for arriving signals from
g_file_monitor. It shall create a Lisp event, and put it into
Emacs input queue. */
static gboolean
dir_monitor_callback (GFileMonitor *monitor,
GFile *file,
GFile *other_file,
GFileMonitorEvent event_type,
gpointer user_data)
{
Lisp_Object symbol, monitor_object, watch_object, flags;
char *name = g_file_get_parse_name (file);
char *oname = other_file ? g_file_get_parse_name (other_file) : NULL;
/* Determine event symbol. */
switch (event_type)
{
case G_FILE_MONITOR_EVENT_CHANGED:
symbol = Qchanged;
break;
case G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT:
symbol = Qchanges_done_hint;
break;
case G_FILE_MONITOR_EVENT_DELETED:
symbol = Qdeleted;
break;
case G_FILE_MONITOR_EVENT_CREATED:
symbol = Qcreated;
break;
case G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED:
symbol = Qattribute_changed;
break;
case G_FILE_MONITOR_EVENT_PRE_UNMOUNT:
symbol = Qpre_unmount;
break;
case G_FILE_MONITOR_EVENT_UNMOUNTED:
symbol = Qunmounted;
break;
case G_FILE_MONITOR_EVENT_MOVED:
symbol = Qmoved;
break;
default:
goto cleanup;
}
/* Determine callback function. */
monitor_object = make_pointer_integer (monitor);
eassert (INTEGERP (monitor_object));
watch_object = assq_no_quit (monitor_object, watch_list);
if (CONSP (watch_object))
{
struct input_event event;
Lisp_Object otail = oname ? list1 (build_string (oname)) : Qnil;
/* Check, whether event_type is expected. */
flags = XCAR (XCDR (XCDR (watch_object)));
if ((!NILP (Fmember (Qchange, flags)) &&
!NILP (Fmember (symbol, list5 (Qchanged, Qchanges_done_hint,
Qdeleted, Qcreated, Qmoved)))) ||
(!NILP (Fmember (Qattribute_change, flags)) &&
((EQ (symbol, Qattribute_changed)))))
{
/* Construct an event. */
EVENT_INIT (event);
event.kind = FILE_NOTIFY_EVENT;
event.frame_or_window = Qnil;
event.arg = list2 (Fcons (monitor_object,
Fcons (symbol,
Fcons (build_string (name),
otail))),
XCAR (XCDR (XCDR (XCDR (watch_object)))));
/* Store it into the input event queue. */
kbd_buffer_store_event (&event);
// XD_DEBUG_MESSAGE ("%s", XD_OBJECT_TO_STRING (event.arg));
}
/* Cancel monitor if file or directory is deleted. */
if (!NILP (Fmember (symbol, list2 (Qdeleted, Qmoved))) &&
!g_file_monitor_is_cancelled (monitor))
g_file_monitor_cancel (monitor);
}
/* Cleanup. */
cleanup:
g_free (name);
g_free (oname);
return TRUE;
}
/* This is the callback function for arriving signals from
g_file_monitor. It shall create a Lisp event, and put it into
Emacs input queue. */
static gboolean
dir_monitor_callback (GFileMonitor *monitor,
GFile *file,
GFile *other_file,
GFileMonitorEvent event_type,
gpointer user_data)
{
Lisp_Object symbol, monitor_object, watch_object;
char *name = g_file_get_parse_name (file);
char *oname = other_file ? g_file_get_parse_name (other_file) : NULL;
/* Determine event symbol. */
switch (event_type)
{
case G_FILE_MONITOR_EVENT_CHANGED:
symbol = Qchanged;
break;
case G_FILE_MONITOR_EVENT_CHANGES_DONE_HINT:
symbol = Qchanges_done_hint;
break;
case G_FILE_MONITOR_EVENT_DELETED:
symbol = Qdeleted;
break;
case G_FILE_MONITOR_EVENT_CREATED:
symbol = Qcreated;
break;
case G_FILE_MONITOR_EVENT_ATTRIBUTE_CHANGED:
symbol = Qattribute_changed;
break;
case G_FILE_MONITOR_EVENT_PRE_UNMOUNT:
symbol = Qpre_unmount;
break;
case G_FILE_MONITOR_EVENT_UNMOUNTED:
symbol = Qunmounted;
break;
case G_FILE_MONITOR_EVENT_MOVED:
symbol = Qmoved;
break;
default:
goto cleanup;
}
/* Determine callback function. */
monitor_object = XIL ((intptr_t) monitor);
eassert (INTEGERP (monitor_object));
watch_object = assq_no_quit (monitor_object, watch_list);
if (CONSP (watch_object))
{
/* Construct an event. */
struct input_event event;
Lisp_Object otail = oname ? list1 (build_string (oname)) : Qnil;
EVENT_INIT (event);
event.kind = FILE_NOTIFY_EVENT;
event.frame_or_window = Qnil;
event.arg = list2 (Fcons (monitor_object,
Fcons (symbol,
Fcons (build_string (name),
otail))),
XCDR (watch_object));
/* Store it into the input event queue. */
kbd_buffer_store_event (&event);
}
/* Cleanup. */
cleanup:
g_free (name);
g_free (oname);
return TRUE;
}
Lisp_Object
get_doc_string (Lisp_Object filepos, int unibyte, int definition)
{
char *from, *to;
register int fd;
register char *name;
register char *p, *p1;
EMACS_INT minsize;
EMACS_INT offset, position;
Lisp_Object file, tem;
if (INTEGERP (filepos))
{
file = Vdoc_file_name;
position = XINT (filepos);
}
else if (CONSP (filepos))
{
file = XCAR (filepos);
position = XINT (XCDR (filepos));
}
else
return Qnil;
if (position < 0)
position = - position;
if (!STRINGP (Vdoc_directory))
return Qnil;
if (!STRINGP (file))
return Qnil;
/* Put the file name in NAME as a C string.
If it is relative, combine it with Vdoc_directory. */
tem = Ffile_name_absolute_p (file);
if (NILP (tem))
{
minsize = SCHARS (Vdoc_directory);
/* sizeof ("../etc/") == 8 */
if (minsize < 8)
minsize = 8;
name = (char *) alloca (minsize + SCHARS (file) + 8);
strcpy (name, SSDATA (Vdoc_directory));
strcat (name, SSDATA (file));
}
else
{
name = SSDATA (file);
}
fd = emacs_open (name, O_RDONLY, 0);
if (fd < 0)
{
#ifndef CANNOT_DUMP
if (!NILP (Vpurify_flag))
{
/* Preparing to dump; DOC file is probably not installed.
So check in ../etc. */
strcpy (name, "../etc/");
strcat (name, SSDATA (file));
fd = emacs_open (name, O_RDONLY, 0);
}
#endif
if (fd < 0)
error ("Cannot open doc string file \"%s\"", name);
}
/* Seek only to beginning of disk block. */
/* Make sure we read at least 1024 bytes before `position'
so we can check the leading text for consistency. */
offset = min (position, max (1024, position % (8 * 1024)));
if (0 > lseek (fd, position - offset, 0))
{
emacs_close (fd);
error ("Position %"pI"d out of range in doc string file \"%s\"",
position, name);
}
/* Read the doc string into get_doc_string_buffer.
P points beyond the data just read. */
p = get_doc_string_buffer;
while (1)
{
EMACS_INT space_left = (get_doc_string_buffer_size
- (p - get_doc_string_buffer));
int nread;
/* Allocate or grow the buffer if we need to. */
if (space_left == 0)
{
EMACS_INT in_buffer = p - get_doc_string_buffer;
get_doc_string_buffer_size += 16 * 1024;
get_doc_string_buffer
= (char *) xrealloc (get_doc_string_buffer,
get_doc_string_buffer_size + 1);
p = get_doc_string_buffer + in_buffer;
space_left = (get_doc_string_buffer_size
- (p - get_doc_string_buffer));
}
/* Read a disk block at a time.
If we read the same block last time, maybe skip this? */
if (space_left > 1024 * 8)
space_left = 1024 * 8;
nread = emacs_read (fd, p, space_left);
if (nread < 0)
{
emacs_close (fd);
error ("Read error on documentation file");
}
p[nread] = 0;
if (!nread)
break;
if (p == get_doc_string_buffer)
p1 = strchr (p + offset, '\037');
else
p1 = strchr (p, '\037');
if (p1)
{
*p1 = 0;
p = p1;
break;
}
p += nread;
}
emacs_close (fd);
/* Sanity checking. */
if (CONSP (filepos))
{
int test = 1;
if (get_doc_string_buffer[offset - test++] != ' ')
return Qnil;
while (get_doc_string_buffer[offset - test] >= '0'
&& get_doc_string_buffer[offset - test] <= '9')
test++;
if (get_doc_string_buffer[offset - test++] != '@'
|| get_doc_string_buffer[offset - test] != '#')
return Qnil;
}
else
{
int test = 1;
if (get_doc_string_buffer[offset - test++] != '\n')
return Qnil;
while (get_doc_string_buffer[offset - test] > ' ')
test++;
if (get_doc_string_buffer[offset - test] != '\037')
return Qnil;
}
/* Scan the text and perform quoting with ^A (char code 1).
^A^A becomes ^A, ^A0 becomes a null char, and ^A_ becomes a ^_. */
from = get_doc_string_buffer + offset;
to = get_doc_string_buffer + offset;
while (from != p)
{
if (*from == 1)
{
int c;
from++;
c = *from++;
if (c == 1)
*to++ = c;
else if (c == '0')
*to++ = 0;
else if (c == '_')
*to++ = 037;
else
{
unsigned char uc = c;
error ("\
Invalid data in documentation file -- %c followed by code %03o",
1, uc);
}
}
else
*to++ = *from++;
}
/* If DEFINITION, read from this buffer
the same way we would read bytes from a file. */
if (definition)
{
read_bytecode_pointer = (unsigned char *) get_doc_string_buffer + offset;
return Fread (Qlambda);
}
if (unibyte)
return make_unibyte_string (get_doc_string_buffer + offset,
to - (get_doc_string_buffer + offset));
else
{
/* The data determines whether the string is multibyte. */
EMACS_INT nchars =
multibyte_chars_in_text (((unsigned char *) get_doc_string_buffer
+ offset),
to - (get_doc_string_buffer + offset));
return make_string_from_bytes (get_doc_string_buffer + offset,
nchars,
to - (get_doc_string_buffer + offset));
}
}
static Lisp_Object
xftfont_open (struct frame *f, Lisp_Object entity, int pixel_size)
{
FcResult result;
Display *display = FRAME_X_DISPLAY (f);
Lisp_Object val, filename, idx, font_object;
FcPattern *pat = NULL, *match;
struct xftfont_info *xftfont_info = NULL;
struct font *font;
double size = 0;
XftFont *xftfont = NULL;
int spacing;
char name[256];
int len, i;
XGlyphInfo extents;
FT_Face ft_face;
FcMatrix *matrix;
val = assq_no_quit (QCfont_entity, AREF (entity, FONT_EXTRA_INDEX));
if (! CONSP (val))
return Qnil;
val = XCDR (val);
filename = XCAR (val);
idx = XCDR (val);
size = XINT (AREF (entity, FONT_SIZE_INDEX));
if (size == 0)
size = pixel_size;
pat = FcPatternCreate ();
FcPatternAddInteger (pat, FC_WEIGHT, FONT_WEIGHT_NUMERIC (entity));
i = FONT_SLANT_NUMERIC (entity) - 100;
if (i < 0) i = 0;
FcPatternAddInteger (pat, FC_SLANT, i);
FcPatternAddInteger (pat, FC_WIDTH, FONT_WIDTH_NUMERIC (entity));
FcPatternAddDouble (pat, FC_PIXEL_SIZE, pixel_size);
val = AREF (entity, FONT_FAMILY_INDEX);
if (! NILP (val))
FcPatternAddString (pat, FC_FAMILY, (FcChar8 *) SDATA (SYMBOL_NAME (val)));
val = AREF (entity, FONT_FOUNDRY_INDEX);
if (! NILP (val))
FcPatternAddString (pat, FC_FOUNDRY, (FcChar8 *) SDATA (SYMBOL_NAME (val)));
val = AREF (entity, FONT_SPACING_INDEX);
if (! NILP (val))
FcPatternAddInteger (pat, FC_SPACING, XINT (val));
val = AREF (entity, FONT_DPI_INDEX);
if (! NILP (val))
{
double dbl = XINT (val);
FcPatternAddDouble (pat, FC_DPI, dbl);
}
val = AREF (entity, FONT_AVGWIDTH_INDEX);
if (INTEGERP (val) && XINT (val) == 0)
FcPatternAddBool (pat, FC_SCALABLE, FcTrue);
/* This is necessary to identify the exact font (e.g. 10x20.pcf.gz
over 10x20-ISO8859-1.pcf.gz). */
FcPatternAddCharSet (pat, FC_CHARSET, ftfont_get_fc_charset (entity));
xftfont_add_rendering_parameters (pat, entity);
FcPatternAddString (pat, FC_FILE, (FcChar8 *) SDATA (filename));
FcPatternAddInteger (pat, FC_INDEX, XINT (idx));
block_input ();
/* Make sure that the Xrender extension is added before the Xft one.
Otherwise, the close-display hook set by Xft is called after the
one for Xrender, and the former tries to re-add the latter. This
results in inconsistency of internal states and leads to X
protocol error when one reconnects to the same X server.
(Bug#1696) */
{
int event_base, error_base;
XRenderQueryExtension (display, &event_base, &error_base);
}
/* Substitute in values from X resources and XftDefaultSet. */
XftDefaultSubstitute (display, FRAME_X_SCREEN_NUMBER (f), pat);
match = XftFontMatch (display, FRAME_X_SCREEN_NUMBER (f), pat, &result);
xftfont_fix_match (pat, match);
FcPatternDestroy (pat);
xftfont = XftFontOpenPattern (display, match);
if (!xftfont)
{
unblock_input ();
XftPatternDestroy (match);
return Qnil;
}
ft_face = XftLockFace (xftfont);
unblock_input ();
/* We should not destroy PAT here because it is kept in XFTFONT and
destroyed automatically when XFTFONT is closed. */
font_object = font_make_object (VECSIZE (struct xftfont_info), entity, size);
ASET (font_object, FONT_TYPE_INDEX, Qxft);
len = font_unparse_xlfd (entity, size, name, 256);
if (len > 0)
ASET (font_object, FONT_NAME_INDEX, make_string (name, len));
len = font_unparse_fcname (entity, size, name, 256);
if (len > 0)
ASET (font_object, FONT_FULLNAME_INDEX, make_string (name, len));
else
ASET (font_object, FONT_FULLNAME_INDEX,
AREF (font_object, FONT_NAME_INDEX));
ASET (font_object, FONT_FILE_INDEX, filename);
ASET (font_object, FONT_FORMAT_INDEX,
ftfont_font_format (xftfont->pattern, filename));
font = XFONT_OBJECT (font_object);
font->pixel_size = size;
font->driver = &xftfont_driver;
font->encoding_charset = font->repertory_charset = -1;
xftfont_info = (struct xftfont_info *) font;
xftfont_info->display = display;
xftfont_info->xftfont = xftfont;
/* This means that there's no need of transformation. */
xftfont_info->matrix.xx = 0;
if (FcPatternGetMatrix (xftfont->pattern, FC_MATRIX, 0, &matrix)
== FcResultMatch)
{
xftfont_info->matrix.xx = 0x10000L * matrix->xx;
xftfont_info->matrix.yy = 0x10000L * matrix->yy;
xftfont_info->matrix.xy = 0x10000L * matrix->xy;
xftfont_info->matrix.yx = 0x10000L * matrix->yx;
}
if (INTEGERP (AREF (entity, FONT_SPACING_INDEX)))
spacing = XINT (AREF (entity, FONT_SPACING_INDEX));
else
spacing = FC_PROPORTIONAL;
if (! ascii_printable[0])
{
int ch;
for (ch = 0; ch < 95; ch++)
ascii_printable[ch] = ' ' + ch;
}
block_input ();
/* Unfortunately Xft doesn't provide a way to get minimum char
width. So, we set min_width to space_width. */
if (spacing != FC_PROPORTIONAL
#ifdef FC_DUAL
&& spacing != FC_DUAL
#endif /* FC_DUAL */
)
{
font->min_width = font->max_width = font->average_width
= font->space_width = xftfont->max_advance_width;
XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents);
}
else
{
XftTextExtents8 (display, xftfont, ascii_printable, 1, &extents);
font->min_width = font->max_width = font->space_width
= extents.xOff;
if (font->space_width <= 0)
/* dirty workaround */
font->space_width = pixel_size;
XftTextExtents8 (display, xftfont, ascii_printable + 1, 94, &extents);
font->average_width = (font->space_width + extents.xOff) / 95;
}
unblock_input ();
font->ascent = xftfont->ascent;
font->descent = xftfont->descent;
if (pixel_size >= 5)
{
/* The above condition is a dirty workaround because
XftTextExtents8 behaves strangely for some fonts
(e.g. "Dejavu Sans Mono") when pixel_size is less than 5. */
if (font->ascent < extents.y)
font->ascent = extents.y;
if (font->descent < extents.height - extents.y)
font->descent = extents.height - extents.y;
}
font->height = font->ascent + font->descent;
if (XINT (AREF (entity, FONT_SIZE_INDEX)) == 0)
{
int upEM = ft_face->units_per_EM;
font->underline_position = -ft_face->underline_position * size / upEM;
font->underline_thickness = ft_face->underline_thickness * size / upEM;
if (font->underline_thickness > 2)
font->underline_position -= font->underline_thickness / 2;
}
else
{
font->underline_position = -1;
font->underline_thickness = 0;
}
#ifdef HAVE_LIBOTF
xftfont_info->maybe_otf = (ft_face->face_flags & FT_FACE_FLAG_SFNT) != 0;
xftfont_info->otf = NULL;
#endif /* HAVE_LIBOTF */
xftfont_info->ft_size = ft_face->size;
font->baseline_offset = 0;
font->relative_compose = 0;
font->default_ascent = 0;
font->vertical_centering = 0;
#ifdef FT_BDF_H
if (! (ft_face->face_flags & FT_FACE_FLAG_SFNT))
{
BDF_PropertyRec rec;
if (FT_Get_BDF_Property (ft_face, "_MULE_BASELINE_OFFSET", &rec) == 0
&& rec.type == BDF_PROPERTY_TYPE_INTEGER)
font->baseline_offset = rec.u.integer;
if (FT_Get_BDF_Property (ft_face, "_MULE_RELATIVE_COMPOSE", &rec) == 0
&& rec.type == BDF_PROPERTY_TYPE_INTEGER)
font->relative_compose = rec.u.integer;
if (FT_Get_BDF_Property (ft_face, "_MULE_DEFAULT_ASCENT", &rec) == 0
&& rec.type == BDF_PROPERTY_TYPE_INTEGER)
font->default_ascent = rec.u.integer;
}
#endif
return font_object;
}
static Lisp_Object
casify_object (enum case_action flag, Lisp_Object obj)
{
register int c, c1;
register int inword = flag == CASE_DOWN;
/* If the case table is flagged as modified, rescan it. */
if (NILP (XCHAR_TABLE (BVAR (current_buffer, downcase_table))->extras[1]))
Fset_case_table (BVAR (current_buffer, downcase_table));
if (INTEGERP (obj))
{
int flagbits = (CHAR_ALT | CHAR_SUPER | CHAR_HYPER
| CHAR_SHIFT | CHAR_CTL | CHAR_META);
int flags = XINT (obj) & flagbits;
int multibyte = ! NILP (BVAR (current_buffer, enable_multibyte_characters));
/* If the character has higher bits set
above the flags, return it unchanged.
It is not a real character. */
if ((unsigned) XFASTINT (obj) > (unsigned) flagbits)
return obj;
c1 = XFASTINT (obj) & ~flagbits;
/* FIXME: Even if enable-multibyte-characters is nil, we may
manipulate multibyte chars. This means we have a bug for latin-1
chars since when we receive an int 128-255 we can't tell whether
it's an eight-bit byte or a latin-1 char. */
if (c1 >= 256)
multibyte = 1;
if (! multibyte)
MAKE_CHAR_MULTIBYTE (c1);
c = downcase (c1);
if (inword)
XSETFASTINT (obj, c | flags);
else if (c == (XFASTINT (obj) & ~flagbits))
{
if (! inword)
c = upcase1 (c1);
if (! multibyte)
MAKE_CHAR_UNIBYTE (c);
XSETFASTINT (obj, c | flags);
}
return obj;
}
if (!STRINGP (obj))
wrong_type_argument (Qchar_or_string_p, obj);
else if (!STRING_MULTIBYTE (obj))
{
EMACS_INT i;
EMACS_INT size = SCHARS (obj);
obj = Fcopy_sequence (obj);
for (i = 0; i < size; i++)
{
c = SREF (obj, i);
MAKE_CHAR_MULTIBYTE (c);
c1 = c;
if (inword && flag != CASE_CAPITALIZE_UP)
c = downcase (c);
else if (!uppercasep (c)
&& (!inword || flag != CASE_CAPITALIZE_UP))
c = upcase1 (c1);
if ((int) flag >= (int) CASE_CAPITALIZE)
inword = (SYNTAX (c) == Sword);
if (c != c1)
{
MAKE_CHAR_UNIBYTE (c);
/* If the char can't be converted to a valid byte, just don't
change it. */
if (c >= 0 && c < 256)
SSET (obj, i, c);
}
}
return obj;
}
else
{
EMACS_INT i, i_byte, size = SCHARS (obj);
int len;
USE_SAFE_ALLOCA;
unsigned char *dst, *o;
/* Over-allocate by 12%: this is a minor overhead, but should be
sufficient in 99.999% of the cases to avoid a reallocation. */
EMACS_INT o_size = SBYTES (obj) + SBYTES (obj) / 8 + MAX_MULTIBYTE_LENGTH;
SAFE_ALLOCA (dst, void *, o_size);
o = dst;
for (i = i_byte = 0; i < size; i++, i_byte += len)
{
if ((o - dst) + MAX_MULTIBYTE_LENGTH > o_size)
{ /* Not enough space for the next char: grow the destination. */
unsigned char *old_dst = dst;
o_size += o_size; /* Probably overkill, but extremely rare. */
SAFE_ALLOCA (dst, void *, o_size);
memcpy (dst, old_dst, o - old_dst);
o = dst + (o - old_dst);
}
c = STRING_CHAR_AND_LENGTH (SDATA (obj) + i_byte, len);
if (inword && flag != CASE_CAPITALIZE_UP)
c = downcase (c);
else if (!uppercasep (c)
&& (!inword || flag != CASE_CAPITALIZE_UP))
c = upcase1 (c);
if ((int) flag >= (int) CASE_CAPITALIZE)
inword = (SYNTAX (c) == Sword);
o += CHAR_STRING (c, o);
}
eassert (o - dst <= o_size);
obj = make_multibyte_string ((char *) dst, size, o - dst);
SAFE_FREE ();
return obj;
}
}
