Pledge in Practcl notation

noop {
 * Copyright (c) 2015,2017 Stuart Cassoff <stwo@users.sourceforge.net>
 *
 * Permission to use, copy, modify, and/or distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 
 * tjpledge.c
 *
 * Tcl / Jim interface to pledge(3).
 *

 * Notes:
 *
}
my include <unistd.h>
my include <errno.h>
# strerror
my include <string.h>

my code header {
#define COMBIEN(Z) ((int) (sizeof(Z) / sizeof(Z[0])))
}
set mode tcl
if {[my <project> define cget FOR_JIM 0]} {
  set mode jim
} elseif [my <project> define cget FOR_TCL_WENC 0] {
  set mode tcl_wenc
}

switch $mode {
  jim {
    my include <jim-subcmd.h>
    my code header {
# define EZT_OK JIM_OK
# define EZT_ERROR JIM_ERR
# define Ezt_Alloc Jim_Alloc
# define Ezt_Free Jim_Free
# define Ezt_PosixError() strerror(errno)
# define Ezt_WrongNumArgs Jim_WrongNumArgs
# define Ezt_IncrRefCount Jim_IncrRefCount
# define Ezt_DecrRefCount(O) Jim_DecrRefCount(interp,(O))
# define Ezt_SetResult(O) Jim_SetResult(interp,(O))
# define Ezt_Obj Jim_Obj
# define Ezt_Interp Jim_Interp
# define Ezt_NewInt(I) Ezt_NewIntObj(interp,(I))
# define Ezt_GetInt(I,P) Ezt_GetIntFromJimObj(interp,(I),(P))
# define Ezt_NewWide(I) Jim_NewWideObj(interp,(I))
# define Ezt_GetWide Jim_GetWide
# define Ezt_NewString(S,L) Jim_NewStringObj(interp,(S),(L))
# define Ezt_GetString Jim_GetString
# define Ezt_GetBytes Jim_GetString
# define Ezt_NewList() Jim_NewListObj(interp, NULL, 0)
# define Ezt_ListAppend(L,O) Jim_ListAppendElement(interp,(L),(O))
# define Ezt_NewDict() Jim_NewDictObj(interp, NULL, 0)
# define Ezt_DictPut(D,KO,VO) Jim_DictAddElement(interp,(D),(KO),(VO))
# define ezt_wide jim_wide
# define EZT_SUBCMD(S) int (S) (Ezt_Interp *interp, int objc, Ezt_Obj *const *objv)
# define EZT_CMD(S) int (S) (Ezt_Interp *interp, int objc, Ezt_Obj *const *objv)
# define ezt_subcmd_type jim_subcmd_type
}
  set EZT_SUBCMD {Ezt_Interp *interp, int objc, Ezt_Obj *const *objv}
  set EZT_CMD {Ezt_Interp *interp, int objc, Ezt_Obj *const *objv}
  } ; # JIM
  default {
    my include <tcl.h>
    my code header { 
# define EZT_OK TCL_OK
# define EZT_ERROR TCL_ERROR
# define Ezt_Alloc ckalloc
# define Ezt_Free ckfree
# define Ezt_PosixError() Tcl_PosixError(interp)
# define Ezt_WrongNumArgs Tcl_WrongNumArgs
# define Ezt_IncrRefCount Tcl_IncrRefCount
# define Ezt_DecrRefCount(O) Tcl_DecrRefCount((O))
# define Ezt_SetResult(O) Tcl_SetObjResult(interp,(O))
# define Ezt_Obj Tcl_Obj
# define Ezt_Interp Tcl_Interp
# define Ezt_NewInt Tcl_NewIntObj
# define Ezt_GetInt(I,P) Tcl_GetIntFromObj(interp,(I),(P))
# define Ezt_NewWide Tcl_NewWideIntObj
# define Ezt_GetWide Tcl_GetWideIntFromObj
# define Ezt_NewString Tcl_NewStringObj
# define Ezt_GetString Tcl_GetStringFromObj
# define Ezt_GetBytes Tcl_GetByteArrayFromObj
# define Ezt_NewList() Tcl_NewListObj(0,NULL)
# define Ezt_ListAppend(L,O) Tcl_ListObjAppendElement(interp,(L),(O))
# define Ezt_NewDict() Tcl_NewDictObj()
# define Ezt_DictPut(D,KO,VO) Tcl_DictObjPut(interp,(D),(KO),(VO))
# define ezt_wide TclWideInt
# define EZT_SUBCMD(S) int (S) (ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[])
# define EZT_CMD EZT_SUBCMD
    }
    set EZT_SUBCMD {ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]}
    set EZT_CMD $EZT_SUBCMD
    my cstructure ezt_subcmd_type {
	const char *name;
	const char *args;
	Tcl_ObjCmdProc *proc;
	short minargs;
	short maxargs;
	unsigned short flags;
}
  } ; # default
} ; #switch 

