smob-value.c 6.84 KB
Newer Older
1 2 3
/* -*- mode: c; c-basic-offset: 8 -*- */

/*
4
 *
Ariel Rios's avatar
Ariel Rios committed
5 6
 *     Author: Ariel Rios <ariel@linuxppc.org>
 *	   Copyright Ariel Rios 2000, 2001
7 8 9 10 11 12 13 14 15 16 17 18
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
19 20 21
 * along with this software; see the file COPYING.  If not, write to the
 * Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
 * MA  02110-1301  USA.
22 23
 */

24
#include <gnumeric-config.h>
25
#include <glib/gi18n.h>
26
#include <gnumeric.h>
27
#include <libguile.h>
28
#include <glib.h>
29
#include <gtk/gtk.h>
30
#include <stdlib.h>
31

32
#include "smob-value.h"
33
#include "value.h"
34

Ariel Rios's avatar
Ariel Rios committed
35
int scm_i_scm2bool (SCM obj);
36 37 38 39
static long value_tag;

typedef struct _SCM_Value
{
Jody Goldberg's avatar
Jody Goldberg committed
40
	GnmValue *v;
41 42 43
	SCM update_func;
} SCM_Value;

44
/**
Jody Goldberg's avatar
Jody Goldberg committed
45
 * The GnmValue in the smob has to be a clone of v, since the original may be
46 47 48
 * released in C-land, and there is no way to tell the Guile garbage
 * collector.
 */
49
SCM
Jody Goldberg's avatar
Jody Goldberg committed
50
make_new_smob (GnmValue *v)
51 52 53 54
{
	SCM_Value *value;

	value = (SCM_Value *) scm_must_malloc (sizeof (SCM_Value), "value");
55
	value->v = value_dup (v);
56
	value->update_func = SCM_BOOL_F;
57

58 59 60
	SCM_RETURN_NEWSMOB (value_tag, value);
}

61 62 63 64 65
/**
 * We also have to clone the value in the smob before returning it to
 * C-land, since the returned value may be released. There may be leaks, but
 * freing memory twice is worse.
 */
Jody Goldberg's avatar
Jody Goldberg committed
66
GnmValue *
67 68 69 70
get_value_from_smob (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);

71
	return value_dup (v->v);
72
}
73

Ariel Rios's avatar
Ariel Rios committed
74 75
int
scm_i_scm2bool (SCM obj)
76
{
Ariel Rios's avatar
Ariel Rios committed
77 78 79
  return (SCM_FALSEP (obj)) ? 0 : 1;
}

80 81
static SCM
make_value (SCM scm)
82
{
Jody Goldberg's avatar
Jody Goldberg committed
83
	GnmValue *v;
84
	SCM_Value *value;
85 86 87 88 89

	/*
	  FIXME:
	  Add support for array, null values, etc
	*/
90

91 92
	if (SCM_NIMP (scm) && SCM_STRINGP (scm))
		v = value_new_string (SCM_CHARS (scm));
93

94
	else if ((SCM_NFALSEP (scm_number_p(scm))))
95
		v = value_new_float ((gnm_float) scm_num2dbl(scm, 0));
96

97
	else if (SCM_BOOLP (scm))
Ariel Rios's avatar
Ariel Rios committed
98
		v = value_new_bool ((gboolean) scm_i_scm2bool (scm));
99

100 101 102
	else
		v = value_new_error (NULL,
				     _("Unable to convert value from Guile"));
Morten Welinder's avatar
Morten Welinder committed
103

104
	value = (SCM_Value *) scm_must_malloc (sizeof (SCM_Value), "value");
105 106
	value->v = v;
	value->update_func = SCM_BOOL_F;
107

108
	SCM_RETURN_NEWSMOB (value_tag, value);
109
}
110 111 112 113 114

static SCM
mark_value (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);
115

116 117 118
	return v->update_func;
}

119
static scm_sizet
120 121 122 123
free_value (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);
	scm_sizet size  = sizeof (SCM_Value);
124
	value_release (v->v);
125 126 127 128 129 130 131

	return size;
}

static int
print_value (SCM value_smob, SCM port, scm_print_state *pstate)
{
132 133 134
#if 0
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);
#endif
135

136
	scm_puts ("#<Value>", port);
137 138 139

	return 1;
}
140

141

142 143 144 145 146 147
static SCM
equalp_value (SCM value_smob_1, SCM value_smob_2)
{
	SCM_Value *v1 = (SCM_Value *) SCM_CDR (value_smob_1);
	SCM_Value *v2 = (SCM_Value *) SCM_CDR (value_smob_2);
	SCM flag;
148

149
	flag = (value_compare (v1->v, v2->v, TRUE))? SCM_BOOL_T : SCM_BOOL_F;
150 151 152

	return flag;
}
153

154 155 156
static SCM
scm_value_new_bool (SCM scm)
{
Jody Goldberg's avatar
Jody Goldberg committed
157
	GnmValue *v;
158 159
	SCM_Value *value;

Ariel Rios's avatar
Ariel Rios committed
160 161
	if (SCM_BOOLP (scm))
		v = value_new_bool ((gboolean) scm_i_scm2bool (scm));
162 163
	else
		v = value_new_error (NULL, _("Not a Guile boolean"));
164 165 166 167

	value = (SCM_Value *) scm_must_malloc (sizeof (SCM_Value), "value");
	value->v = v;
	value->update_func = SCM_BOOL_F;
168

169 170 171 172 173 174
	SCM_RETURN_NEWSMOB (value_tag, value);
}

