C++ scm_is_string函数代码示例

/*! \todo Finish function documentation!!!
 *  \brief
 *  \par Function Description
 *
 */
SCM g_funcs_filesel(SCM scm_msg, SCM scm_templ, SCM scm_flags)
{
  int c_flags;
  char *r, *msg, *templ;
  SCM v;

  SCM_ASSERT (scm_is_string (scm_msg), scm_msg,
	      SCM_ARG1, "gschem-filesel");
  
  SCM_ASSERT (scm_is_string (scm_templ), scm_templ,
	      SCM_ARG2, "gschem-filesel");
  
  /*! \bug FIXME -- figure out the magic SCM_ASSERT for the flags */

  /*! \bug FIXME -- how to deal with conflicting flags? 
   * Should I throw a scheme error?  Just deal in the c code?
   */
  for (c_flags = 0; scm_is_pair (scm_flags); scm_flags = SCM_CDR (scm_flags)) {
    char *flag;
    SCM scm_flag = SCM_CAR (scm_flags);

    flag = scm_to_utf8_string (scm_flag);
    if (strcmp (flag, "may_exist") == 0) {
      c_flags |= FSB_MAY_EXIST;

    } else if (strcmp (flag, "must_exist") == 0) {
      c_flags |= FSB_MUST_EXIST;
      
    } else if (strcmp (flag, "must_not_exist") == 0) {
      c_flags |= FSB_SHOULD_NOT_EXIST;

    } else if (strcmp (flag, "save") == 0) {
      c_flags |= FSB_SAVE;

    } else if (strcmp (flag, "open") == 0) {
      c_flags |= FSB_LOAD;

    } else {
      free(flag);
      scm_wrong_type_arg ("gschem-filesel", SCM_ARG3, scm_flag);
    }
    free(flag);
  }

  msg = scm_to_utf8_string (scm_msg);
  templ = scm_to_utf8_string (scm_templ);

  r = generic_filesel_dialog (msg, templ, c_flags);

  free(msg);
  free(templ);

  v = scm_from_utf8_string (r);
  g_free (r);

  return v;
}

SCM g_get_package_attribute(SCM scm_uref, SCM scm_wanted_attrib)
{
    SCM scm_return_value;
    NETLIST *nl_current;
    char *uref;
    char *wanted_attrib;
    char *return_value = NULL;

    SCM_ASSERT(scm_is_string (scm_uref),
	       scm_uref, SCM_ARG1, "gnetlist:get-package-attribute");

    SCM_ASSERT(scm_is_string (scm_wanted_attrib),
	       scm_wanted_attrib, SCM_ARG2, "gnetlist:get-package-attribute");

    uref          = SCM_STRING_CHARS (scm_uref);
    wanted_attrib = SCM_STRING_CHARS (scm_wanted_attrib);

    /* here is where you make it multi page aware */
    nl_current = netlist_head;

    /* search for the first instance */
    /* through the entire list */
    while (nl_current != NULL) {

	if (nl_current->component_uref) {
	    if (strcmp(nl_current->component_uref, uref) == 0) {

		/* first search outside the symbol */
		return_value =
		    o_attrib_search_name_single(nl_current->object_ptr,
						wanted_attrib, NULL);

		if (return_value) {
		    break;
		}

		/* now search inside the symbol */
		return_value =
		    o_attrib_search_name(nl_current->object_ptr->
					 complex->prim_objs, wanted_attrib,
					 0);

		break;
	    }
	}
	nl_current = nl_current->next;
    }

    if (return_value) {
      scm_return_value = scm_makfrom0str (return_value);
    } else {
      scm_return_value = scm_makfrom0str ("unknown");
    }

    return (scm_return_value);
}

/*! \brief
 *  \par Function Description
 *
 *  \param [in] path 
 *  \param [in] name Optional descriptive name for library directory.
 *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 */
SCM g_rc_component_library(SCM path, SCM name)
{
  gchar *string;
  char *temp;
  char *namestr = NULL;

  SCM_ASSERT (scm_is_string (path), path,
              SCM_ARG1, "component-library");
  
  if (name != SCM_UNDEFINED) {
    SCM_ASSERT (scm_is_string (name), name,
		SCM_ARG2, "component-library");
    namestr = scm_to_utf8_string (name);
  }
  
  /* take care of any shell variables */
  temp = scm_to_utf8_string (path);
  string = s_expand_env_variables (temp);
  free (temp);

  /* invalid path? */
  if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
    fprintf(stderr,
            "Invalid path [%s] passed to component-library\n",
            string);
    if (namestr != NULL) {
      free (namestr);
    }
    g_free(string);
    return SCM_BOOL_F;
  }

  if (g_path_is_absolute (string)) {
    s_clib_add_directory (string, namestr);
  } else {
    gchar *cwd = g_get_current_dir ();
    gchar *temp;
    temp = g_build_filename (cwd, string, NULL);
    s_clib_add_directory (temp, namestr);
    g_free(temp);
    g_free(cwd);
  }

  if (namestr != NULL) {
    free (namestr);
  }
  g_free(string);

  return SCM_BOOL_T;
}

