Jim Tcl

EXTENSIONS_OBJS := $(patsubst %,jim-%.o,$(EXTENSIONS))

.PRECIOUS: jim-%.c

# Create C extensions from pure Tcl extensions
jim-%.c: %.tcl
	echo $@ >>.clean
	tclsh make-c-ext $*.tcl

# Emulate tinytcl
LIBJIM := libtcl6.a

ifdef jim_nofork
	CFLAGS += -DNO_FORK
endif

# what: jim commands, description, points to ponder

jim 
	set var [value]

	dict

    if (ferror(outfilePtr->f)) {
        Jim_AppendResult(interp, "error writing \"", argv[0], "\": ", Jim_UnixError(interp), 0);
        clearerr(outfilePtr->f);
        return TCL_ERROR;
    }

    Jim_SetIntResult(interp, count);

    return JIM_OK;
}
#endif

static int bio_cmd_write(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{

        return "link";
    } else if (S_ISSOCK(mode)) {
        return "socket";
    }
    return "unknown";
}

static void Jim_SetIntResult(Jim_Interp *interp, jim_wide wide)
{
    Jim_SetResult(interp, Jim_NewIntObj(interp, wide));
}

/*
 *----------------------------------------------------------------------
 *
 * StoreStatData --
 *
 *  This is a utility procedure that breaks out the fields of a
 *  "stat" structure and stores them in textual form into the

static int file_cmd_atime(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
    struct stat sb;

    if (file_stat(interp, argv[0], &sb) != JIM_OK) {
        return JIM_ERR;
    }
    Jim_SetIntResult(interp, sb.st_atime);
    return JIM_OK;
}

static int file_cmd_mtime(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
    struct stat sb;

    if (file_stat(interp, argv[0], &sb) != JIM_OK) {
    return JIM_ERR;
    }
    Jim_SetIntResult(interp, sb.st_mtime);
    return JIM_OK;
}

static int file_cmd_size(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
    struct stat sb;

    if (file_stat(interp, argv[0], &sb) != JIM_OK) {
    return JIM_ERR;
    }
    Jim_SetIntResult(interp, sb.st_size);
    return JIM_OK;
}

static int file_cmd_isdirectory(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
    struct stat sb;
    int ret = 0;

    if (file_stat(interp, argv[0], &sb) == JIM_OK) {
    ret = S_ISDIR(sb.st_mode);
    }
    Jim_SetIntResult(interp, ret);
    return JIM_OK;
}

static int file_cmd_isfile(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
    struct stat sb;
    int ret = 0;

    if (file_stat(interp, argv[0], &sb) == JIM_OK) {
    ret = S_ISREG(sb.st_mode);
    }
    Jim_SetIntResult(interp, ret);
    return JIM_OK;
}

static int file_cmd_owned(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
    struct stat sb;
    int ret = 0;

    if (file_stat(interp, argv[0], &sb) == JIM_OK) {
    ret = (geteuid() == sb.st_uid);
    }
    Jim_SetIntResult(interp, ret);
    return JIM_OK;
}

#ifdef S_IFLNK
static int file_cmd_readlink(Jim_Interp *interp, int argc, Jim_Obj *const *argv)
{
    const char *path = Jim_GetString(argv[0], NULL);

#include <regex.h>
#include <string.h>

#define JIM_EXTENSION
#include "jim.h"

/* REVISIT: Would be useful in jim.h */
static void Jim_SetIntResult(Jim_Interp *interp, jim_wide wide)
{
    Jim_SetResult(interp, Jim_NewIntObj(interp, wide));
}

/**
 * REVISIT: Should cache a number of compiled regexps for performance reasons.
 */
