1 /*
2  *  tkimgUtils.tcl
3  */
4 
5 #include <string.h>
6 #include <stdlib.h>
7 #include "tkimg.h"
8 
9 /*
10  * The variable "tkimg_initialized" contains flags indicating which
11  * version of Tcl or Perl we are running:
12  *
13  *  IMG_PERL        perl
14  *  IMG_COMPOSITE   Photo image type proc signatures are 8.4 or higher.
15  *  IMG_NOPANIC     Photo image type proc signatures are 8.5 or higher.
16  *
17  * These flags will be determined at runtime (except the IMG_PERL
18  * flag, for now), so we can use the same dynamic library for all
19  * Tcl/Tk versions (and for Perl/Tk in the future).
20  *
21  * The existence of the CPP macro _LANG implies usage in Perl/Tk.
22  *
23  * Img 1.4: Support for Tcl 8.2 and lower is dropped.
24  */
25 
26 int tkimg_initialized = 0;
27 
TkimgInitUtilities(Tcl_Interp * interp)28 int TkimgInitUtilities(
29 	Tcl_Interp *interp
30 ) {
31 #ifdef _LANG
32 	tkimg_initialized = IMG_PERL;
33 #else
34 
35 	int major, minor, patchlevel, type;
36 	tkimg_initialized = IMG_TCL;
37 
38 	Tcl_GetVersion(&major, &minor, &patchlevel, &type);
39 
40 	if ((major > 8) || ((major == 8) && (minor > 3))) {
41 		tkimg_initialized |= IMG_COMPOSITE;
42 	}
43 	if ((major > 8) || ((major == 8) && (minor > 4))) {
44 		tkimg_initialized |= IMG_NOPANIC;
45 	}
46 
47 #endif
48 	return tkimg_initialized;
49 }
50 
51 
52 /*
53  *----------------------------------------------------------------------
54  *
55  * tkimg_GetStringFromObj --
56  *
57  *  Returns the string representation's byte array pointer and length
58  *  for an object.
59  *
60  * Results:
61  *  Returns a pointer to the string representation of objPtr.  If
62  *  lengthPtr isn't NULL, the length of the string representation is
63  *  stored at *lengthPtr. The byte array referenced by the returned
64  *  pointer must not be modified by the caller. Furthermore, the
65  *  caller must copy the bytes if they need to retain them since the
66  *  object's string rep can change as a result of other operations.
67  *      REMARK: This function reacts a little bit different than
68  *  Tcl_GetStringFromObj():
69  *  - objPtr is allowed to be NULL. In that case the NULL pointer
70  *    will be returned, and the length will be reported to be 0;
71  *  In the tkimg_ code there is never a distinction between en empty
72  *  string and a NULL pointer, while the latter is easier to check
73  *  for. That's the reason for this difference.
74  *
75  * Side effects:
76  *  May call the object's updateStringProc to update the string
77  *  representation from the internal representation.
78  *
79  *----------------------------------------------------------------------
80  */
81 
tkimg_GetStringFromObj(Tcl_Obj * objPtr,int * lengthPtr)82 const char *tkimg_GetStringFromObj(
83 	Tcl_Obj *objPtr, /* Object whose string rep byte pointer
84 			  * should be returned, or NULL */
85 	int *lengthPtr /* If non-NULL, the location where the
86 			* string rep's byte array length should be
87 			* stored. If NULL, no length is stored. */
88 ) {
89 	if (!objPtr) {
90 		if (lengthPtr) {
91 			*lengthPtr = 0;
92 		}
93 		return NULL;
94 	}
95 #ifdef _LANG
96 	{
97 		char *string = LangString((Arg) objPtr);
98 		if (lengthPtr) {
99 			*lengthPtr = string? strlen(string): 0;
100 		}
101 		return string;
102 	}
103 #else /* _LANG */
104 	return Tcl_GetStringFromObj(objPtr, lengthPtr);
105 #endif /* _LANG */
106 }
107 
108 /*
109  *----------------------------------------------------------------------
110  *
111  * tkimg_GetStringFromObj2 --
112  *
113  *  Returns the string representation's byte array pointer and length
114  *  for an object.
115  *
116  * Results:
117  *  Returns a pointer to the string representation of objPtr.  If
118  *  lengthPtr isn't NULL, the length of the string representation is
119  *  stored at *lengthPtr. The byte array referenced by the returned
120  *  pointer must not be modified by the caller. Furthermore, the
121  *  caller must copy the bytes if they need to retain them since the
122  *  object's string rep can change as a result of other operations.
123  *      REMARK: This function reacts a little bit different than
124  *  Tcl_GetStringFromObj():
125  *  - objPtr is allowed to be NULL. In that case the NULL pointer
126  *    will be returned, and the length will be reported to be 0;
127  *  In the tkimg_ code there is never a distinction between en empty
128  *  string and a NULL pointer, while the latter is easier to check
129  *  for. That's the reason for this difference.
130  *
131  * Side effects:
132  *  May call the object's updateStringProc to update the string
133  *  representation from the internal representation.
134  *
135  *----------------------------------------------------------------------
136  */
137 
tkimg_GetStringFromObj2(Tcl_Obj * objPtr,size_t * lengthPtr)138 const char *tkimg_GetStringFromObj2(
139 	Tcl_Obj *objPtr, /* Object whose string rep byte pointer
140 			  * should be returned, or NULL */
141 	size_t *lengthPtr /* If non-NULL, the location where the
142 			   * string rep's byte array length should be
143 			   * stored. If NULL, no length is stored. */
144 ) {
145 #ifndef _LANG
146     const char *result;
147 #endif
148 	if (!objPtr) {
149 		if (lengthPtr) {
150 			*lengthPtr = 0;
151 		}
152 		return NULL;
153 	}
154 #ifdef _LANG
155 	{
156 		char *string = LangString((Arg) objPtr);
157 		if (lengthPtr) {
158 			*lengthPtr = string? strlen(string): 0;
159 		}
160 		return string;
161 	}
162 #else /* _LANG */
163 	result = Tcl_GetString(objPtr);
164 	if (lengthPtr) {
165 		*lengthPtr = objPtr->length;
166 	}
167 	return result;
168 #endif /* _LANG */
169 }
170 
171 /*
172  *----------------------------------------------------------------------
173  *
174  * tkimg_GetByteArrayFromObj --
175  *
176  *  Returns the binary representation and length
177  *  for a byte array object.
178  *
179  * Results:
180  *  Returns a pointer to the byte representation of objPtr.  If
181  *  lengthPtr isn't NULL, the length of the string representation is
182  *  stored at *lengthPtr. The byte array referenced by the returned
183  *  pointer must not be modified by the caller. Furthermore, the
184  *  caller must copy the bytes if they need to retain them since the
185  *  objects representation can change as a result of other operations.
186  *
187  * Side effects:
188  *  May call the object's updateStringProc to update the string
189  *  representation from the internal representation.
190  *
191  *----------------------------------------------------------------------
192  */
tkimg_GetByteArrayFromObj(Tcl_Obj * objPtr,int * lengthPtr)193 unsigned char *tkimg_GetByteArrayFromObj(
194 	Tcl_Obj *objPtr, /**< Object whose string rep byte pointer
195 			  * should be returned, or NULL */
196 	int *lengthPtr /**< If non-NULL, the location where the
197 		        * string rep's byte array length should be
198 		        * stored. If NULL, no length is stored. */
199 ) {
200 #ifdef _LANG
201 	char *string = LangString((Arg) objPtr);
202 	if (lengthPtr) {
203 		*lengthPtr = string? strlen(string): 0;
204 	}
205 	return (unsigned char *) string;
206 #else /* _LANG */
207 
208 	return Tcl_GetByteArrayFromObj(objPtr, lengthPtr);
209 #endif /* _LANG */
210 }
211 
212 /*
213  *----------------------------------------------------------------------
214  *
215  * tkimg_GetByteArrayFromObj2 --
216  *
217  *  Returns the binary representation and length
218  *  for a byte array object.
219  *
220  * Results:
221  *  Returns a pointer to the byte representation of objPtr.  If
222  *  lengthPtr isn't NULL, the length of the string representation is
223  *  stored at *lengthPtr. The byte array referenced by the returned
224  *  pointer must not be modified by the caller. Furthermore, the
225  *  caller must copy the bytes if they need to retain them since the
226  *  objects representation can change as a result of other operations.
227  *
228  * Side effects:
229  *  May call the object's updateStringProc to update the string
230  *  representation from the internal representation.
231  *
232  *----------------------------------------------------------------------
233  */
tkimg_GetByteArrayFromObj2(Tcl_Obj * objPtr,size_t * lengthPtr)234 unsigned char *tkimg_GetByteArrayFromObj2(
235 	Tcl_Obj *objPtr, /**< Object whose string rep byte pointer
236 			  * should be returned, or NULL */
237 	size_t *lengthPtr /**< If non-NULL, the location where the
238 			   * string rep's byte array length should be
239 			   * stored. If NULL, no length is stored. */
240 ) {
241 #ifdef _LANG
242 	char *string = LangString((Arg) objPtr);
243 	if (lengthPtr) {
244 		*lengthPtr = string? strlen(string): 0;
245 	}
246 	return (unsigned char *) string;
247 #else /* _LANG */
248 	int len;
249 	unsigned char *result = Tcl_GetByteArrayFromObj(objPtr, &len);
250 	if (lengthPtr) {
251 		*lengthPtr = len;
252 	}
253 	return result;
254 #endif /* _LANG */
255 }
256 
257 /*
258  *----------------------------------------------------------------------
259  *
260  * tkimg_ListObjGetElements --
261  *
262  *  Splits an object into its components.
263  *
264  * Results:
265  *  If objPtr is a valid list (or can be converted to one),
266  *  TCL_OK will be returned. The object will be split in
267  *  its components.
268  *  Otherwise TCL_ERROR is returned. If interp is not a NULL
269  *  pointer, an error message will be left in it as well.
270  *
271  * Side effects:
272  *  May call the object's updateStringProc to update the string
273  *  representation from the internal representation.
274  *
275  *----------------------------------------------------------------------
276  */
277 
tkimg_ListObjGetElements(Tcl_Interp * interp,Tcl_Obj * objPtr,int * objc,Tcl_Obj *** objv)278 int tkimg_ListObjGetElements(
279 	Tcl_Interp *interp,
280 	Tcl_Obj *objPtr,
281 	int *objc,
282 	Tcl_Obj ***objv
283 ) {
284 	if (!objPtr) {
285 		*objc = 0;
286 		return TCL_OK;
287 	}
288 	return Tcl_ListObjGetElements(interp, objPtr, objc, objv);
289 }
290