/*! \brief Use gschemdoc to open a browser to a specific wiki page
 *
 * \param [in] wikiname the name of the wiki page
 *
 * \par Function Description
 * Invokes gschemdoc with its -w switch to open a browser to the wiki
 * page specified by wikiname.  If wikiname is empty or not a string, 
 * will browse to the main wiki page.
 */
SCM g_funcs_browse_wiki(SCM wikiname)
{
  char *wikistr;
  int pid;

  /* Extract wiki name string from Scheme value structure.
   * If not a string, use the empty string */
  if (scm_is_string (wikiname)) {
    wikistr = scm_to_utf8_string(wikiname);
  } else {
    wikistr = "";
  }

  #ifndef __MINGW32__

  pid = fork();

  if (pid < 0) {
    /* Fork failed. Still in parent process, so can use the log
     * window */
    if (scm_is_string (wikiname))
      free(wikistr);
    s_log_message(_("Could not fork\n"));
    return SCM_BOOL_F;
  } else if (pid > 0) {
    /* Parent process, we're finished here */
    if (scm_is_string (wikiname))
      free(wikistr);
    return SCM_BOOL_T;
  }
  
  /* begin daughter process stuff */
  
  /* assume gschemdoc is part of path */
  char *gschemdoc = "gschemdoc";
  char *wikiarg = "-w";
  
  execlp(gschemdoc, gschemdoc, wikiarg, wikistr, NULL);

  /* if we return, then nothing happened */
  fprintf(stderr, _("Could not invoke %s\n"), gschemdoc);
  _exit(0);

  /* end daughter process stuff */

#else /* __MINGW32__ */
  s_log_message(_("Documentation commands not supported under MinGW.\n"));
  return SCM_BOOL_F;
#endif /* __MINGW32__ */
}

SCM g_get_pins(SCM uref)
{
    SCM list = SCM_EOL;
    NETLIST *nl_current;
    CPINLIST *pl_current;

    SCM_ASSERT(scm_is_string (uref), uref, SCM_ARG1, "gnetlist:get-pins");

    /* here is where you make it multi page aware */
    nl_current = netlist_head;

    /* search for the first instance */
    /* through the entire list */
    while (nl_current != NULL) {

	if (nl_current->component_uref) {
	    if (strcmp(nl_current->component_uref, SCM_STRING_CHARS (uref)) == 0) {

		pl_current = nl_current->cpins;
		while (pl_current != NULL) {
		    if (pl_current->pin_number) {
              list = scm_cons (scm_makfrom0str (pl_current->pin_number),
                               list);
		    }
		    pl_current = pl_current->next;
		}
	    }
	}
	nl_current = nl_current->next;
    }

    return (list);
}

/********************************************************************\
 * gnc_guile_call1_to_string                                        *
 *   returns the malloc'ed string returned by the guile function    *
 *   or NULL if it can't be retrieved                               *
 *                                                                  *
 * Args: func - the guile function to call                          *
 *       arg  - the single function argument                        *
 * Returns: g_malloc'ed char * or NULL                              *
\********************************************************************/
char *
gnc_guile_call1_to_string(SCM func, SCM arg)
{
    SCM value;

    if (scm_is_procedure(func))
    {
        value = scm_call_1(func, arg);

        if (scm_is_string(value))
        {
            return gnc_scm_to_locale_string(value);
        }
        else
        {
            PERR("bad value\n");
        }
    }
    else
    {
        PERR("not a procedure\n");
    }

    return NULL;
}

/*! \todo Finish function documentation!!!
 *  \brief
 *  \par Function Description
 *
 */
