* @file tcl_ref.c Purple Tcl typed references API * Copyright (C) 2006 Ethan Blanton <eblanton@cs.purdue.edu> * 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., 51 Franklin Street, Fifth Floor, Boston, MA 02111-1301 USA /* Instead of all that internal representation mumbo jumbo, use these * macros to access the internal representation of a PurpleTclRef */ #define OBJ_REF_TYPE(obj) (obj->internalRep.twoPtrValue.ptr1) #define OBJ_REF_VALUE(obj) (obj->internalRep.twoPtrValue.ptr2) static Tcl_FreeInternalRepProc purple_tcl_ref_free; static Tcl_DupInternalRepProc purple_tcl_ref_dup; static Tcl_UpdateStringProc purple_tcl_ref_update; static Tcl_SetFromAnyProc purple_tcl_ref_set; static Tcl_ObjType purple_tcl_ref = { void purple_tcl_ref_init() Tcl_RegisterObjType(&purple_tcl_ref); void *purple_tcl_ref_get(Tcl_Interp *interp, Tcl_Obj *obj, PurpleStringref *type) if (obj->typePtr != &purple_tcl_ref) { if (Tcl_ConvertToType(interp, obj, &purple_tcl_ref) != TCL_OK) if (strcmp(purple_stringref_value(OBJ_REF_TYPE(obj)), purple_stringref_value(type))) { Tcl_Obj *error = Tcl_NewStringObj("Bad Purple reference type: expected ", -1); Tcl_AppendToObj(error, purple_stringref_value(type), -1); Tcl_AppendToObj(error, " but got ", -1); Tcl_AppendToObj(error, purple_stringref_value(OBJ_REF_TYPE(obj)), -1); Tcl_SetObjResult(interp, error); return OBJ_REF_VALUE(obj); Tcl_Obj *purple_tcl_ref_new(PurpleStringref *type, void *value) Tcl_Obj *obj = Tcl_NewObj(); obj->typePtr = &purple_tcl_ref; OBJ_REF_TYPE(obj) = purple_stringref_ref(type); OBJ_REF_VALUE(obj) = value; Tcl_InvalidateStringRep(obj); static void purple_tcl_ref_free(Tcl_Obj *obj) purple_stringref_unref(OBJ_REF_TYPE(obj)); static void purple_tcl_ref_dup(Tcl_Obj *obj1, Tcl_Obj *obj2) OBJ_REF_TYPE(obj2) = purple_stringref_ref(OBJ_REF_TYPE(obj1)); OBJ_REF_VALUE(obj2) = OBJ_REF_VALUE(obj1); static void purple_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("purple-%s:%p", purple_stringref_value(OBJ_REF_TYPE(obj)), obj->length = strlen(bytes); obj->bytes = ckalloc(len); g_strlcpy(obj->bytes, bytes, len); /* 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 purple_tcl_ref_set(Tcl_Interp *interp, Tcl_Obj *obj) char *bytes = Tcl_GetStringFromObj(obj, NULL); static const char prefix[] = "purple-"; static const int prefixlen = sizeof(prefix) - 1; if (strlen(bytes) < prefixlen || strncmp(bytes, prefix, prefixlen) || (ptr = strchr(bytes, ':')) == NULL || (ptr - bytes) == prefixlen) type = purple_stringref_new(bytes + prefixlen); if (sscanf(ptr, "%p", &value) == 0) { purple_stringref_unref(type); /* 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 = &purple_tcl_ref; OBJ_REF_TYPE(obj) = type; OBJ_REF_VALUE(obj) = value; Tcl_NewStringObj("invalid PurpleTclRef representation", -1));