static regex_t * 
compile_regexp(Jim_Interp *interp, const char *pattern, int flags)
{
    int ret;

    done:
    if (result == JIM_OK) {
        if (opt_inline) {
            Jim_SetResult(interp, resultListObj);
        }
        else {
            Jim_SetIntResult(interp, num_matches);
        }
    }

    Jim_Free(pmatch);
    regfree(regex);
    Jim_Free(regex);
    return result;

     */
    Jim_AppendString(interp, resultObj, p, -1);

    /* And now set the result variable */
    result = Jim_SetVariable(interp, varname, resultObj);

    if (result == JIM_OK) {
        Jim_SetIntResult(interp, num_matches);
    }
    else {
        Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
        Jim_AppendStrings(interp, Jim_GetResult(interp), "couldn't set variable \"", Jim_GetString(varname, NULL), "\"", NULL);
        Jim_FreeObj(interp, resultObj);
    }

        }
        Jim_DecrRefCount(interp, objv[0]);
        Jim_DecrRefCount(interp, objv[1]);
    }
    return retval;
}


/* REVISIT: Just load the file with a single malloc/fread then Jim_EvalObj() */
int Jim_EvalFile(Jim_Interp *interp, const char *filename)
{
    char *prg = NULL;
    FILE *fp;
    int nread, totread, maxlen, buflen;
    int retval;
    Jim_Obj *scriptObjPtr;


    
    if ((fp = fopen(filename, "r")) == NULL) {
        const int cwd_len=2048;
        char *cwd=malloc(cwd_len);
        Jim_SetResult(interp, Jim_NewEmptyStringObj(interp));
        if (getcwd( cwd, cwd_len ) != 0) {
            strcpy(cwd, "?");
        }
        Jim_AppendStrings(interp, Jim_GetResult(interp),
            "Error loading script \"", filename, "\"",
            " cwd: ", cwd,
            " err: ", strerror(errno), NULL);
        free(cwd);
        return JIM_ERR;
    }
    buflen = 1024;
    maxlen = totread = 0;
    while (1) {
        if (maxlen < totread+buflen+1) {
            maxlen = totread+buflen+1;
            prg = Jim_Realloc(prg, maxlen);
        }
        if ((nread = fread(prg+totread, 1, buflen, fp)) == 0) break;


        totread += nread;

    }
    prg[totread] = '\0';
    fclose(fp);

    scriptObjPtr = Jim_NewStringObjNoAlloc(interp, prg, totread);
    JimSetSourceInfo(interp, scriptObjPtr, filename, 1);
    Jim_IncrRefCount(scriptObjPtr);
    retval = Jim_EvalObj(interp, scriptObjPtr);
    Jim_DecrRefCount(interp, scriptObjPtr);
    return retval;
}

#!/usr/bin/env tclsh

proc tcl_to_string {str} {
	set result {}
	foreach buf [split $str \n] {
		set trimmed [string trim $buf]
		if {[string match "#*" $trimmed] || $trimmed == ""} {
			continue
		}
		regsub -all {\\} $buf {\\\\} buf 
		regsub -all \" $buf "\\\"" buf
		append result {"} $buf {\n"} \n
	}
	return $result
}

foreach file $argv {
	if {![string match *.tcl $file]} {
		error "Not a tcl file: $file"
	}
	set tmp [file tail $file]
	set rootname [file rootname $tmp]
	set outfile jim-$rootname.c
	puts "$file -> $outfile"
	set f [open $file]
	set str [read $f]
	close $f
	set f [open $outfile w]
	puts $f {#include <jim.h>}
	puts $f "int Jim_${rootname}Init(Jim_Interp *interp)"
	puts $f "{"
	puts $f "\treturn Jim_EvalGlobal(interp, "
	puts -nonewline $f [tcl_to_string $str]
	puts $f ");\t}"
	close $f
}

#!/bin/sh

exec >$1

shift



echo '#include "jim.h"'
for i in "$@"; do
	name=`echo $i | sed -e 's@.*/\(.*\).c@\1@'`
	echo "extern int Jim_${name}Init(Jim_Interp *interp);"
done
echo "int Jim_InitStaticExtensions(Jim_Interp *interp) {"
for i in "$@"; do
	name=`echo $i | sed -e 's@.*/\(.*\).c@\1@'`
	echo "if (Jim_${name}Init(interp) != JIM_OK) return JIM_ERR;"
done
	echo "return JIM_OK;"
echo "}"