SCM g_rc_paper_sizes(SCM scm_papername, SCM scm_width, SCM scm_height)
#define FUNC_NAME "paper-sizes"
{
  int width;
  int height;
  char *papername;
  SCM ret;

  SCM_ASSERT (scm_is_string (scm_papername), scm_papername,
              SCM_ARG1, FUNC_NAME);
  SCM_ASSERT (SCM_NIMP (scm_width) && SCM_REALP (scm_width), scm_width,
              SCM_ARG2, FUNC_NAME);
  SCM_ASSERT (SCM_NIMP (scm_height) && SCM_REALP (scm_height), scm_height,
              SCM_ARG3, FUNC_NAME);

  papername = SCM_STRING_CHARS (scm_papername);
  width  = (int) (SCM_NUM2DOUBLE (0, scm_width)  * MILS_PER_INCH);
  height = (int) (SCM_NUM2DOUBLE (0, scm_height) * MILS_PER_INCH);

  if (!s_papersizes_uniq(papername)) {
    ret = SCM_BOOL_F;
  } else {
    s_papersizes_add_entry(papername, width, height);
    ret = SCM_BOOL_T;
  }

  return ret;
}

/*! \brief read the configuration string list for the component dialog
 *  \par Function Description
 *  This function reads the string list from the component-dialog-attributes
 *  configuration parameter and converts the list into a GList.
 *  The GList is stored in the global default_component_select_attrlist variable.
 */
SCM g_rc_component_dialog_attributes(SCM stringlist)
{
  int length, i;
  GList *list=NULL;
  gchar *attr;

  SCM_ASSERT(scm_list_p(stringlist), stringlist, SCM_ARG1, "scm_is_list failed");
  length = scm_ilength(stringlist);

  /* If the command is called multiple times, remove the old list before
     recreating it */
  g_list_foreach(default_component_select_attrlist, (GFunc)g_free, NULL);
  g_list_free(default_component_select_attrlist);

  /* convert the scm list into a GList */
  for (i=0; i < length; i++) {
    SCM_ASSERT(scm_is_string(scm_list_ref(stringlist, scm_from_int(i))), 
	       scm_list_ref(stringlist, scm_from_int(i)), SCM_ARG1, 
	       "list element is not a string");
    attr = g_strdup(SCM_STRING_CHARS(scm_list_ref(stringlist, scm_from_int(i))));
    list = g_list_prepend(list, attr);
  }

  default_component_select_attrlist = g_list_reverse(list);

  return SCM_BOOL_T;
}

SCM
yacl_scm_b64url_decode (SCM scmb64)
{
  if (!scm_is_string (scmb64))
    scm_throw (scm_from_locale_symbol ("BADSTR"), SCM_BOOL_T);

  size_t scmb64len, outlen;
  char * b64url = scm_to_utf8_stringn (scmb64, &scmb64len);

  if (NULL == b64url)
    scm_throw (scm_from_locale_symbol ("BADDECODE"), SCM_BOOL_T);

  uint8_t *decode = yacl_b64url_decode (b64url, &outlen);

  free (b64url);

  if (NULL == decode)
      scm_throw (scm_from_locale_symbol ("BADDECODED"), SCM_BOOL_T);

  SCM b64 = scm_c_make_bytevector (outlen);
  memcpy (SCM_BYTEVECTOR_CONTENTS (b64), decode, outlen);

  free (decode);

  return b64;


}

/* this function will only return a unique list of packages */
SCM g_get_packages(SCM level)
{
    SCM list = SCM_EOL;
    GHashTable *ht;

    NETLIST *nl_current = NULL;

    SCM_ASSERT(scm_is_string (level), level, SCM_ARG1, "gnetlist:get-pins");

    /* build a hash table */
    ht = g_hash_table_new (g_str_hash, g_str_equal);
    for (nl_current = netlist_head; nl_current != NULL;
         nl_current = nl_current->next) {
      if (nl_current->component_uref != NULL) {
        /* add component_uref in the hash table */
        /* uniqueness of component_uref is guaranteed by the hashtable */

        if (g_hash_table_lookup (ht, nl_current->component_uref) == NULL) {
          g_hash_table_insert (ht, nl_current->component_uref,
                                   nl_current->component_uref);
          list = scm_cons (scm_makfrom0str (nl_current->component_uref), list);
        }
      }
    }
    g_hash_table_destroy (ht);

    return list;
}

/*! \todo Finish function documentation!!!
 *  \brief
 *  \par Function Description
 *
 */
SCM g_funcs_image(SCM scm_filename)
{
  char *filename;

  SCM_ASSERT (scm_is_string (scm_filename), scm_filename,
              SCM_ARG1, "gschem-image");

  GSCHEM_TOPLEVEL *w_current = g_current_window ();

  if (output_filename) {
    x_image_lowlevel (w_current, output_filename,
                      w_current->image_width,
                      w_current->image_height,
		      g_strdup("png"));
  } else  {
    filename = scm_to_utf8_string (scm_filename);
    x_image_lowlevel (w_current, filename,
                      w_current->image_width,
                      w_current->image_height,
		      g_strdup("png"));
    free(filename);
  }
  
  return SCM_BOOL_T;
}