static SCM
scm_value_new_float (SCM scm)
{
Jody Goldberg's avatar
Jody Goldberg committed
175
	GnmValue *v;
176 177 178
	SCM_Value *value;

	if ((SCM_NFALSEP (scm_number_p(scm))))
179
		v = value_new_float ((gnm_float) scm_num2dbl(scm, 0));
180 181
	else
		v = value_new_error (NULL, _("Not a Guile number"));
182 183 184 185

	value = (SCM_Value *) scm_must_malloc (sizeof (SCM_Value), "value");
	value->v = v;
	value->update_func = SCM_BOOL_F;
186

187 188 189 190 191 192
	SCM_RETURN_NEWSMOB (value_tag, value);
}

static SCM
scm_value_new_string (SCM scm)
{
Jody Goldberg's avatar
Jody Goldberg committed
193
	GnmValue *v;
194 195 196 197
	SCM_Value *value;

	if (SCM_NIMP (scm) && SCM_STRINGP (scm))
		v = value_new_string (SCM_CHARS (scm));
198 199 200
	else
		v = value_new_error (NULL, _("Not a Guile string"));

201

202 203 204
	value = (SCM_Value *) scm_must_malloc (sizeof (SCM_Value), "value");
	value->v = v;
	value->update_func = SCM_BOOL_F;
205

206 207 208
	SCM_RETURN_NEWSMOB (value_tag, value);
}

209 210 211 212
static SCM
scm_value_get_as_string (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);
213

214 215 216 217
	if (v->v->type == VALUE_STRING ||
            v->v->type == VALUE_BOOLEAN ||
            v->v->type == VALUE_INTEGER ||
            v->v->type == VALUE_FLOAT)
218 219 220 221 222 223 224 225 226
		return scm_makfrom0str (value_get_as_string (v->v));

	return SCM_EOL;
}

static SCM
scm_value_get_as_int (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);
227 228 229
	if (v->v->type == VALUE_BOOLEAN ||
            v->v->type == VALUE_INTEGER ||
            v->v->type == VALUE_FLOAT)
230
		return scm_long2num (value_get_as_int (v->v));
231

232 233 234 235 236 237 238 239
	return SCM_EOL;
}

static SCM
scm_value_get_as_float (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);

240 241 242
	if (v->v->type == VALUE_BOOLEAN ||
            v->v->type == VALUE_INTEGER ||
            v->v->type == VALUE_FLOAT)
Ariel Rios's avatar
Ariel Rios committed
243
		return scm_i_dbl2big (value_get_as_float (v->v));
244

Ariel Rios's avatar
Ariel Rios committed
245
	return SCM_EOL;
246
}
247

248 249 250 251 252 253 254 255 256
static SCM
scm_value_get_as_list (SCM value_smob)
{
	SCM_Value *v = (SCM_Value *) SCM_CDR (value_smob);

	if (v->v->type ==  VALUE_ARRAY)
		{
			int x, y, i, ii;
			SCM list, *ls = &list;
257

258 259 260 261 262 263
			x = v->v->v_array.x;
			y = v->v->v_array.y;

			for (i = 0; i < y; i++)
				for (ii = 0; i < x; i++)
					{
Ariel Rios's avatar
Ariel Rios committed
264
						/*
265
						*ls = scm_cons (gh_double2scm (value_get_as_float (v->v->v_array.vals[i][ii])), *ls);
Ariel Rios's avatar
Ariel Rios committed
266 267
						*/
						*ls = scm_cons (scm_i_dbl2big (value_get_as_float (v->v->v_array.vals[i][ii])), *ls);
268
						/* FIXME */
269 270 271 272 273 274 275 276 277 278
						ls = SCM_CDRLOC (*ls);
					}
			*ls = SCM_EOL;
			*ls = scm_reverse (*ls);
			return list;
		}

	return SCM_EOL;
}

279 280 281
void
init_value_type ()
{
282

283
	value_tag = scm_make_smob_type ((char *) "value", sizeof (SCM_Value));
284 285 286
	scm_set_smob_mark (value_tag, mark_value);
	scm_set_smob_free (value_tag, free_value);
	scm_set_smob_print (value_tag, print_value);
287
	scm_set_smob_equalp (value_tag, equalp_value);
288

289 290 291 292 293 294 295 296
	scm_c_define_gsubr ("make-value", 1, 0, 0, make_value);
	scm_c_define_gsubr ("value-new-bool", 1, 0, 0, scm_value_new_bool);
	scm_c_define_gsubr ("value-new-float", 1, 0, 0, scm_value_new_float);
	scm_c_define_gsubr ("value-new-string", 1, 0, 0, scm_value_new_string);
	scm_c_define_gsubr ("value-get-as-string", 1, 0, 0, scm_value_get_as_string);
	scm_c_define_gsubr ("value-get-as-int", 1, 0, 0, scm_value_get_as_int);
	scm_c_define_gsubr ("value-get-as-float", 1, 0, 0, scm_value_get_as_float);
	scm_c_define_gsubr ("value-get-as-list", 1, 0, 0, scm_value_get_as_list);
297 298
}

299 300