| |
1 /** |
| |
2 * @file tcl_ref.c Gaim Tcl typed references API |
| |
3 * |
| |
4 * gaim |
| |
5 * |
| |
6 * Copyright (C) 2006 Ethan Blanton <eblanton@cs.purdue.edu> |
| |
7 * |
| |
8 * This program is free software; you can redistribute it and/or modify |
| |
9 * it under the terms of the GNU General Public License as published by |
| |
10 * the Free Software Foundation; either version 2 of the License, or |
| |
11 * (at your option) any later version. |
| |
12 * |
| |
13 * This program is distributed in the hope that it will be useful, |
| |
14 * but WITHOUT ANY WARRANTY; without even the implied warranty of |
| |
15 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| |
16 * GNU General Public License for more details. |
| |
17 * |
| |
18 * You should have received a copy of the GNU General Public License |
| |
19 * along with this program; if not, write to the Free Software |
| |
20 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
| |
21 */ |
| |
22 |
| |
23 #include <tcl.h> |
| |
24 #include <glib.h> |
| |
25 |
| |
26 #include "tcl_gaim.h" |
| |
27 #include "stringref.h" |
| |
28 |
| |
29 /* Instead of all that internal representation mumbo jumbo, use these |
| |
30 * macros to access the internal representation of a GaimTclRef */ |
| |
31 #define OBJ_REF_TYPE(obj) (obj->internalRep.twoPtrValue.ptr1) |
| |
32 #define OBJ_REF_VALUE(obj) (obj->internalRep.twoPtrValue.ptr2) |
| |
33 |
| |
34 static Tcl_FreeInternalRepProc gaim_tcl_ref_free; |
| |
35 static Tcl_DupInternalRepProc gaim_tcl_ref_dup; |
| |
36 static Tcl_UpdateStringProc gaim_tcl_ref_update; |
| |
37 static Tcl_SetFromAnyProc gaim_tcl_ref_set; |
| |
38 |
| |
39 static Tcl_ObjType gaim_tcl_ref = { |
| |
40 "GaimTclRef", |
| |
41 gaim_tcl_ref_free, |
| |
42 gaim_tcl_ref_dup, |
| |
43 gaim_tcl_ref_update, |
| |
44 gaim_tcl_ref_set |
| |
45 }; |
| |
46 |
| |
47 void gaim_tcl_ref_init() |
| |
48 { |
| |
49 Tcl_RegisterObjType(&gaim_tcl_ref); |
| |
50 } |
| |
51 |
| |
52 void *gaim_tcl_ref_get(Tcl_Interp *interp, Tcl_Obj *obj, GaimStringref *type) |
| |
53 { |
| |
54 if (obj->typePtr != &gaim_tcl_ref) { |
| |
55 if (Tcl_ConvertToType(interp, obj, &gaim_tcl_ref) != TCL_OK) |
| |
56 return NULL; |
| |
57 } |
| |
58 if (strcmp(gaim_stringref_value(OBJ_REF_TYPE(obj)), |
| |
59 gaim_stringref_value(type))) { |
| |
60 if (interp) { |
| |
61 Tcl_Obj *error = Tcl_NewStringObj("Bad Gaim reference type: expected ", -1); |
| |
62 Tcl_AppendToObj(error, gaim_stringref_value(type), -1); |
| |
63 Tcl_AppendToObj(error, " but got ", -1); |
| |
64 Tcl_AppendToObj(error, gaim_stringref_value(OBJ_REF_TYPE(obj)), -1); |
| |
65 Tcl_SetObjResult(interp, error); |
| |
66 } |
| |
67 return NULL; |
| |
68 } |
| |
69 return OBJ_REF_VALUE(obj); |
| |
70 } |
| |
71 |
| |
72 Tcl_Obj *gaim_tcl_ref_new(GaimStringref *type, void *value) |
| |
73 { |
| |
74 Tcl_Obj *obj = Tcl_NewObj(); |
| |
75 obj->typePtr = &gaim_tcl_ref; |
| |
76 OBJ_REF_TYPE(obj) = gaim_stringref_ref(type); |
| |
77 OBJ_REF_VALUE(obj) = value; |
| |
78 Tcl_InvalidateStringRep(obj); |
| |
79 return obj; |
| |
80 } |
| |
81 |
| |
82 static void gaim_tcl_ref_free(Tcl_Obj *obj) |
| |
83 { |
| |
84 gaim_stringref_unref(OBJ_REF_TYPE(obj)); |
| |
85 } |
| |
86 |
| |
87 static void gaim_tcl_ref_dup(Tcl_Obj *obj1, Tcl_Obj *obj2) |
| |
88 { |
| |
89 OBJ_REF_TYPE(obj2) = gaim_stringref_ref(OBJ_REF_TYPE(obj1)); |
| |
90 OBJ_REF_VALUE(obj2) = OBJ_REF_VALUE(obj1); |
| |
91 } |
| |
92 |
| |
93 static void gaim_tcl_ref_update(Tcl_Obj *obj) |
| |
94 { |
| |
95 /* This is ugly on memory, but we pretty much have to either |
| |
96 * do this or guesstimate lengths or introduce a varargs |
| |
97 * function in here ... ugh. */ |
| |
98 char *bytes = g_strdup_printf("gaim-%s:%p", |
| |
99 gaim_stringref_value(OBJ_REF_TYPE(obj)), |
| |
100 OBJ_REF_VALUE(obj)); |
| |
101 |
| |
102 obj->length = strlen(bytes); |
| |
103 obj->bytes = ckalloc(obj->length + 1); |
| |
104 strcpy(obj->bytes, bytes); |
| |
105 g_free(bytes); |
| |
106 } |
| |
107 |
| |
108 /* This isn't as memory-efficient as setting could be, because we |
| |
109 * essentially have to synthesize the Stringref here, where we would |
| |
110 * really rather dup it. Oh, well. */ |
| |
111 static int gaim_tcl_ref_set(Tcl_Interp *interp, Tcl_Obj *obj) |
| |
112 { |
| |
113 char *bytes = Tcl_GetStringFromObj(obj, NULL); |
| |
114 char *ptr; |
| |
115 GaimStringref *type; |
| |
116 void *value; |
| |
117 |
| |
118 if (strlen(bytes) < 7 |
| |
119 || strncmp(bytes, "gaim-", 5) |
| |
120 || (ptr = strchr(bytes, ':')) == NULL |
| |
121 || (ptr - bytes) == 5) |
| |
122 goto badobject; |
| |
123 |
| |
124 /* Bad Ethan */ |
| |
125 *ptr = '\0'; |
| |
126 type = gaim_stringref_new(bytes + 5); |
| |
127 *ptr = ':'; |
| |
128 ptr++; |
| |
129 |
| |
130 if (sscanf(ptr, "%p", &value) == 0) { |
| |
131 gaim_stringref_unref(type); |
| |
132 goto badobject; |
| |
133 } |
| |
134 |
| |
135 /* At this point we know we have a good object; free the old and |
| |
136 * install our internal representation. */ |
| |
137 if (obj->typePtr != NULL && obj->typePtr->freeIntRepProc != NULL) |
| |
138 obj->typePtr->freeIntRepProc(obj); |
| |
139 |
| |
140 obj->typePtr = &gaim_tcl_ref; |
| |
141 OBJ_REF_TYPE(obj) = type; |
| |
142 OBJ_REF_VALUE(obj) = value; |
| |
143 |
| |
144 return TCL_OK; |
| |
145 |
| |
146 badobject: |
| |
147 if (interp) { |
| |
148 Tcl_SetObjResult(interp, |
| |
149 Tcl_NewStringObj("invalid GaimTclRef representation", -1)); |
| |
150 } |
| |
151 return TCL_ERROR; |
| |
152 } |