# HG changeset patch # User Ethan Blanton # Date 1149963646 0 # Node ID 65ac70a8a66141d59efd60fa5af7491e921605aa # Parent e0e8959d92a0e5968a56f6e6e8c3d1e4c01b19c8 [gaim-migrate @ 16243] Forgot to add tcl_ref.c That's OK, because subversion is really, really bad and didn't want to let me do it anyway. Can we please get a real revision control system, as opposed to one which was clearly designed by and for monkeys who liked CVS but couldn't stand all the working-ness? committer: Tailor Script diff -r e0e8959d92a0 -r 65ac70a8a661 plugins/tcl/tcl_ref.c --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/plugins/tcl/tcl_ref.c Sat Jun 10 18:20:46 2006 +0000 @@ -0,0 +1,152 @@ +/** + * @file tcl_ref.c Gaim Tcl typed references API + * + * gaim + * + * Copyright (C) 2006 Ethan Blanton + * + * 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 of the License, 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 + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + */ + +#include +#include + +#include "tcl_gaim.h" +#include "stringref.h" + +/* Instead of all that internal representation mumbo jumbo, use these + * macros to access the internal representation of a GaimTclRef */ +#define OBJ_REF_TYPE(obj) (obj->internalRep.twoPtrValue.ptr1) +#define OBJ_REF_VALUE(obj) (obj->internalRep.twoPtrValue.ptr2) + +static Tcl_FreeInternalRepProc gaim_tcl_ref_free; +static Tcl_DupInternalRepProc gaim_tcl_ref_dup; +static Tcl_UpdateStringProc gaim_tcl_ref_update; +static Tcl_SetFromAnyProc gaim_tcl_ref_set; + +static Tcl_ObjType gaim_tcl_ref = { + "GaimTclRef", + gaim_tcl_ref_free, + gaim_tcl_ref_dup, + gaim_tcl_ref_update, + gaim_tcl_ref_set +}; + +void gaim_tcl_ref_init() +{ + Tcl_RegisterObjType(&gaim_tcl_ref); +} + +void *gaim_tcl_ref_get(Tcl_Interp *interp, Tcl_Obj *obj, GaimStringref *type) +{ + if (obj->typePtr != &gaim_tcl_ref) { + if (Tcl_ConvertToType(interp, obj, &gaim_tcl_ref) != TCL_OK) + return NULL; + } + if (strcmp(gaim_stringref_value(OBJ_REF_TYPE(obj)), + gaim_stringref_value(type))) { + if (interp) { + Tcl_Obj *error = Tcl_NewStringObj("Bad Gaim reference type: expected ", -1); + Tcl_AppendToObj(error, gaim_stringref_value(type), -1); + Tcl_AppendToObj(error, "but got ", -1); + Tcl_AppendToObj(error, gaim_stringref_value(OBJ_REF_TYPE(obj)), -1); + Tcl_SetObjResult(interp, error); + } + return NULL; + } + return OBJ_REF_VALUE(obj); +} + +Tcl_Obj *gaim_tcl_ref_new(GaimStringref *type, void *value) +{ + Tcl_Obj *obj = Tcl_NewObj(); + obj->typePtr = &gaim_tcl_ref; + OBJ_REF_TYPE(obj) = gaim_stringref_ref(type); + OBJ_REF_VALUE(obj) = value; + Tcl_InvalidateStringRep(obj); + return obj; +} + +static void gaim_tcl_ref_free(Tcl_Obj *obj) +{ + gaim_stringref_unref(OBJ_REF_TYPE(obj)); +} + +static void gaim_tcl_ref_dup(Tcl_Obj *obj1, Tcl_Obj *obj2) +{ + OBJ_REF_TYPE(obj2) = gaim_stringref_ref(OBJ_REF_TYPE(obj1)); + OBJ_REF_VALUE(obj2) = OBJ_REF_VALUE(obj1); +} + +static void gaim_tcl_ref_update(Tcl_Obj *obj) +{ + /* This is ugly on memory, but we pretty much have to either + * do this or guesstimate lengths or introduce a varargs + * function in here ... ugh. */ + char *bytes = g_strdup_printf("gaim-%s:%p", + gaim_stringref_value(OBJ_REF_TYPE(obj)), + OBJ_REF_VALUE(obj)); + + obj->length = strlen(bytes); + obj->bytes = ckalloc(obj->length + 1); + strcpy(obj->bytes, bytes); + g_free(bytes); +} + +/* This isn't as memory-efficient as setting could be, because we + * essentially have to synthesize the Stringref here, where we would + * really rather dup it. Oh, well. */ +static int gaim_tcl_ref_set(Tcl_Interp *interp, Tcl_Obj *obj) +{ + char *bytes = Tcl_GetStringFromObj(obj, NULL); + char *ptr; + GaimStringref *type; + void *value; + + if (strlen(bytes) < 7 + || strncmp(bytes, "gaim-", 5) + || (ptr = strchr(bytes, ':')) == NULL + || (ptr - bytes) == 5) + goto badobject; + + /* Bad Ethan */ + *ptr = '\0'; + type = gaim_stringref_new(bytes + 5); + *ptr = ':'; + ptr++; + + if (sscanf(ptr, "%p", &value) == 0) { + gaim_stringref_unref(type); + goto badobject; + } + + /* At this point we know we have a good object; free the old and + * install our internal representation. */ + if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) + obj->typePtr->freeIntRepProc(obj); + + obj->typePtr = &gaim_tcl_ref; + OBJ_REF_TYPE(obj) = type; + OBJ_REF_VALUE(obj) = value; + + return TCL_OK; + +badobject: + if (interp) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("invalid GaimTclRef representation", -1)); + } + return TCL_ERROR; +}