source: trunk/base/src/tclobjc1.0/tclobjc_types.m @ 49208

Last change on this file since 49208 was 49208, checked in by toby@…, 8 years ago

cheap hack to make sure objects don't get released prematurely

File size: 5.5 KB
Line 
1/*
2 * TclObjTypes.c
3 *
4 * Copyright (c) 2004 Landon J. Fuller <landonf@macports.org>
5 * All rights reserved.
6 *
7 * Redistribution and use in source and binary forms, with or without
8 * modification, are permitted provided that the following conditions
9 * are met:
10 * 1. Redistributions of source code must retain the above copyright
11 *    notice, this list of conditions and the following disclaimer.
12 * 2. Redistributions in binary form must reproduce the above copyright
13 *    notice, this list of conditions and the following disclaimer in the
14 *    documentation and/or other materials provided with the distribution.
15 * 3. Neither the name of the copyright owner nor the names of contributors
16 *    may be used to endorse or promote products derived from this software
17 *    without specific prior written permission.
18 *
19 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
20 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
21 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
22 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
23 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
24 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
25 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
26 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
27 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
28 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
29 * POSSIBILITY OF SUCH DAMAGE.
30 */
31
32#ifdef HAVE_CONFIG_H
33#include <config.h>
34#endif
35
36/* Required by glibc for asprintf() */
37#define _GNU_SOURCE
38#include <stdio.h>
39
40#include <string.h>
41#include <stdlib.h>
42
43#include <Foundation/Foundation.h>
44#include <objc/objc.h>
45
46#include <tcl.h>
47
48/*
49 * Tcl Objc Id Object
50 */
51
52/** All (evil) Objective-C string pointer representations start with a common prefix. */
53static const char tclobjc_name_prefix[] = "objc.id-";
54
55/** Invalid Objective-C pointer string representation. */
56static const char tclobjc_invalid_string_error[] = "Invalid Objective-C object: ";
57
58/* Standard prototypes */
59static void free_objc_internalrep(Tcl_Obj *objPtr);
60static void dup_objc_internalrep(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr);
61static void update_objc_string(Tcl_Obj *objPtr);
62static int set_objc_fromstring(Tcl_Interp *interp, Tcl_Obj *objPtr);
63
64static Tcl_ObjType tclObjcIdType = {
65        /* Name */
66        "tclObjcId",
67        /* Tcl_FreeInternalRepProc */
68        &free_objc_internalrep,
69        /* Tcl_DupInternalRepProc */
70        &dup_objc_internalrep,
71        /* Tcl_UpdateStringProc */
72        &update_objc_string,
73        /* Tcp_SetFromAnyProc */
74        &set_objc_fromstring
75};
76
77/*
78 * Private Functions
79 */
80
81/**
82 * Release the internal objective-c instance.
83 */
84static void free_objc_internalrep(Tcl_Obj *objPtr UNUSED) {
85    /* TODO cleanup */
86}
87
88/**
89 * Duplicate the internal objective-c pointer.
90 */
91static void dup_objc_internalrep(Tcl_Obj *srcPtr, Tcl_Obj *dupPtr) {
92        dupPtr->internalRep.otherValuePtr = srcPtr->internalRep.otherValuePtr;
93}
94
95
96/**
97 * Update the string value based on the internal pointer address.
98 */
99static void update_objc_string (Tcl_Obj *objPtr) {
100        char *string;
101        int length;
102
103        if ((length = asprintf(&string, "objc.id-%p", objPtr->internalRep.otherValuePtr)) <= 0) {
104                /* ack! malloc failed! */
105                abort();
106        }
107
108        /* Terminating NULL */
109        length++;
110
111        /* objPtr->bytes must be allocated with Tcl_Alloc */
112        objPtr->bytes = Tcl_Alloc(length);
113        strcpy(objPtr->bytes, string);
114        free(string);
115}
116
117/**
118 * Evil piece of code that set's the internal ObjC pointer value by
119 * converting the provided string value.
120 */
121static int set_objc_fromstring (Tcl_Interp *interp, Tcl_Obj *objPtr) {
122        Tcl_ObjType *oldTypePtr = objPtr->typePtr;
123        Tcl_Obj *tcl_result;
124        char *string, *p;
125        id objcId;
126        int length;
127
128        string = Tcl_GetStringFromObj(objPtr, &length);
129
130        /* Verify that this is a valid string */
131        if ((length < (int)sizeof(tclobjc_name_prefix)) ||
132                        (strncmp(string, tclobjc_name_prefix,
133                                 sizeof(tclobjc_name_prefix)) != 0)) {
134                        goto invalid_obj;
135        }
136
137        p = string + sizeof(tclobjc_name_prefix);
138
139        if (sscanf(p, "%p", (void **)&objcId) != 1)
140                goto invalid_obj;
141       
142        /* Free the old internal representation before setting new one */
143        if (oldTypePtr != NULL && oldTypePtr->freeIntRepProc != NULL) {
144                oldTypePtr->freeIntRepProc(objPtr);
145        }
146
147        objPtr->internalRep.otherValuePtr = objcId;
148        objPtr->typePtr = &tclObjcIdType;
149
150        return (TCL_OK);
151
152
153        /* Cleanup Handler */
154invalid_obj:
155        if (interp) {
156                tcl_result = Tcl_NewStringObj(tclobjc_invalid_string_error, sizeof(tclobjc_invalid_string_error));
157                Tcl_AppendObjToObj(tcl_result, objPtr);
158                Tcl_SetObjResult(interp, tcl_result);
159        }
160        return (TCL_ERROR);
161}
162
163/*
164 * Public Functions
165 */
166
167/**
168 * Create a new Tcl Object wrapper for a given Objective-C object.
169 */
170Tcl_Obj *TclObjC_NewIdObj(id objcId) {
171        Tcl_Obj *objPtr;
172
173        objPtr = Tcl_NewObj();
174
175        objPtr->bytes = NULL;
176
177        objPtr->internalRep.otherValuePtr = [objcId retain]; /* this is a leak */
178        objPtr->typePtr = &tclObjcIdType;
179        return (objPtr);
180}
181
182/**
183 * Returns a pointer to the wrapped Objective-C object.
184 */
185int TclObjC_GetIdFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, id *objcId)
186{
187        int result;
188
189        if (objPtr->typePtr == &tclObjcIdType) {
190                *objcId = objPtr->internalRep.otherValuePtr;
191                return (TCL_OK);
192        }
193
194        result = set_objc_fromstring(interp, objPtr);
195
196        if (result == TCL_OK)
197                *objcId = objPtr->internalRep.otherValuePtr;
198
199        return (result);
200}
201
202/**
203 * Register the Tcl Objective-C Object type(s).
204 */
205void TclObjC_RegisterTclObjTypes(void) {
206        Tcl_RegisterObjType(&tclObjcIdType);
207}
Note: See TracBrowser for help on using the repository browser.