void
sprint_list(LispObj o, int depth)
{
LispObj the_cdr;
add_char('(');
while(1) {
if (o != lisp_nil) {
sprint_lisp_object(ptr_to_lispobj(car(o)), depth);
the_cdr = ptr_to_lispobj(cdr(o));
if (the_cdr != lisp_nil) {
add_char(' ');
if (fulltag_of(the_cdr) == fulltag_cons) {
o = the_cdr;
continue;
}
add_c_string(". ");
sprint_lisp_object(the_cdr, depth);
break;
}
}
break;
}
add_char(')');
}
// Funcion que guarda en un diccionario claves y valores que son contenidos en un string
void parse_str(struct dictionary * d, char * str) {
char c = str[0];
char key[30];
char value[30];
key[0] = '\0';
value[0] = '\0';
// creo un diccionario para guardar las claves y valores que vinieron en el string
while (c != '\0') {
while (c != '=' && c != '\0') {
add_char(key, c, strlen(key));
c = *++str;
}
if (c == '\0') break;
c = *++str;
while (c != ' ' && c != '\0') {
add_char(value, c, strlen(value));
c = *++str;
}
if (c != '\0') c = *++str;
put(d, key, value);
key[0] = '\0';
value[0] = '\0';
}
}
void writes_wintt(wchar_t c, t_printf_arg *arg)
{
size_t i;
size_t size;
size_t size2;
size = (arg->prec.right > 0) ? FT_MIN(arg->prec.right, 1) : 1;
size2 = FT_MAX((int)size, arg->prec.left);
i = -1;
if (!(arg->buf = ft_strnew(size2 * 4)))
return ;
if (!(arg->flags & less))
{
while (++i < size2 - size)
arg->buf[arg->size++] = (!(arg->flags & zero)) ? ' ' : '0';
add_char(c, arg);
}
else
{
if (c && i++)
add_char(c, arg);
while (++i < size2)
arg->buf[arg->size++] = ' ';
}
if (!arg->size)
arg->size = 1;
}
static void read_free (void)
{
int c;
while (isspace(c=fgetc(in)))
;
if (c == EOF)
{
lua_pushnil();
return;
}
if (c == '\"' || c == '\'')
{ /* string */
c = read_until_char(c);
if (c == EOF)
{
add_char(0); /* to be ready for next time */
lua_pushnil();
}
else
lua_pushstring(add_char(0));
}
else
{
double d;
char dummy;
char *s;
add_char(c);
read_until_blank();
s = add_char(0);
if (sscanf(s, "%lf %c", &d, &dummy) == 1)
lua_pushnumber(d);
else
lua_pushstring(s);
}
}
static void ascii(char key)
{
t_line *l;
if (data()->cur == NONE)
data()->current = init_line(key);
else if (data()->cur == CURRENT)
{
l = data()->current;
if (l == NULL)
l = init_line(key);
else
l->tmp = add_char(key, l->tmp, l->edit);
set_edit(l);
data()->current = l;
}
else
{
l = data()->history;
while (l->id != data()->cur)
l = l->next;
if (l->tmp == NULL && l->edit)
l->tmp = dup_str(l->line);
l->tmp = add_char(key, l->tmp, l->edit);
set_edit(l);
}
}
void
sprint_specializers_list(LispObj o, int depth)
{
LispObj the_cdr, the_car;
add_char('(');
while(1) {
if (o != lisp_nil) {
the_car = car(o);
if (fulltag_of(the_car) == fulltag_misc) {
sprint_lisp_object(deref(deref(the_car,3), 4), depth);
} else {
sprint_lisp_object(the_car, depth);
}
the_cdr = cdr(o);
if (the_cdr != lisp_nil) {
add_char(' ');
if (fulltag_of(the_cdr) == fulltag_cons) {
o = the_cdr;
continue;
}
add_c_string(". ");
sprint_lisp_object(the_cdr, depth);
break;
}
}
break;
}
add_char(')');
}
CAMLexport char * caml_format_exception(value exn)
{
#ifndef NATIVE_CODE
if( bytecode_compatibility == Caml1999X008){
return Caml1999X008_caml_format_exception(exn);
} else
#endif
{
mlsize_t start, i;
value bucket, v;
struct stringbuf buf;
char intbuf[64];
char * res;
buf.ptr = buf.data;
buf.end = buf.data + sizeof(buf.data) - 1;
if (Tag_val(exn) == 0) {
add_string(&buf, String_val(Field(Field(exn, 0), 0)));
/* Check for exceptions in the style of Match_failure and Assert_failure */
if (Wosize_val(exn) == 2 &&
Is_block(Field(exn, 1)) &&
Tag_val(Field(exn, 1)) == 0 &&
caml_is_special_exception(Field(exn, 0))) {
bucket = Field(exn, 1);
start = 0;
} else {
bucket = exn;
start = 1;
}
add_char(&buf, '(');
for (i = start; i < Wosize_val(bucket); i++) {
if (i > start) add_string(&buf, ", ");
v = Field(bucket, i);
if (Is_long(v)) {
snprintf(intbuf, sizeof(intbuf),
"%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
add_string(&buf, intbuf);
} else if (Tag_val(v) == String_tag) {
add_char(&buf, '"');
add_string(&buf, String_val(v));
add_char(&buf, '"');
} else {
add_char(&buf, '_');
}
}
add_char(&buf, ')');
} else
add_string(&buf, String_val(Field(exn, 0)));
*buf.ptr = 0; /* Terminate string */
i = buf.ptr - buf.data + 1;
res = malloc(i);
if (res == NULL) return NULL;
memmove(res, buf.data, i);
return res;
}
}
void add_wchar(wchar_t c)
{
if (c <= 0x7F)
add_char(c);
else if (c <= 0x7FF)
{
add_char((c >> 6) + 0xC0);
add_char((c & 0x3F) + 0x80);
}
void
sprint_lisp_object(LispObj o, int depth)
{
if (--depth < 0) {
add_char('#');
} else {
switch (fulltag_of(o)) {
case fulltag_even_fixnum:
case fulltag_odd_fixnum:
sprint_signed_decimal(unbox_fixnum(o));
break;
#ifdef PPC64
case fulltag_immheader_0:
case fulltag_immheader_1:
case fulltag_immheader_2:
case fulltag_immheader_3:
case fulltag_nodeheader_0:
case fulltag_nodeheader_1:
case fulltag_nodeheader_2:
case fulltag_nodeheader_3:
#else
case fulltag_immheader:
case fulltag_nodeheader:
#endif
add_c_string("#<header ? ");
sprint_unsigned_hex(o);
add_c_string(">");
break;
#ifdef PPC64
case fulltag_imm_0:
case fulltag_imm_1:
case fulltag_imm_2:
case fulltag_imm_3:
#else
case fulltag_imm:
#endif
if (o == unbound) {
add_c_string("#<Unbound>");
} else {
if (header_subtag(o) == subtag_character) {
unsigned c = (o >> charcode_shift);
add_c_string("#\\");
if ((c >= ' ') && (c < 0x7f)) {
add_char(c);
} else {
sprintf(numbuf, "%o", c);
add_c_string(numbuf);
}
#ifdef PPC64
} else if (header_subtag(o) == subtag_single_float) {
sprintf(numbuf, "%f", o>>32);
add_c_string(numbuf);
#endif
} else {
void compose_handle_keypress(uint8_t key) {
if (state_ == COMPOSE_STATE_WRITING) {
switch (key) {
case KBACK:
del_char();
compose_draw();
break;
case '<':
cursor_left();
compose_draw();
break;
case '>':
cursor_right();
compose_draw();
break;
case ' ':
case ',':
add_char(key);
compose_draw();
break;
case KALT:
alt_on_ = !alt_on_;
compose_draw();
break;
case KSPK:
if (alt_on_) {
add_char('0');
compose_draw();
}
break;
case '\n':
state_ = COMPOSE_STATE_CONFIRM;
compose_draw();
default:
if (key >= 'A' && key <= 'Z') {
add_char(key);
compose_draw();
}
break;
}
} else if (state_ == COMPOSE_STATE_CONFIRM) {
switch (key) {
case 'Y':
state_ = COMPOSE_STATE_SENDING;
compose_draw();
send_message();
break;
case 'N':
state_ = COMPOSE_STATE_WRITING;
compose_draw();
break;
}
}
}
ALLEGRO_COLOR
blue_hue_palette (ALLEGRO_COLOR c)
{
unsigned char r, g, b, a;
al_unmap_rgba (c, &r, &g, &b, &a);
if (a == 0) return c;
r = add_char (r, -96);
g = add_char (g, -80);
b = add_char (b, +64);
return al_map_rgb (r, g, b);
}
void add_conv_char(t_string *t, char c)
{
load(t);
if ((t->space -= 1) < 0)
return (add_char(t, c));
if (t->left == 0)
fill_character(t, t->pad);
add_char(t, c);
if (t->left)
fill_character(t, t->pad);
}
ALLEGRO_COLOR
gray_hue_palette (ALLEGRO_COLOR c)
{
unsigned char r, g, b, a;
al_unmap_rgba (c, &r, &g, &b, &a);
if (a == 0) return c;
r = add_char (r, +13);
g = add_char (g, -7);
b = add_char (b, -52);
return al_map_rgb (r, g, b);
}
ALLEGRO_COLOR
yellow_hue_palette (ALLEGRO_COLOR c)
{
unsigned char r, g, b, a;
al_unmap_rgba (c, &r, &g, &b, &a);
if (a == 0) return c;
r = add_char (r, +78);
g = add_char (g, +25);
b = add_char (b, -64);
return al_map_rgb (r, g, b);
}
static void add_xo_form2(uint32_t instr, const char * mnemonic) {
uint8_t rA = bits_uint8(instr, 11, 5);
uint8_t rD = bits_uint8(instr, 6, 5);
add_str(mnemonic);
if (bits_uint8(instr, 21, 1)) add_char('o');
if (bits_uint8(instr, 31, 1)) add_char('.');
add_str(" r");
add_dec_uint8(rD);
add_str(", r");
add_dec_uint8(rA);
}
static int add_num2(char *string, int num, int max, enum padding pad)
{
int top = num / 10;
int length = 0;
if (top == 0 && pad == blank)
add_char(' ');
else if (top != 0 || pad == zero)
add_char(top + '0');
add_char(num % 10 + '0');
return length;
}
static krb5_error_code
unparse_name_fixed(krb5_context context,
krb5_const_principal principal,
char *name,
size_t len,
int flags)
{
size_t idx = 0;
int i;
int short_form = (flags & KRB5_PRINCIPAL_UNPARSE_SHORT) != 0;
int no_realm = (flags & KRB5_PRINCIPAL_UNPARSE_NO_REALM) != 0;
int display = (flags & KRB5_PRINCIPAL_UNPARSE_DISPLAY) != 0;
if (!no_realm && princ_realm(principal) == NULL) {
krb5_set_error_message(context, ERANGE,
N_("Realm missing from principal, "
"can't unparse", ""));
return ERANGE;
}
for(i = 0; i < princ_num_comp(principal); i++){
if(i)
add_char(name, idx, len, '/');
idx = quote_string(princ_ncomp(principal, i), name, idx, len, display);
if(idx == len) {
krb5_set_error_message(context, ERANGE,
N_("Out of space printing principal", ""));
return ERANGE;
}
}
/* add realm if different from default realm */
if(short_form && !no_realm) {
krb5_realm r;
krb5_error_code ret;
ret = krb5_get_default_realm(context, &r);
if(ret)
return ret;
if(strcmp(princ_realm(principal), r) != 0)
short_form = 0;
free(r);
}
if(!short_form && !no_realm) {
add_char(name, idx, len, '@');
idx = quote_string(princ_realm(principal), name, idx, len, display);
if(idx == len) {
krb5_set_error_message(context, ERANGE,
N_("Out of space printing "
"realm of principal", ""));
return ERANGE;
}
}
return 0;
}
void
sprint_unsigned_decimal_aux(natural n, Boolean first)
{
if (n == 0) {
if (first) {
add_char('0');
}
} else {
sprint_unsigned_decimal_aux(n/10, false);
add_char(digits[n%10]);
}
}
static void add_disp8(void) {
uint32_t disp = get_code();
if (disp < 0x80) {
add_char('+');
}
else {
add_char('-');
disp = (disp ^ 0xff) + 1;
}
add_str("0x");
add_hex_uint32(disp);
}
void
sprint_specializers_list(LispObj o, int depth)
{
LispObj the_cdr, the_car;
add_char('(');
while(1) {
if (o != lisp_nil) {
the_car = car(o);
if (fulltag_of(the_car) == fulltag_misc) {
LispObj header = header_of(the_car);
unsigned subtag = header_subtag(header);
if (subtag == subtag_instance) {
if (unbox_fixnum(deref(the_car,1)) < (1<<20)) {
sprint_lisp_object(deref(deref(the_car,3), 4), depth);
} else {
/* An EQL specializer */
add_c_string("(EQL ");
sprint_lisp_object(deref(deref(the_car,3), 3), depth);
add_char(')');
}
} else if (subtag == subtag_macptr) {
char *class_name = foreign_class_name(deref(the_car,1));
if (class_name) {
add_c_string(class_name);
} else {
sprint_lisp_object(the_car, depth);
}
} else {
sprint_lisp_object(the_car, depth);
}
} else {
sprint_lisp_object(the_car, depth);
}
the_cdr = cdr(o);
if (the_cdr != lisp_nil) {
add_char(' ');
if (fulltag_of(the_cdr) == fulltag_cons) {
o = the_cdr;
continue;
}
add_c_string(". ");
sprint_lisp_object(the_cdr, depth);
break;
}
}
break;
}
add_char(')');
}
static void s_alt(void)
{
if (sgt_printf()->flags.alt && sgt_printf()->flags.base == 16)
{
add_char(L'0');
add_char(sgt_printf()->flags.spec);
}
if (sgt_printf()->flags.number.word != 0 && sgt_printf()->flags.alt
&& sgt_printf()->flags.base == 8)
{
add_char('0');
sgt_printf()->flags.width -= 1;
}
}
static void
process_defun_args (char **defun_args, int auto_var_p)
{
int pending_space = 0;
if (xml)
{
xml_process_defun_args (defun_args, auto_var_p);
return;
}
for (;;)
{
char *defun_arg = *defun_args++;
if (defun_arg == NULL)
break;
if (defun_arg[0] == ' ')
{
pending_space = 1;
continue;
}
if (pending_space)
{
add_char (' ');
pending_space = 0;
}
if (DEFUN_SELF_DELIMITING (defun_arg[0]))
{
/* Within @deffn and friends, texinfo.tex makes parentheses
sans serif and brackets bold. We use roman instead. */
if (html)
insert_html_tag (START, "");
add_char (defun_arg[0]);
if (html)
insert_html_tag (END, "");
}
/* else if (defun_arg[0] == '&' || defun_arg[0] == COMMAND_PREFIX) */
/* execute_string ("%s", defun_arg); */
/* else if (auto_var_p) */
/* execute_string ("%s", defun_arg); */
else
execute_string ("%s", defun_arg);
}
}
static int add_value (LuaMatchState *ms, char_buffer_st **b, const char *s,
const char *e, const char *news) {
size_t l, i;
l = strlen(news);
for (i = 0; i < l; i++) {
if (news[i] != L_ESC){
if(!add_char(ms, b, news[i])) return 0;
}
else {
i++; /* skip ESC */
if (!isdigit(uchar(news[i]))) {
if (news[i] != L_ESC){
ms->error = "invalid use of replacement string";
return 0;
}
if(!add_char(ms, b, news[i])) return 0;
}
else if (news[i] == '0'){
if(!add_str(ms, b, s, e - s)) return 0;
}
else {
int il = news[i] - '1';
if (il >= ms->level) {
if (il == 0){ /* ms->level == 0, too */
if(!add_str(ms, b, s, e - s)) return 0; /* add whole match */
}
else{
ms->error = "invalid capture index";
return 0;
}
}
else {
ptrdiff_t cl = ms->capture[il].len;
if (cl == CAP_UNFINISHED) {
ms->error = "unfinished capture";
return 0;
}
if (cl == CAP_POSITION){
char buf[32];
snprintf(buf, sizeof(buf), "%d", ms->capture[il].init - ms->src_init + 1);
if(!add_str(ms, b, buf, strlen(buf))) return 0;
}
else
if(!add_str(ms, b, ms->capture[il].init, cl)) return 0;
}
}
}
}
return 1;
}
void
sprint_function(LispObj o, int depth)
{
LispObj lfbits, header, name = lisp_nil;
natural elements;
header = header_of(o);
elements = header_element_count(header);
lfbits = deref(o, elements);
if ((lfbits & lfbits_noname_mask) == 0) {
name = deref(o, elements-1);
}
add_c_string("#<");
if (name == lisp_nil) {
add_c_string("Anonymous Function ");
} else {
if (lfbits & lfbits_method_mask) {
if (header_subtag(header_of(name)) == subtag_instance) {
LispObj
slot_vector = deref(name,3),
method_name = deref(slot_vector, 6),
method_qualifiers = deref(slot_vector, 2),
method_specializers = deref(slot_vector, 3);
add_c_string("Method-Function ");
sprint_lisp_object(method_name, depth);
add_char(' ');
if (method_qualifiers != lisp_nil) {
if (cdr(method_qualifiers) == lisp_nil) {
sprint_lisp_object(car(method_qualifiers), depth);
} else {
sprint_lisp_object(method_qualifiers, depth);
}
add_char(' ');
}
sprint_specializers_list(method_specializers, depth);
} else {
sprint_lisp_object(name, depth);
}
add_char(' ');
} else {
add_c_string("Function ");
sprint_lisp_object(name, depth);
add_char(' ');
}
}
sprint_unsigned_hex(o);
add_char('>');
}
void write_PDB_dstring
(JNIEnv *env, jobject graph, jobject elementRule,
void *nGraph, int dimension, dstring *encoding)
{
char buffer [100], *element;
int i, size;
void *iterator;
g_float *coord;
jclass elementRuleClass;
jmethodID getElement, getBytes;
prepare_get_element
(env, elementRule, &elementRuleClass, &getElement, &getBytes);
clear_dstring (encoding);
size = get_graph_size (nGraph);
for (i = 1; i <= size; ++i)
{
coord = get_3d_coordinates (nGraph, i);
element = get_element
(env, elementRule, elementRuleClass, getElement, getBytes, graph, i);
if (element == NULL) element = "X";
sprintf (buffer,
"ATOM %5d %3s %8.3f%8.3f%8.3f \n",
i, element, coord [0], coord [1], coord [2]);
add_string (encoding, buffer);
}
for (i = 1; i <= size; ++i)
{
void *iterator;
int k = 0;
iterator = get_edge_iterator (nGraph, i);
while (has_next_edge (iterator))
{
int j;
if (k % 6 == 0) {
if (k > 0) add_char (encoding, '\n');
add_string (encoding, "CONECT");
sprintf (buffer, "%5d", i);
add_string (encoding, buffer);
}
++k;
j = get_next_edge (iterator);
sprintf (buffer, "%5d", j);
add_string (encoding, buffer);
}
free (iterator);
add_char (encoding, '\n');
}
add_string (encoding, "END\n");
}
static void s_flags(void)
{
if (sgt_printf()->flags.is_negative && sgt_printf()->flags.base == 10)
{
add_char('-');
}
else if (sgt_printf()->flags.showsign && sgt_printf()->flags.base == 10)
{
add_char('+');
}
else if (sgt_printf()->flags.space && sgt_printf()->flags.base == 10)
{
add_char(' ');
}
}
static size_t
quote_string(const char *s, char *out, size_t idx, size_t len)
{
const char *p, *q;
for(p = s; *p && idx < len; p++){
if((q = strchr(quotable_chars, *p))){
add_char(out, idx, len, '\\');
add_char(out, idx, len, replace_chars[q - quotable_chars]);
}else
add_char(out, idx, len, *p);
}
if(idx < len)
out[idx] = '\0';
return idx;
}
CAMLexport char * caml_format_exception(value exn)
{
mlsize_t start, i;
value bucket, v;
struct stringbuf buf;
char intbuf[64];
char * res;
buf.ptr = buf.data;
buf.end = buf.data + sizeof(buf.data) - 1;
add_string(&buf, String_val(Field(Field(exn, 0), 0)));
if (Wosize_val(exn) >= 2) {
/* Check for exceptions in the style of Match_failure and Assert_failure */
if (Wosize_val(exn) == 2 &&
Is_block(Field(exn, 1)) &&
Tag_val(Field(exn, 1)) == 0 &&
caml_is_special_exception(Field(exn, 0))) {
bucket = Field(exn, 1);
start = 0;
} else {
bucket = exn;
start = 1;
}
add_char(&buf, '(');
for (i = start; i < Wosize_val(bucket); i++) {
if (i > start) add_string(&buf, ", ");
v = Field(bucket, i);
if (Is_long(v)) {
sprintf(intbuf, "%" ARCH_INTNAT_PRINTF_FORMAT "d", Long_val(v));
add_string(&buf, intbuf);
} else if (Tag_val(v) == String_tag) {
add_char(&buf, '"');
add_string(&buf, String_val(v));
add_char(&buf, '"');
} else {
add_char(&buf, '_');
}
}
add_char(&buf, ')');
}
*buf.ptr = 0; /* Terminate string */
i = buf.ptr - buf.data + 1;
/* OCamlCC: fix g++ warning */
res = (char *) malloc(i);
if (res == NULL) return NULL;
memmove(res, buf.data, i);
return res;
}
/* print table of contents in ASCII (--no-headers)
May be we should create a new command line switch --ascii ? */
static void
contents_update_info (void)
{
int i;
int k;
if (!toc_counter)
return;
insert_string ((char *) gdt("Table of Contents"));
insert ('\n');
for (i = 0; i < strlen (gdt("Table of Contents")); i++)
insert ('*');
insert_string ("\n\n");
for (i = 0; i < toc_counter; i++)
{
if (toc_entry_alist[i]->level == 0)
add_char ('\n');
/* indention with two spaces per level, should this
changed? */
for (k = 0; k < toc_entry_alist[i]->level; k++)
insert_string (" ");
insert_string (toc_entry_alist[i]->name);
insert ('\n');
}
insert_string ("\n\n");
}
void
add_string(char *s, int len)
{
while(len--) {
add_char(*s++);
}
}
