static int
win_shell(term_t op, term_t file, term_t how)
{ size_t lo, lf;
wchar_t *o, *f;
UINT h;
HINSTANCE instance;
if ( !PL_get_wchars(op, &lo, &o, CVT_ALL|CVT_EXCEPTION|BUF_RING) ||
!PL_get_wchars(file, &lf, &f, CVT_ALL|CVT_EXCEPTION|BUF_RING) ||
!get_showCmd(how, &h) )
fail;
instance = ShellExecuteW(NULL, o, f, NULL, NULL, h);
if ( (intptr_t)instance <= 32 )
{ const shell_error *se;
for(se = se_errors; se->message; se++)
{ if ( se->eno == (int)(intptr_t)instance )
return PL_error(NULL, 0, se->message, ERR_SHELL_FAILED, file);
}
PL_error(NULL, 0, NULL, ERR_SHELL_FAILED, file);
}
succeed;
}
static foreign_t
uri_query_components(term_t string, term_t list)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(string, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) )
{ return unify_query_string_components(list, len, s);
} else if ( PL_is_list(list) )
{ term_t tail = PL_copy_term_ref(list);
term_t head = PL_new_term_ref();
term_t nv = PL_new_term_refs(2);
charbuf out;
int rc;
fill_flags();
init_charbuf(&out);
while( PL_get_list(tail, head, tail) )
{ atom_t fname;
int arity;
if ( PL_is_functor(head, FUNCTOR_equal2) ||
PL_is_functor(head, FUNCTOR_pair2) )
{ _PL_get_arg(1, head, nv+0);
_PL_get_arg(2, head, nv+1);
} else if ( PL_get_name_arity(head, &fname, &arity) && arity == 1 )
{ PL_put_atom(nv+0, fname);
_PL_get_arg(1, head, nv+1);
} else
{ free_charbuf(&out);
return type_error("name_value", head);
}
if ( out.here != out.base )
add_charbuf(&out, '&');
if ( !add_encoded_term_charbuf(&out, nv+0, ESC_QNAME) )
{ free_charbuf(&out);
return FALSE;
}
add_charbuf(&out, '=');
if ( !add_encoded_term_charbuf(&out, nv+1, ESC_QVALUE) )
{ free_charbuf(&out);
return FALSE;
}
}
rc = PL_unify_wchars(string, PL_ATOM, out.here-out.base, out.base);
free_charbuf(&out);
return rc;
} else
{ return PL_get_wchars(string, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION);
}
return FALSE;
}
static foreign_t
uri_authority_components(term_t Authority, term_t components)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(Authority, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) )
{ return unify_uri_authority_components(components, len, s);
} else if ( PL_is_functor(components, FUNCTOR_uri_authority4) )
{ charbuf b;
int rc;
init_charbuf(&b);
if ( (rc=get_text_arg(components, 1, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
if ( (rc=get_text_arg(components, 2, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_charbuf(&b, ':');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
add_charbuf(&b, '@');
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
if ( (rc=get_text_arg(components, 3, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
if ( (rc=get_text_arg(components, 4, &len, &s,
TXT_EX_TEXT|CVT_INTEGER)) == TRUE )
{ add_charbuf(&b, ':');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
rc = PL_unify_wchars(Authority, PL_ATOM, b.here-b.base, b.base);
free_charbuf(&b);
return rc;
} else
{ return PL_get_wchars(Authority, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION);
}
}
static foreign_t
turtle_name(term_t name)
{ char *s;
pl_wchar_t *w;
size_t len;
if ( PL_get_nchars(name, &len, &s, CVT_ATOM) )
{ const char *e = &s[len];
if ( !wcis_name_start_char(s[0]&0xff) )
return FALSE;
for(s++; s<e; s++)
{ if ( !wcis_name_char(s[0]&0xff) )
return FALSE;
}
return TRUE;
} else if ( PL_get_wchars(name, &len, &w, CVT_ATOM|CVT_EXCEPTION) )
{ const pl_wchar_t *e = &w[len];
if ( !wcis_name_start_char(w[0]) )
return FALSE;
for(w++; w<e; w++)
{ if ( !wcis_name_char(w[0]) )
return FALSE;
}
return TRUE;
} else
return FALSE;
}
static foreign_t
turtle_write_uri(term_t Stream, term_t Value)
{ size_t len;
char *s;
pl_wchar_t *w;
IOSTREAM *out;
if ( !PL_get_stream_handle(Stream, &out) )
return FALSE;
if ( PL_get_nchars(Value, &len, &s, CVT_ATOM|CVT_STRING) )
{ const char *e = &s[len];
Sputcode('<', out);
for(; s<e; s++)
{ if ( ttl_put_ucharacter(out, s[0]&0xff) < 0 )
break;
}
Sputcode('>', out);
return PL_release_stream(out);
} else if ( PL_get_wchars(Value, &len, &w, CVT_ATOM|CVT_EXCEPTION) )
{ const pl_wchar_t *e = &w[len];
Sputcode('<', out);
for(; w<e; w++)
{ if ( ttl_put_ucharacter(out, w[0]) < 0 )
break;
}
Sputcode('>', out);
return PL_release_stream(out);
} else
{ PL_release_stream(out);
return FALSE;
}
}
static const uri_component_ranges *
base_ranges(term_t t)
{ atom_t a;
if ( PL_get_atom(t, &a) )
{ base_cache *base = myBase();
if ( base->atom != a )
{ size_t len;
pl_wchar_t *s;
if ( base->atom )
{ PL_unregister_atom(base->atom);
PL_free(base->text);
}
if ( !PL_get_wchars(t, &len, &s, CVT_ATOM|BUF_MALLOC) )
return NULL;
base->atom = a;
PL_register_atom(a);
base->text = s;
parse_uri(&base->ranges, len, s);
}
return &base->ranges;
} else
{ type_error("atom", t);
return NULL;
}
}
static int
parse_options(term_t options, p_options *info)
{ term_t tail = PL_copy_term_ref(options);
term_t head = PL_new_term_ref();
term_t arg = PL_new_term_ref();
info->window = MAYBE;
while(PL_get_list(tail, head, tail))
{ atom_t name;
int arity;
if ( !PL_get_name_arity(head, &name, &arity) || arity != 1 )
return type_error(head, "option");
_PL_get_arg(1, head, arg);
if ( name == ATOM_stdin )
{ if ( !get_stream(arg, info, &info->streams[0]) )
return FALSE;
} else if ( name == ATOM_stdout )
{ if ( !get_stream(arg, info, &info->streams[1]) )
return FALSE;
} else if ( name == ATOM_stderr )
{ if ( !get_stream(arg, info, &info->streams[2]) )
return FALSE;
} else if ( name == ATOM_process )
{ info->pid = PL_copy_term_ref(arg);
} else if ( name == ATOM_detached )
{ if ( !PL_get_bool(arg, &info->detached) )
return type_error(arg, "boolean");
} else if ( name == ATOM_cwd )
{
#ifdef __WINDOWS__
if ( !PL_get_wchars(arg, NULL, &info->cwd,
CVT_ATOM|CVT_STRING|CVT_EXCEPTION|BUF_MALLOC) )
return FALSE;
#else
if ( !PL_get_chars(arg, &info->cwd,
CVT_ATOM|CVT_STRING|CVT_EXCEPTION|BUF_MALLOC|REP_FN) )
return FALSE;
#endif
} else if ( name == ATOM_window )
{ if ( !PL_get_bool(arg, &info->window) )
return type_error(arg, "boolean");
} else if ( name == ATOM_env )
{ if ( !parse_environment(arg, info) )
return FALSE;
} else
return domain_error(head, "process_option");
}
if ( !PL_get_nil(tail) )
return type_error(tail, "list");
return TRUE;
}
static foreign_t
pl_win_open_console(term_t title, term_t input, term_t output, term_t error,
term_t options)
{ rlc_console_attr attr;
rlc_console c;
IOSTREAM *in, *out, *err;
TCHAR *s;
size_t len;
memset(&attr, 0, sizeof(attr));
if ( !PL_get_wchars(title, &len, &s, CVT_ALL|BUF_RING) )
return type_error(title, "text");
attr.title = (const TCHAR*) s;
if ( !process_console_options(&attr, options) )
return FALSE;
c = rlc_create_console(&attr);
create_prolog_hidden_window(c); /* for sending messages */
registerConsole(c);
#define STREAM_COMMON (SIO_TEXT| /* text-stream */ \
SIO_NOCLOSE| /* do no close on abort */ \
SIO_ISATTY| /* terminal */ \
SIO_NOFEOF) /* reset on end-of-file */
in = Snew(c, SIO_INPUT|SIO_LBUF|STREAM_COMMON, &rlc_functions);
out = Snew(c, SIO_OUTPUT|SIO_LBUF|STREAM_COMMON, &rlc_functions);
err = Snew(c, SIO_OUTPUT|SIO_NBUF|STREAM_COMMON, &rlc_functions);
in->position = &in->posbuf; /* record position on same stream */
out->position = &in->posbuf;
err->position = &in->posbuf;
in->encoding = ENC_WCHAR;
out->encoding = ENC_WCHAR;
err->encoding = ENC_WCHAR;
if ( !PL_unify_stream(input, in) ||
!PL_unify_stream(output, out) ||
!PL_unify_stream(error, err) )
{ Sclose(in);
Sclose(out);
Sclose(err);
rlc_close(c);
return FALSE;
}
rlc_set(c, RLC_PROLOG_INPUT, (uintptr_t)in, NULL);
rlc_set(c, RLC_PROLOG_OUTPUT, (uintptr_t)out, NULL);
rlc_set(c, RLC_PROLOG_ERROR, (uintptr_t)err, free_stream);
return TRUE;
}
static int
get_text_arg(term_t term, int pos, size_t *len, pl_wchar_t **s, int flags)
{ term_t tmp = PL_new_term_ref();
_PL_get_arg(pos, term, tmp);
if ( PL_is_variable(tmp) )
return FALSE;
if ( !PL_get_wchars(tmp, len, s, flags) )
return -1;
return TRUE;
}
static foreign_t
is_plaincase1(term_t atom)
{ char* s;
wchar_t* ws;
size_t len;
if (PL_get_chars(atom, &s, CVT_ATOMIC))
return is_plaincase(s);
if (PL_get_wchars(atom, &len, &ws, CVT_ATOMIC))
return is_wplaincase(ws, len);
return FALSE;
}
static foreign_t
is_diacritics1(term_t atom)
{ char* s;
wchar_t* ws;
size_t len;
if (PL_get_chars(atom, &s, CVT_ATOMIC))
return is_diacritics((unsigned char*) s);
if (PL_get_wchars(atom, &len, &ws, CVT_ATOMIC))
return is_wdiacritics(ws, len);
return FALSE;
}
word
pl_win_exec(term_t cmd, term_t how)
{ wchar_t *s;
size_t len;
UINT h;
if ( PL_get_wchars(cmd, &len, &s, CVT_ALL|CVT_EXCEPTION) &&
get_showCmd(how, &h) )
{ return win_exec(len, s, h);
} else
fail;
}
static foreign_t
uri_encoded(term_t what, term_t qv, term_t enc)
{ pl_wchar_t *s;
size_t len;
atom_t w;
int flags;
if ( !PL_get_atom(what, &w) )
return type_error("atom", what);
if ( w == ATOM_query_value )
flags = ESC_QVALUE;
else if ( w == ATOM_fragment )
flags = ESC_FRAGMENT;
else if ( w == ATOM_path )
flags = ESC_PATH;
else
return domain_error("uri_component", what);
fill_flags();
if ( !PL_is_variable(qv) )
{ charbuf out;
int rc;
init_charbuf(&out);
if ( !add_encoded_term_charbuf(&out, qv, flags) )
{ free_charbuf(&out);
return FALSE;
}
rc = PL_unify_wchars(enc, PL_ATOM, out.here-out.base, out.base);
free_charbuf(&out);
return rc;
} else if ( PL_get_wchars(enc, &len, &s, CVT_ATOM|CVT_STRING|CVT_EXCEPTION) )
{ range r;
r.start = s;
r.end = s+len;
return unify_decoded_atom(qv, &r, flags);
} else
{ return FALSE;
}
}
static int
get_exe(term_t exe, p_options *info)
{ int arity;
term_t arg = PL_new_term_ref();
if ( !PL_get_name_arity(exe, &info->exe_name, &arity) )
return type_error(exe, "callable");
PL_put_atom(arg, info->exe_name);
#ifdef __WINDOWS__
if ( !PL_get_wchars(arg, NULL, &info->exe, CVT_ATOM|CVT_EXCEPTION|BUF_MALLOC) )
return FALSE;
if ( !win_command_line(exe, arity, info->exe, &info->cmdline) )
return FALSE;
#else /*__WINDOWS__*/
if ( !PL_get_chars(arg, &info->exe, CVT_ATOM|CVT_EXCEPTION|BUF_MALLOC|REP_FN) )
return FALSE;
if ( !(info->argv = PL_malloc((arity+2)*sizeof(char*))) )
return PL_resource_error("memory");
memset(info->argv, 0, (arity+2)*sizeof(char*));
if ( !(info->argv[0] = PL_malloc(strlen(info->exe)+1)) )
return PL_resource_error("memory");
strcpy(info->argv[0], info->exe);
{ int i;
for(i=1; i<=arity; i++)
{ _PL_get_arg(i, exe, arg);
if ( !PL_get_chars(arg, &info->argv[i],
CVT_ATOMIC|CVT_EXCEPTION|BUF_MALLOC|REP_FN) )
return FALSE;
}
info->argv[i] = NULL;
}
#endif /*__WINDOWS__*/
return TRUE;
}
static foreign_t
pl_no_diacritics_atom(term_t in, term_t out)
{ char *s, *to;
size_t len;
wchar_t *ws, *wto;
if (PL_get_nchars(in, &len, &s, CVT_ATOMIC))
{ if ((to = alloca(len+1)))
{ no_diacritics(s, to);
return PL_unify_chars(out, PL_ATOM, len, to);
}
} else
if (PL_get_wchars(in, &len, &ws, CVT_ATOMIC))
{ if ((wto = alloca((len+1)*sizeof(wchar_t))))
{ wno_diacritics(ws, len, wto);
return PL_unify_wchars(out, PL_ATOM, len, wto);
}
}
return FALSE;
}
static int
get_hsz(DWORD ddeInst, term_t data, HSZ *rval)
{ wchar_t *s;
size_t len;
if ( PL_get_wchars(data, &len, &s, CVT_ALL|CVT_EXCEPTION) )
{ HSZ h;
assert(s[len] == 0); /* Must be 0-terminated */
DEBUG(2, Sdprintf("Get HSZ for %Ws ...\n", s));
if ( (h=DdeCreateStringHandleW(ddeInst, s, CP_WINUNICODE)) )
{ DEBUG(2, Sdprintf("\tHSZ = %p\n", h));
*rval = h;
succeed;
}
return PL_error(NULL, 0, WinError(), ERR_SYSCALL, "DdeCreateStringHandleW");
}
fail;
}
static int
add_encoded_term_charbuf(charbuf *cb, term_t value, int flags)
{ pl_wchar_t *s;
range r;
size_t len;
if ( !PL_get_wchars(value, &len, &s, CVT_ATOMIC|CVT_EXCEPTION) )
return FALSE;
r.start = s;
r.end = r.start+len;
if ( range_is_unreserved(&r, TRUE, flags) )
{ add_nchars_charbuf(cb, r.end-r.start, r.start);
} else
{ const pl_wchar_t *s = r.start;
while(s<r.end)
add_encoded_charbuf(cb, *s++, flags);
}
return TRUE;
}
static foreign_t
normalized(term_t URI, term_t CannonicalURI, int iri)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(URI, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION) )
{ uri_component_ranges ranges;
charbuf b;
int rc;
parse_uri(&ranges, len, s);
init_charbuf(&b);
normalize_in_charbuf(&b, &ranges, iri);
rc = PL_unify_wchars(CannonicalURI, PL_ATOM, b.here-b.base, b.base);
free_charbuf(&b);
return rc;
}
return FALSE;
}
static int
get_echars_arg_ex(int i, term_t from, term_t arg, echar **sp, size_t *lenp)
{ const echar *s, *e;
if ( !PL_get_arg(i, from, arg) )
return FALSE;
#ifdef __WINDOWS__
if ( !PL_get_wchars(arg, lenp, sp,
CVT_ATOMIC|CVT_EXCEPTION) )
#else
if ( !PL_get_nchars(arg, lenp, sp,
CVT_ATOMIC|CVT_EXCEPTION|REP_FN) )
#endif
return FALSE;
for(s = *sp, e = s+*lenp; s<e; s++)
{ if ( !*s )
return domain_error(arg, "text_non_zero_code");
}
return TRUE;
}
static foreign_t
pl_rl_add_history(term_t text)
{ atom_t a;
static atom_t last = 0;
if ( PL_get_atom(text, &a) )
{ if ( a != last )
{ TCHAR *s;
if ( last )
PL_unregister_atom(last);
last = a;
PL_register_atom(last);
PL_get_wchars(text, NULL, &s, CVT_ATOM);
rlc_add_history(PL_current_console(), s);
}
return TRUE;
}
return FALSE;
}
static foreign_t
uri_is_global(term_t URI)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(URI, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION) )
{ const pl_wchar_t *e;
const pl_wchar_t *end = &s[len];
range r;
fill_flags();
e = skip_not(s, end, L":/?#");
if ( e > s && e[0] == ':' )
{ r.start = s;
r.end = e;
if ( range_is_unreserved(&r, FALSE, CH_SCHEME) )
return TRUE;
}
}
return FALSE;
}
static int
win_command_line(term_t t, int arity, const wchar_t *exe, wchar_t **cline)
{ if ( arity > 0 )
{ arg_string *av = PL_malloc((arity+1)*sizeof(*av));
term_t arg = PL_new_term_ref();
size_t cmdlen;
wchar_t *cmdline, *o;
const wchar_t *b;
int i;
if ( (b=wcsrchr(exe, '\\')) )
b++;
else
b = exe;
av[0].text = (wchar_t*)b;
av[0].len = wcslen(av[0].text);
set_quote(&av[0]);
cmdlen = av[0].len+(av[0].quote?2:0)+1;
for( i=1; i<=arity; i++)
{ PL_get_arg(i, t, arg);
if ( !PL_get_wchars(arg, &av[i].len, &av[i].text,
CVT_ATOMIC|CVT_EXCEPTION|BUF_MALLOC) )
return FALSE;
if ( wcslen(av[i].text) != av[i].len )
return domain_error(arg, "no_zero_code_atom");
if ( !set_quote(&av[i]) )
return domain_error(arg, "dos_quotable_atom");
cmdlen += av[i].len+(av[i].quote?2:0)+1;
}
cmdline = PL_malloc(cmdlen*sizeof(wchar_t));
for( o=cmdline,i=0; i<=arity; )
{ wchar_t *s = av[i].text;
if ( av[i].quote )
*o++ = av[i].quote;
wcsncpy(o, s, av[i].len);
o += av[i].len;
if ( i > 0 )
PL_free(s); /* do not free shared exename */
if ( av[i].quote )
*o++ = av[i].quote;
if (++i <= arity)
*o++ = ' ';
}
*o = 0;
PL_free(av);
*cline = cmdline;
} else
{ *cline = NULL;
}
return TRUE;
}
static foreign_t
resolve(term_t Rel, term_t Base, term_t URI, int normalize, int iri)
{ pl_wchar_t *s;
size_t slen;
uri_component_ranges s_ranges, t_ranges;
int rc;
size_t len;
charbuf out, pb, path;
init_charbuf(&pb); /* path-buffer */
if ( PL_get_wchars(Rel, &slen, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION) )
{ parse_uri(&s_ranges, slen, s);
if ( s_ranges.scheme.start )
{ t_ranges = s_ranges;
} else
{ const uri_component_ranges *b_ranges;
if ( !(b_ranges = base_ranges(Base)) )
return FALSE;
memset(&t_ranges, 0, sizeof(t_ranges));
if ( s_ranges.authority.start )
{ t_ranges.authority = s_ranges.authority;
t_ranges.path = s_ranges.path;
t_ranges.query = s_ranges.query;
} else
{ if ( s_ranges.path.start == s_ranges.path.end )
{ t_ranges.path = b_ranges->path;
if ( s_ranges.query.start )
t_ranges.query = s_ranges.query;
else
t_ranges.query = b_ranges->query;
} else
{ if ( s_ranges.path.start[0] == '/' )
{ t_ranges.path = s_ranges.path;
} else
{ if ( b_ranges->authority.start &&
b_ranges->path.start == b_ranges->path.end )
{ add_charbuf(&pb, '/');
add_verb_range_charbuf(&pb, &s_ranges.path);
} else
{ range path = b_ranges->path;
path.end = remove_last_segment(path.start, path.end);
add_verb_range_charbuf(&pb, &path);
add_verb_range_charbuf(&pb, &s_ranges.path);
t_ranges.path.start = pb.base;
t_ranges.path.end = pb.here;
}
}
t_ranges.query = s_ranges.query;
}
t_ranges.authority = b_ranges->authority;
}
t_ranges.scheme = b_ranges->scheme;
t_ranges.fragment = s_ranges.fragment;
}
} else
return FALSE;
init_charbuf(&out); /* output buffer */
if ( normalize )
{ normalize_in_charbuf(&out, &t_ranges, iri);
} else
{ init_charbuf_at_size(&path, t_ranges.path.end - t_ranges.path.start);
len = removed_dot_segments(t_ranges.path.end - t_ranges.path.start,
t_ranges.path.start,
path.base);
t_ranges.path.start = path.base;
t_ranges.path.end = path.base+len;
free_charbuf(&pb);
ranges_in_charbuf(&out, &t_ranges);
}
rc = PL_unify_wchars(URI, PL_ATOM, out.here-out.base, out.base);
free_charbuf(&out);
return rc;
}
static foreign_t
uri_components(term_t URI, term_t components)
{ pl_wchar_t *s;
size_t len;
if ( PL_get_wchars(URI, &len, &s, CVT_ATOM|CVT_STRING|CVT_LIST) )
{ uri_component_ranges ranges;
term_t rt = PL_new_term_refs(6);
term_t av = rt+1;
parse_uri(&ranges, len, s);
unify_range(av+0, &ranges.scheme);
unify_range(av+1, &ranges.authority);
unify_range(av+2, &ranges.path);
unify_range(av+3, &ranges.query);
unify_range(av+4, &ranges.fragment);
return (PL_cons_functor_v(rt, FUNCTOR_uri_components5, av) &&
PL_unify(components, rt));
} else if ( PL_is_functor(components, FUNCTOR_uri_components5) )
{ charbuf b;
int rc;
init_charbuf(&b);
/* schema */
if ( (rc=get_text_arg(components, 1, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
add_charbuf(&b, ':');
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* authority */
if ( (rc=get_text_arg(components, 2, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_charbuf(&b, '/');
add_charbuf(&b, '/');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* path */
if ( (rc=get_text_arg(components, 3, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* query */
if ( (rc=get_text_arg(components, 4, &len, &s, TXT_EX_TEXT)) == TRUE )
{ if ( len > 0 )
{ add_charbuf(&b, '?');
add_nchars_charbuf(&b, len, s);
}
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
/* fragment */
if ( (rc=get_text_arg(components, 5, &len, &s, TXT_EX_TEXT)) == TRUE )
{ add_charbuf(&b, '#');
add_nchars_charbuf(&b, len, s);
} else if ( rc == -1 )
{ free_charbuf(&b);
return FALSE;
}
rc = PL_unify_wchars(URI, PL_ATOM, b.here-b.base, b.base);
free_charbuf(&b);
return rc;
} else /* generate an error */
{ return PL_get_wchars(URI, &len, &s,
CVT_ATOM|CVT_STRING|CVT_LIST|CVT_EXCEPTION);
}
}
static foreign_t
do_quote(term_t in, term_t quoted, char **map, int maxchr)
{ char *inA = NULL;
wchar_t *inW = NULL;
size_t len;
const unsigned char *s;
charbuf buffer;
int changes = 0;
int rc;
if ( !PL_get_nchars(in, &len, &inA, CVT_ATOMIC) &&
!PL_get_wchars(in, &len, &inW, CVT_ATOMIC) )
return sgml2pl_error(ERR_TYPE, "atom", in);
if ( len == 0 )
return PL_unify(in, quoted);
init_buf(&buffer);
if ( inA )
{ for(s = (unsigned char*)inA ; len-- > 0; s++ )
{ int c = *s;
if ( map[c] )
{ if ( !add_str_buf(&buffer, map[c]) )
return FALSE;
changes++;
} else if ( c > maxchr )
{ char buf[10];
sprintf(buf, "&#%d;", c);
if ( !add_str_buf(&buffer, buf) )
return FALSE;
changes++;
} else
{ add_char_buf(&buffer, c);
}
}
if ( changes > 0 )
rc = PL_unify_atom_nchars(quoted, used_buf(&buffer), buffer.bufp);
else
rc = PL_unify(in, quoted);
} else
{ for( ; len-- > 0; inW++ )
{ int c = *inW;
if ( c <= 0xff && map[c] )
{ if ( !add_str_bufW(&buffer, map[c]) )
return FALSE;
changes++;
} else if ( c > maxchr )
{ char buf[10];
sprintf(buf, "&#%d;", c);
if ( !add_str_bufW(&buffer, buf) )
return FALSE;
changes++;
}else
{ add_char_bufW(&buffer, c);
}
}
if ( changes > 0 )
rc = PL_unify_wchars(quoted, PL_ATOM,
used_buf(&buffer)/sizeof(wchar_t),
(wchar_t*)buffer.bufp);
else
rc = PL_unify(in, quoted);
}
free_buf(&buffer);
return rc;
}
static HDDEDATA CALLBACK
DdeCallback(UINT type, UINT fmt, HCONV hconv, HSZ hsz1, HSZ hsz2,
HDDEDATA hData, DWORD dwData1, DWORD dwData2)
{ GET_LD
DWORD ddeInst = LD->os.dde_instance;
switch(type)
{ case XTYP_CONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect3, MODULE_dde);
int rval;
if ( unify_hsz(ddeInst, argv+0, hsz2) && /* topic */
unify_hsz(ddeInst, argv+1, hsz1) && /* service */
PL_unify_integer(argv+2, dwData2 ? 1 : 0) ) /* same instance */
{ rval = PL_call_predicate(MODULE_dde, TRUE, pred, argv);
} else
{ rval = FALSE;
}
PL_discard_foreign_frame(cid);
return (void *)(intptr_t)rval;
}
case XTYP_CONNECT_CONFIRM:
{ int plhandle;
if ( (plhandle = allocServerHandle(hconv)) >= 0 )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_connect_confirm3, MODULE_dde);
if ( unify_hsz(ddeInst, argv+0, hsz2) && /* topic */
unify_hsz(ddeInst, argv+1, hsz1) && /* service */
PL_unify_integer(argv+2, plhandle) )
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
}
return NULL;
}
case XTYP_DISCONNECT:
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(1);
predicate_t pred = PL_pred(FUNCTOR_dde_disconnect1, MODULE_dde);
int plhandle = findServerHandle(hconv);
if ( plhandle >= 0 && plhandle < MAX_CONVERSATIONS )
server_handle[plhandle] = (HCONV)NULL;
PL_put_integer(argv+0, plhandle);
PL_call_predicate(MODULE_dde, TRUE, pred, argv);
PL_discard_foreign_frame(cid);
return NULL;
}
case XTYP_EXECUTE:
{ int plhandle = findServerHandle(hconv);
HDDEDATA rval = DDE_FNOTPROCESSED;
fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(3);
predicate_t pred = PL_pred(FUNCTOR_dde_execute3, MODULE_dde);
DEBUG(1, Sdprintf("Got XTYP_EXECUTE request\n"));
PL_put_integer(argv+0, plhandle);
unify_hsz(ddeInst, argv+1, hsz1);
unify_hdata( argv+2, hData);
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
rval = (void *) DDE_FACK;
PL_discard_foreign_frame(cid);
DdeFreeDataHandle(hData);
return rval;
}
case XTYP_REQUEST:
{ HDDEDATA data = (HDDEDATA) NULL;
if ( fmt == CF_UNICODETEXT )
{ fid_t cid = PL_open_foreign_frame();
term_t argv = PL_new_term_refs(4);
predicate_t pred = PL_pred(FUNCTOR_dde_request4, MODULE_dde);
int plhandle = findServerHandle(hconv);
PL_put_integer( argv+0, plhandle);
unify_hsz(ddeInst, argv+1, hsz1); /* topic */
unify_hsz(ddeInst, argv+2, hsz2); /* item */
if ( PL_call_predicate(MODULE_dde, TRUE, pred, argv) )
{ wchar_t *s;
size_t len;
/* TBD: error handling */
if ( PL_get_wchars(argv+3, &len, &s, CVT_ALL) )
data = DdeCreateDataHandle(ddeInst,
(unsigned char*) s,
(DWORD)(len+1)*sizeof(wchar_t),
0, hsz2, CF_UNICODETEXT, 0);
}
PL_discard_foreign_frame(cid);
}
return data;
}
default:
;
}
return (HDDEDATA)NULL;
}
