static SCM
scm_from_byte_string (const char *buf, size_t len)
{
    SCM str = scm_from_locale_stringn (buf, len);

    return string_to_object (str);
}
Example #2
0
void
dialogue_command_rep::apply () {
  int i;
  object cmd  = null_object ();
  object learn= null_object ();
  for (i=nr_args-1; i>=0; i--) {
    string s_arg;
    sv->dialogue_inquire (i, s_arg);
    if (s_arg == "#f") {
      exec_delayed (scheme_cmd ("(dialogue-end)"));
      return;
    }
    object arg= string_to_object (s_arg);
    cmd= cons (arg, cmd);
    if (!is_empty (p) && get_type (p, i) == "password")
      learn= cons (cons (object (as_string (i)), object ("")), learn);
    else
      learn= cons (cons (object (as_string (i)), arg), learn);
    //call ("learn-interactive-arg", fun, object (i), arg);
  }
  call ("learn-interactive", fun, learn);
  cmd= cons (fun, cmd);
  exec_delayed (scheme_cmd ("(dialogue-end)"));
  exec_delayed (scheme_cmd (cmd));
}
Example #3
0
void
interactive_command_rep::apply () {
  if ((i>0) && (s[i-1] == "#f")) return;
  if (i == N(p)) {
    object learn= null_object ();
    array<object> params (N(p));
    for (i=N(p)-1; i>=0; i--) {
      params[i]= string_to_object (s[i]);
      if (get_type (p, i) == "password")
	learn= cons (cons (object (as_string (i)), object ("")), learn);
      else
	learn= cons (cons (object (as_string (i)), params[i]), learn);
    }
    call ("learn-interactive", fun, learn);
    string ret= object_to_string (call (fun, params));
    if (ret != "" && ret != "<unspecified>" && ret != "#<unspecified>")
      sv->set_message (verbatim (ret), "interactive command");
  }
  else {
    s[i]= string ("");
    string prompt= get_prompt (p, i);
    string type  = get_type (p, i);
    array<string> proposals= get_proposals (p, i);
    win->interactive (prompt, type, proposals, s[i], this);
    i++;
  }
}
Example #4
0
tree
rewrite_impl (tree t) {
    switch (L(t)) {
    case EXTERN:
    {
        int i, n= N(t);
        tree r (TUPLE, n);
        for (i=0; i<n; i++)
            r[i]= evaluate (t[i]);
        object expr= null_object ();
        for (i=n-1; i>0; i--)
            expr= cons (object (r[i]), expr);
        string fun= evaluate_string (t[0]);
        expr= cons (string_to_object (fun), expr);
        bool secure= as_bool (std_env ["secure"]);
        if (!secure && script_status < 2) {
            if (!as_bool (call ("secure?", expr)))
                return tree (ERROR, "insecure script");
        }
        environment old_env= reenter_rewrite_env;
        reenter_rewrite_env= std_env;
        object o= eval (expr);
        reenter_rewrite_env= old_env;
        return content_to_tree (o);
    }
#ifdef CLASSICAL_MACRO_EXPANSION
    case MAP_ARGS:
    {
        if (!(is_atomic (t[0]) && is_atomic (t[1]) && is_atomic (t[2])))
            return evaluate_error ("invalid map-args");
        if (macro_top_level (std_env))
            return evaluate_error ("undefined", t[2]);
        basic_environment local= macro_arguments (std_env);
        int key= make_tree_label (t[2]->label);
        if (!local->contains (key))
            return evaluate_error ("undefined", t[2]);
        tree v= local [key];
        if (is_atomic (v))
            return evaluate_error ("invalid-map-args");
        macro_up (std_env);

        int start= 0, end= N(v);
        if (N(t)>=4) start= as_int (evaluate (t[3]));
        if (N(t)>=5) end  = as_int (evaluate (t[4]));
        int i, n= max (0, end-start);
        tree r (make_tree_label (t[1]->label), n);
        for (i=0; i<n; i++)
            r[i]= tree (make_tree_label (t[0]->label),
                        tree (ARG, copy (t[2]), as_string (start+i)),
                        as_string (start+i));

        macro_redown (std_env, local);
        return r;
    }
#endif // CLASSICAL_MACRO_EXPANSION
    case VAR_INCLUDE:
    {
        url base_file_name (as_string (std_env ["base-file-name"]));
        url file_name= url_system (evaluate_string (t[0]));
        return load_inclusion (relative (base_file_name, file_name));
    }
    case REWRITE_INACTIVE:
    {
#ifdef CLASSICAL_MACRO_EXPANSION
        if ((!is_func (t[0], ARG)) || is_compound (t[0][0]))
            return evaluate_error ("invalid rewrite-inactive");
        if (macro_top_level (std_env))
            return evaluate_error ("undefined", t[0][0]);
        basic_environment local= macro_arguments (std_env);
        int key= make_tree_label (t[0][0]->label);
        if (!local->contains (key))
            return evaluate_error ("undefined", t[0][0]);
        tree val= local [key];
        int i, n= N(t[0]);
        for (i=1; i<n; i++) {
            int j= as_int (t[0][i]);
            if ((j>=0) && (j<N(val))) val= val[j];
            else return evaluate_error ("invalid rewrite-inactive");
        }
#else
        tree val= t[0];
#endif
        int inactive_mode= INACTIVE_INLINE_RECURSE;
        if (t[1] == "recurse") inactive_mode= INACTIVE_INLINE_RECURSE;
        else if (t[1] == "recurse*") inactive_mode= INACTIVE_BLOCK_RECURSE;
        else if (t[1] == "once") inactive_mode= INACTIVE_INLINE_ONCE;
        else if (t[1] == "once*") inactive_mode= INACTIVE_BLOCK_ONCE;
        else if (t[1] == "error") inactive_mode= INACTIVE_INLINE_ERROR;
        else if (t[1] == "error*") inactive_mode= INACTIVE_BLOCK_ERROR;
        return rewrite_inactive (val, inactive_mode);
    }
    default:
        return t;
    }
}