SCM g_rc_gschlas_version(SCM scm_version)
{
    char *version;
    SCM ret = SCM_BOOL_T;

    SCM_ASSERT (scm_is_string (scm_version), scm_version,
		SCM_ARG1, "gschlas-version");

    version = scm_to_utf8_string (scm_version);
    if (g_strcasecmp (version, PACKAGE_DATE_VERSION) != 0) {
      fprintf(stderr,
              "You are running gEDA/gaf version [%s%s.%s],\n",
              PREPEND_VERSION_STRING, PACKAGE_DOTTED_VERSION,
              PACKAGE_DATE_VERSION);
      fprintf(stderr,
              "but you have a version [%s] gschlasrc file:\n[%s]\n",
              version, rc_filename);
      fprintf(stderr,
              "Please be sure that you have the latest rc file.\n");
      ret = SCM_BOOL_F;
    }

    free (version);
    return ret;
}

static SCM
decode_scm_col_list (GttGhtml *ghtml, SCM col_list)
{
	SCM col_name;
	char * tok = NULL;

	/* reset the parser */
	ghtml->ninvl_cols = 0;
	ghtml->ntask_cols = 0;
		
	while (!scm_is_null (col_list))
	{
		col_name = SCM_CAR (col_list);

		/* either a 'symbol or a "quoted string" */
		if (!scm_is_symbol(col_name) && !scm_is_string (col_name))
		{
			col_list = SCM_CDR (col_list);
			continue;
		}
		tok = scm_to_locale_string (col_name);
		decode_column (ghtml, tok);

		free (tok);
		col_list = SCM_CDR (col_list);
	}

	return SCM_UNSPECIFIED;
}

/*! \brief Exports the keymap in scheme to a GLib GArray.
 *  \par Function Description
 *  This function converts the list of key sequence/action pairs
 *  returned by the scheme function \c dump-current-keymap into an
 *  array of C structures.
 *
 *  The returned value must be freed by caller.
 *
 *  \return A GArray with keymap data.
  */
GArray*
g_keys_dump_keymap (void)
{
  SCM dump_proc = scm_c_lookup ("dump-current-keymap");
  SCM scm_ret;
  GArray *ret = NULL;
  struct keyseq_action_t {
    gchar *keyseq, *action;
  };

  dump_proc = scm_variable_ref (dump_proc);
  g_return_val_if_fail (SCM_NFALSEP (scm_procedure_p (dump_proc)), NULL);

  scm_ret = scm_call_0 (dump_proc);
  g_return_val_if_fail (SCM_CONSP (scm_ret), NULL);

  ret = g_array_sized_new (FALSE,
                           FALSE,
                           sizeof (struct keyseq_action_t),
                           (guint)scm_ilength (scm_ret));
  for (; scm_ret != SCM_EOL; scm_ret = SCM_CDR (scm_ret)) {
    SCM scm_keymap_entry = SCM_CAR (scm_ret);
    struct keyseq_action_t keymap_entry;

    g_return_val_if_fail (SCM_CONSP (scm_keymap_entry) &&
                          scm_is_symbol (SCM_CAR (scm_keymap_entry)) &&
                          scm_is_string (SCM_CDR (scm_keymap_entry)), ret);
    keymap_entry.action = g_strdup (SCM_SYMBOL_CHARS (SCM_CAR (scm_keymap_entry)));
    keymap_entry.keyseq = g_strdup (SCM_STRING_CHARS (SCM_CDR (scm_keymap_entry)));
    ret = g_array_append_val (ret, keymap_entry);
  }

  return ret;
}

static Expr* eqv(Expr* args) {
	assert(args);

	if(scm_list_len(args) != 2) return scm_mk_error("eqv? expects 2 args");
	
	Expr* fst = scm_car(args);
	Expr* snd = scm_cadr(args);

	if(fst == snd) return TRUE;
	if(scm_is_pair(fst) || scm_is_pair(snd)) return FALSE;
	if(scm_is_closure(fst) || scm_is_closure(snd)) return FALSE;
	if(scm_is_num(fst) && scm_is_num(snd)) return num_eq(args);
	if(scm_is_string(fst) && scm_is_string(snd) && strcmp(scm_sval(fst), scm_sval(snd)) == 0) return TRUE;

	return FALSE;
}