/*
 *
 * t k - u t i l . c 		- Some Tk utilities 
 *
 *
 * Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
 * 
 *
 * Permission to use, copy, and/or distribute this software and its
 * documentation for any purpose and without fee is hereby granted, provided
 * that both the above copyright notice and this permission notice appear in
 * all copies and derived works.  Fees for distribution or use of this
 * software or derived works may only be charged with express written
 * permission of the copyright holder.  
 * This software is provided ``as is'' without express or implied warranty.
 *
 * This software is a derivative work of other copyrighted softwares; the
 * copyright notices of these softwares are placed in the file COPYRIGHTS
 *
 *            Author: Erick Gallesio [eg@unice.fr]
 *    Creation date: 19-Feb-1993 22:15
 * Last file update:  2-Feb-1995 22:40
 *
 */

#ifdef USE_TK
#include "stk.h"
#include "tk-glue.h"

PRIMITIVE STk_string2widget(SCM str)
{
  SCM tmp, w;
  char *s;

  if (NSTRINGP(str)) Err("string->widget: bad string", str);

  s = CHARS(str);
  if (strcmp(s, ".") == 0) s = ROOT_WINDOW;

  tmp = Intern(s);
  if (STk_symbol_boundp(tmp, STk_globenv) == Truth && TKCOMMP(w=STk_eval(tmp, NIL)))
    return w;
  return Ntruth;
}

PRIMITIVE STk_widget2string(SCM widget)
{
  char *tmp;

  if (NTKCOMMP(widget)) Err("widget->string: bad widget", widget);
  tmp = (widget == STk_root_window) ? ROOT_WINDOW
    				: widget->storage_as.tk.data->Id;
  return STk_makestring(tmp);
}

PRIMITIVE STk_tk_commandp(SCM obj)
{
  return TKCOMMP(obj) ? Truth : Ntruth;
}

PRIMITIVE STk_widget_name(SCM widget)
{
  char *tmp;
  
  if (NTKCOMMP(widget)) Err("widget-name: bad widget", widget);
  tmp = (widget == STk_root_window) ? ROOT_WINDOW
    				    : widget->storage_as.tk.data->Id;
  return Intern(tmp);
}

PRIMITIVE STk_get_widget_data(SCM widget)
{
  if (NTKCOMMP(widget)) Err("get-widget-data: bad widget", widget);
  return widget->storage_as.tk.l_data;
}

PRIMITIVE STk_set_widget_data(SCM widget, SCM value)
{
  if (NTKCOMMP(widget)) Err("set-widget-data!: bad widget", widget);
  widget->storage_as.tk.l_data = value;
  return UNDEFINED;
}

PRIMITIVE STk_widget_environment(SCM widget)
{
  if (NTKCOMMP(widget)) Err("widget-environment: bad widget", widget);
  return widget->storage_as.tk.data->environment;
}


/*
 * STk_Stringify permits to transform the string "s" in a valid STk string.
 * Original string is deallocated if free_original is 1 
 */

char *STk_Stringify(char *s, int free_original)
{
  char *res, *d;
  
  if (s == NULL) s = "";
  res = d = must_malloc(2 * strlen(s) + 3); /* worst overestimation */
  
  for ( *d++ = '"'; *s; s++, d++) {
    if (*s == '"' || *s == '\\') *d++ = '\\';
    *d = *s;
  }
  *d++ = '"';
  *d   = '\0';
  
  if (free_original) free(s);
  return res;
}
#endif /* USE_TK */