noop {
# Function not used
if {$jim_mode} {
  my c_function {static Jim_Obj *Ezt_NewIntObj (Jim_Interp *interp, int i)} {
	return Jim_NewWideObj(interp, (ezt_wide) i);
}
  my c_function {static int
Ezt_GetIntFromJimObj (Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr)} {
	jim_wide w;
	if (Jim_GetWide(interp, objPtr, &w) != JIM_OK) { return JIM_ERR; }
	*intPtr = (int) w;
	return JIM_OK;
}
}

set body {}
if {$mode eq "tcl_wenc"} {
  set body {
    Tcl_DString req;
	int ret = EZT_OK;

	if (objc < 2 || objc > 3) {
		Ezt_WrongNumArgs(interp, 1, objv, "promises ?paths?");
		return EZT_ERROR;
	}

	Tcl_DStringInit(&req);
	Tcl_UtfToExternalDString(NULL, Ezt_GetString(objv[1], NULL), -1, &req);

	if (objc == 2) {
		if (pledge(Tcl_DStringValue(&req), NULL) == -1) {
			Ezt_SetResult(Ezt_NewString(Tcl_PosixError(interp), -1));
			ret = EZT_ERROR;
		}
	} else if (objc == 3) {
		const char **paths = NULL;
		Tcl_DString *dsa;
		int lobjc;
		Ezt_Obj **lobjv;
		int i;
		if (Tcl_ListObjGetElements(interp, objv[2], &lobjc, &lobjv) != EZT_OK) {
			ret = EZT_ERROR;
			goto quitting;
		}
		dsa = ckalloc(lobjc * sizeof(*dsa));
		paths = ckalloc((lobjc + 1) * sizeof(*paths));
		for (i = 0; i < lobjc; i++) {
			Tcl_DStringInit(&dsa[i]);
			paths[i] = Tcl_UtfToExternalDString(NULL, Tcl_GetString(lobjv[i]), -1, &dsa[i]);
		}
		paths[i] = NULL;
		if (pledge(Tcl_DStringValue(&req), paths) == -1) {
			Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp), -1));
			ret = EZT_ERROR;
		}
		for (i = 0; paths[i] != NULL; i++) {
			Tcl_DStringFree(&dsa[i]);
		}
		ckfree(dsa);
		ckfree(paths);
	}

quitting:;

	Tcl_DStringFree(&req);

	return ret;
  }
  # END TCL_WENC
} else {
  set body {
	const char **paths = NULL;
	int ret = EZT_OK;

	if (objc < 2 || objc > 3) {
		Ezt_WrongNumArgs(interp, 1, objv, "promises ?paths?");
		return EZT_ERROR;
	}
  }
  if {$mode eq "jim"} {
    ::practcl::cputs body {
    if (objc == 3) {
  	    int llen, i;
		Ezt_Obj *o;
        
        llen = Jim_ListLength(interp, objv[2]);
        paths = (const char **) Ezt_Alloc((llen + 1) * sizeof(*paths));
        for (i = 0; i < llen; i++) {
        	o = Jim_ListGetIndex(interp, objv[2], i);
            paths[i] = Ezt_GetString(o, NULL);
        }
        paths[i] = NULL;
    }
}
  } else {
    ::practcl::cputs body {
    if (objc == 3) {
  	    int llen, i;
		Ezt_Obj **lobjv;
		if (Tcl_ListObjGetElements(interp, objv[2], &llen, &lobjv) != EZT_OK) {
			return EZT_ERROR;
		}
        paths = (const char **) Ezt_Alloc((llen + 1) * sizeof(*paths));
        for (i = 0; i < llen; i++) {
        	o = lobjv[i];
            paths[i] = Ezt_GetString(o, NULL);
        }
        paths[i] = NULL;
    }
}
  }
  ::practcl::cputs body {
	if (pledge(Ezt_GetString(objv[1], NULL), paths) == -1) {
		Ezt_SetResult(Ezt_NewString(Ezt_PosixError(), -1));
		ret = EZT_ERROR;
	}

	Ezt_Free((char *) paths);

	return ret;
  }
}

if {$mode eq "jim"} {
    my code header {
#define MIN_TCL_VERSION "8.5"
#define TJPledge_NS "::pledge"
#define TJPledge_CMD "pledge"
}
    my c_function "static TJPledge_PledgeCmd\($EXT_CMD\)" $body
    my c_function {EXTERN int Jim_pledgeInit (Jim_Interp *interp)} {
	if (Jim_CreateCommand(interp, "pledge", TJPledge_PledgeCmd, NULL, NULL)   != JIM_OK) { return JIM_ERR; }
	if (Jim_PackageProvide(interp, PACKAGE_NAME, PACKAGE_VERSION, JIM_ERRMSG) != JIM_OK) { return JIM_ERR; }
	return JIM_OK;
}
    my c_function 
} else {
    my c_tclcmd "::pledge" $body
}