[darwinbuild-changes] [19] trunk/darwinxref
source_changes at macosforge.org
source_changes at macosforge.org
Wed Oct 4 01:37:38 PDT 2006
Revision: 19
http://trac.macosforge.org/projects/darwinbuild/changeset/19
Author: kevin
Date: 2006-10-04 01:37:38 -0700 (Wed, 04 Oct 2006)
Log Message:
-----------
- enhanced Tcl plugin support
Modified Paths:
--------------
trunk/darwinxref/DBPlugin.c
trunk/darwinxref/DBPlugin.h
trunk/darwinxref/DBTclPlugin.c
Modified: trunk/darwinxref/DBPlugin.c
===================================================================
--- trunk/darwinxref/DBPlugin.c 2005-06-18 01:33:07 UTC (rev 18)
+++ trunk/darwinxref/DBPlugin.c 2006-10-04 08:37:38 UTC (rev 19)
@@ -174,7 +174,7 @@
_DBPluginSetCurrentPlugin(plugin);
#if HAVE_TCL_PLUGINS
CFStringRef usage = NULL;
- if ((plugin->type & kDBPluginTclType) != 0) {
+ if ((plugin->interp) != 0) {
usage = call_tcl_usage((DBPlugin*)plugin);
} else {
usage = plugin->usage();
@@ -196,7 +196,7 @@
_DBPluginSetCurrentPlugin(plugin);
#if HAVE_TCL_PLUGINS
CFStringRef usage = NULL;
- if ((plugin->type & kDBPluginTclType) != 0) {
+ if ((plugin->interp) != 0) {
usage = call_tcl_usage((DBPlugin*)plugin);
} else {
usage = plugin->usage();
@@ -227,7 +227,7 @@
if (plugin) {
_DBPluginSetCurrentPlugin(plugin);
#if HAVE_TCL_PLUGINS
- if ((plugin->type & kDBPluginTclType) != 0) {
+ if ((plugin->interp) != 0) {
res = call_tcl_run((DBPlugin*)plugin, args);
} else {
res = plugin->run(args);
Modified: trunk/darwinxref/DBPlugin.h
===================================================================
--- trunk/darwinxref/DBPlugin.h 2005-06-18 01:33:07 UTC (rev 18)
+++ trunk/darwinxref/DBPlugin.h 2006-10-04 08:37:38 UTC (rev 19)
@@ -85,9 +85,6 @@
kDBPluginNullType = 0,
kDBPluginBasicType = 1,
kDBPluginPropertyType = 2,
-#if HAVE_TCL_PLUGINS
- kDBPluginTclType = 0x8000000,
-#endif
};
/*!
Modified: trunk/darwinxref/DBTclPlugin.c
===================================================================
--- trunk/darwinxref/DBTclPlugin.c 2005-06-18 01:33:07 UTC (rev 18)
+++ trunk/darwinxref/DBTclPlugin.c 2006-10-04 08:37:38 UTC (rev 19)
@@ -63,7 +63,34 @@
return tcl_result;
}
+Tcl_Obj* tcl_cfarray(CFArrayRef array) {
+ Tcl_Obj** objv;
+ int i, objc = CFArrayGetCount(array);
+ objv = (Tcl_Obj**)malloc(sizeof(Tcl_Obj*) * objc);
+ for (i = 0; i < objc; ++i) {
+ CFStringRef str = CFArrayGetValueAtIndex(array, i);
+ assert(CFGetTypeID(str) == CFStringGetTypeID());
+ objv[i] = tcl_cfstr(str);
+ }
+ Tcl_Obj* list = Tcl_NewListObj(objc, objv);
+ return list;
+}
+CFArrayRef cfarray_tcl(Tcl_Interp* interp, Tcl_Obj* list) {
+ CFArrayRef result = NULL;
+ Tcl_Obj** objv;
+ int i, objc;
+ if (Tcl_ListObjGetElements(interp, list, &objc, &objv) == TCL_OK) {
+ const void** array = malloc(sizeof(CFStringRef) * objc);
+ for (i = 0; i < objc; ++i) {
+ array[i] = cfstr_tcl(objv[i]);
+ }
+ result = CFArrayCreate(NULL, array, objc, &kCFTypeArrayCallBacks);
+ free(array);
+ }
+ return result;
+}
+
int DBPluginSetNameCmd(ClientData data, Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[]) {
if (objc != 2) {
Tcl_WrongNumArgs(interp, 1, objv, "name");
@@ -85,9 +112,9 @@
char* type = Tcl_GetStringFromObj(objv[1], &length);
DBPlugin* plugin = (DBPlugin*)data;
if (strcmp(type, "basic") == 0) {
- plugin->type = kDBPluginBasicType | kDBPluginTclType;
+ plugin->type = kDBPluginBasicType;
} else if (strcmp(type, "property") == 0) {
- plugin->type = kDBPluginPropertyType | kDBPluginTclType;
+ plugin->type = kDBPluginPropertyType;
} else {
Tcl_AppendResult(interp, "Unknown type: ", type, NULL);
return TCL_ERROR;
@@ -95,16 +122,115 @@
return TCL_OK;
}
+int DBPluginSetDatatypeCmd(ClientData data, Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[]) {
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "datatype");
+ return TCL_ERROR;
+ }
+ int length;
+ char* type = Tcl_GetStringFromObj(objv[1], &length);
+ DBPlugin* plugin = (DBPlugin*)data;
+ if (strcmp(type, "string") == 0) {
+ plugin->datatype = CFStringGetTypeID();
+ } else if (strcmp(type, "array") == 0) {
+ plugin->datatype = CFArrayGetTypeID();
+ } else if (strcmp(type, "dictionary") == 0) {
+ plugin->datatype = CFDictionaryGetTypeID();
+ } else {
+ Tcl_AppendResult(interp, "Unknown type: ", type, NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+int DBGetCurrentBuildCmd(ClientData data, Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[]) {
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, tcl_cfstr(DBGetCurrentBuild()));
+ return TCL_OK;
+}
+
+
+int DBSetPropStringCmd(ClientData data, Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[]) {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv, "build project property value");
+ return TCL_ERROR;
+ }
+
+ CFStringRef build = cfstr_tcl(objv[1]);
+ CFStringRef project = cfstr_tcl(objv[2]);
+ CFStringRef property = cfstr_tcl(objv[3]);
+ CFStringRef value = cfstr_tcl(objv[4]);
+ DBSetPropString(build, project, property, value);
+ return TCL_OK;
+}
+
+int DBCopyPropStringCmd(ClientData data, Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[]) {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "build project property");
+ return TCL_ERROR;
+ }
+
+ CFStringRef build = cfstr_tcl(objv[1]);
+ CFStringRef project = cfstr_tcl(objv[2]);
+ CFStringRef property = cfstr_tcl(objv[3]);
+ CFStringRef str = DBCopyPropString(build, project, property);
+ if (str) {
+ Tcl_SetObjResult(interp, tcl_cfstr(str));
+ CFRelease(str);
+ }
+ return TCL_OK;
+}
+
+
+int DBSetPropArrayCmd(ClientData data, Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[]) {
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv, "build project property list");
+ return TCL_ERROR;
+ }
+
+ CFStringRef build = cfstr_tcl(objv[1]);
+ CFStringRef project = cfstr_tcl(objv[2]);
+ CFStringRef property = cfstr_tcl(objv[3]);
+ CFArrayRef list = cfarray_tcl(interp, objv[4]);
+ DBSetPropArray(build, project, property, list);
+ return TCL_OK;
+}
+
+int DBCopyPropArrayCmd(ClientData data, Tcl_Interp* interp, int objc, Tcl_Obj* CONST objv[]) {
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "build project property");
+ return TCL_ERROR;
+ }
+
+ CFStringRef build = cfstr_tcl(objv[1]);
+ CFStringRef project = cfstr_tcl(objv[2]);
+ CFStringRef property = cfstr_tcl(objv[3]);
+ CFArrayRef array = DBCopyPropArray(build, project, property);
+ if (array) {
+ Tcl_SetObjResult(interp, tcl_cfarray(array));
+ CFRelease(array);
+ }
+ return TCL_OK;
+}
+
+
int load_tcl_plugin(DBPlugin* plugin, const char* filename) {
- // Create a plugin object
Tcl_Interp* interp = Tcl_CreateInterp();
plugin->interp = (DBPluginRunFunc)interp;
- // Register our plugin callback
+ // Register our plugin callbacks
Tcl_CreateObjCommand(interp, "DBPluginSetName", DBPluginSetNameCmd, (ClientData)plugin, (Tcl_CmdDeleteProc *)NULL);
Tcl_CreateObjCommand(interp, "DBPluginSetType", DBPluginSetTypeCmd, (ClientData)plugin, (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp, "DBPluginSetDatatype", DBPluginSetDatatypeCmd, (ClientData)plugin, (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp, "DBGetCurrentBuild", DBGetCurrentBuildCmd, (ClientData)plugin, (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp, "DBSetPropString", DBSetPropStringCmd, (ClientData)plugin, (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp, "DBCopyPropString", DBCopyPropStringCmd, (ClientData)plugin, (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp, "DBSetPropArray", DBSetPropArrayCmd, (ClientData)plugin, (Tcl_CmdDeleteProc *)NULL);
+ Tcl_CreateObjCommand(interp, "DBCopyPropArray", DBCopyPropArrayCmd, (ClientData)plugin, (Tcl_CmdDeleteProc *)NULL);
// Source the plugin file
Tcl_EvalFile(interp, filename);
@@ -119,10 +245,24 @@
}
int call_tcl_run(DBPlugin* plugin, CFArrayRef args) {
- // XXX: need to pass args
- Tcl_Eval(plugin->interp, "run");
- Tcl_Obj* res = Tcl_GetObjResult(plugin->interp);
- return 0;
+ Tcl_Obj* tcl_args = tcl_cfarray(args);
+ Tcl_Obj* varname = tcl_cfstr(CFSTR("__args__"));
+ Tcl_ObjSetVar2(plugin->interp, varname, NULL, tcl_args, TCL_GLOBAL_ONLY);
+ int exitCode = -1;
+ if (Tcl_Eval(plugin->interp, "eval run ${__args__}") == TCL_OK) {
+ Tcl_Obj* result = Tcl_GetObjResult(plugin->interp);
+ if (Tcl_GetCharLength(result) == 0) {
+ exitCode = 0;
+ } else {
+ Tcl_GetIntFromObj(plugin->interp, result, &exitCode);
+ }
+ } else {
+ Tcl_Obj* result = Tcl_GetObjResult(plugin->interp);
+ CFStringRef str = cfstr_tcl(result);
+ cfprintf(stderr, "Tcl error in \'%@\' plugin: %@\n", plugin->name, str);
+ CFRelease(str);
+ }
+ return exitCode;
}
#endif /* HAVE_TCL_PLUGINS */
\ No newline at end of file
-------------- next part --------------
An HTML attachment was scrubbed...
URL: http://lists.macosforge.org/pipermail/darwinbuild-changes/attachments/20061004/de10461b/attachment-0001.html
More information about the darwinbuild-changes
mailing list