// File: "TclAS.c"
//                        Created: 2014-12-11 18:05:01
//              Last modification: 2016-08-09 11:51:22
// Author: Bernard Desgraupes
// e-mail: <bdesgraupes@users.sourceforge.net>
// 
// Load this extension in the Tcl interpreter with the following instruction:
//         package require Tclapplescript
// 
// Copyright (c) 2014-2016 Bernard Desgraupes
//         All rights reserved.
// This software is free software with BSD licence.
// Version history: see the Changes.Log file.


#include "TclAS.h"
#include "TclASVersion.h"

/*
 * Prototypes for static procedures
 */
static int TclAS_AppleScriptCmd(ClientData clientData,  Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
static int TclASCmd_Decompile(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
static int TclASCmd_Execute(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
static int TclASCmd_Run(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]);
static int TclAS_GetAppleScriptComponent();
static void TclAS_SetResultFromDesc(Tcl_Interp *interp, AEDesc * inDesc);


static ComponentInstance sDefaultComponent = NULL;
static ComponentInstance sAppleScriptComponent = NULL;



/*
 *----------------------------------------------------------------------
 *
 * Tclapplescript_Init --
 *
 *	This procedure is invoked when the package is loaded.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */
int Tclapplescript_Init(Tcl_Interp *interp) {	
#ifdef USE_TCL_STUBS
    if (Tcl_InitStubs(interp, "8.1", 0) == NULL) {
		return TCL_ERROR;
    }
#endif

	// Register the [AppleScript] command
    Tcl_CreateObjCommand(interp, "AppleScript", TclAS_AppleScriptCmd,
			     (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);
				 
    // Declare the Tclapplescript package
    if (Tcl_PkgProvide(interp, "Tclapplescript", TCLAPPLESCRIPT_VERSION_STRING) != TCL_OK) {
		return TCL_ERROR;
    }       
		
    return TCL_OK;
}


/*
 *----------------------------------------------------------------------
 *
 * TclAS_AppleScriptCmd --
 *
 *	This procedure is invoked to process the "AppleScript" Tcl command.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	See the user documentation.
 *
 *----------------------------------------------------------------------
 */
int
TclAS_AppleScriptCmd(
    ClientData clientData,		/* Not used. */
    Tcl_Interp *interp,			/* Current interpreter. */
    int objc,					/* Number of arguments. */
    Tcl_Obj *CONST objv[])		/* Argument values. */
{
	int index, result;
	
	static CONST char *switches[] = {
		"decompile", "execute", "run", (char *) NULL 
	};
	
	enum {
		TCLAS_DECOMPILE, TCLAS_EXECUTE, TCLAS_RUN
	};
		
	if (objc < 2) {
		Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg ...?");
		return TCL_ERROR;
	}
	
	if (sAppleScriptComponent == NULL && TclAS_GetAppleScriptComponent() != TCL_OK) {
		Tcl_SetResult(interp, "Could not get default component.", TCL_STATIC);
		return TCL_ERROR;
	} 
	
	if (Tcl_GetIndexFromObj(interp, objv[1], switches, "subcommand", 0, &index) != TCL_OK) {
		return TCL_ERROR;
	}
	
	switch (index) {
		case TCLAS_DECOMPILE:
		result = TclASCmd_Decompile(clientData, interp, objc, objv);
		break;
		
		case TCLAS_EXECUTE:
		result = TclASCmd_Execute(clientData, interp, objc, objv);
		break;
		
		case TCLAS_RUN:
		result = TclASCmd_Run(clientData, interp, objc, objv);
		break;
				
	}

	return result;
}


/*
 *----------------------------------------------------------------------
 *
 * TclASCmd_Decompile --
 *
 *	This procedure is invoked to process the [AppleScript decompile] Tcl
 *	command.
 *
 * Syntax:
 *  AppleScript decompile scriptFile
 *  
 * Results:
 *	A standard Tcl result.
 *
 *----------------------------------------------------------------------
 */
int
TclASCmd_Decompile(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *CONST objv[])
{
	int				result = TCL_OK;
    char *			fileName;
    OSErr 			err;
    FSRef			scriptRef;
    Tcl_DString		nativeds, fileds;
    CONST UInt8 *	nativeName;
    AEDesc			resultDesc;
	OSAID			scriptID;
	

	if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "scriptFile");
		return TCL_ERROR;
	}
	
	fileName = Tcl_GetString(objv[objc-1]);
    if (Tcl_TranslateFileName(interp, fileName, &fileds) == NULL) {
		return TCL_ERROR;
    }
    nativeName = (CONST UInt8 *)Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&fileds), 
					  Tcl_DStringLength(&fileds), &nativeds);

    /* Get FSRef for file. */
    err = FSPathMakeRef(nativeName, &scriptRef, NULL);
	Tcl_DStringFree(&nativeds);
	Tcl_DStringFree(&fileds);
	if (err != noErr) {
		Tcl_SetResult(interp, "Could not get file reference.", TCL_STATIC);
		return TCL_ERROR;
	}

    // Load the file
    err = OSALoadFile(sAppleScriptComponent, &scriptRef, NULL, kOSAModeNull, &scriptID);
    if (err != noErr) {
		Tcl_SetResult(interp, "Failed to load script.", TCL_STATIC);
		return TCL_ERROR;
    } else {
		// Try to get the source script.
		// If a script error occurs during processing, the resultDesc gets
		// the error message of the error, and errOSAScriptError is returned.
		err = OSAGetSource(sAppleScriptComponent,scriptID,typeUTF8Text,&resultDesc);
	}
    
	if (err != noErr) {
		Tcl_SetResult(interp, "Failed to get source.", TCL_STATIC);
		result = TCL_ERROR;
	} 
	
	TclAS_SetResultFromDesc(interp, &resultDesc);
	AEDisposeDesc(&resultDesc);
		
	return result; 
}


/*
 *----------------------------------------------------------------------
 *
 * TclASCmd_Execute --
 *
 *	This procedure is invoked to process the [AppleScript execute] Tcl command.
 *
 * Syntax:
 *  AppleScript execute scriptData
 *  
 * Results:
 *	A standard Tcl result.
 *
 *----------------------------------------------------------------------
 */
int
TclASCmd_Execute(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *CONST objv[])
{
	int			len, result = TCL_OK;
	char *		script;
    OSErr 		err;
    AEDesc		scriptDesc, resultDesc;

	if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "scriptData");
		return TCL_ERROR;
	}
	
	script = Tcl_GetStringFromObj(objv[objc-1], &len);
	err = AECreateDesc(typeUTF8Text, script, len, &scriptDesc);
    if (err != noErr) {
		Tcl_SetResult(interp, "Can't create descriptor.", TCL_STATIC);
		return TCL_ERROR;
    } 
			
    err = OSADoScript(sAppleScriptComponent, &scriptDesc, kOSANullScript, typeUTF8Text, kOSAModeNull, &resultDesc);
    if (err != noErr) {
		// If a script error occurs during processing, the resultDesc gets
		// the error message of the error, and errOSAScriptError is returned.
		result = TCL_ERROR;
    } 
	
	/* Get output from the script execution. */
	TclAS_SetResultFromDesc(interp, &resultDesc);
	AEDisposeDesc(&resultDesc);
	AEDisposeDesc(&scriptDesc);
	
	return result; 
}


/*
 *----------------------------------------------------------------------
 *
 * TclASCmd_Run --
 *
 *	This procedure is invoked to process the [AppleScript run] Tcl command.
 *
 * Syntax:
 *  AppleScript run scriptFile
 *  
 * Results:
 *	A standard Tcl result.
 *
 *----------------------------------------------------------------------
 */
int
TclASCmd_Run(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *CONST objv[])
{
	int				result = TCL_OK;
    char *			fileName;
    OSErr 			err;
    FSRef			scriptRef;
    Tcl_DString		nativeds, fileds;
    CONST UInt8 *	nativeName;
    AEDesc			resultDesc;

	if (objc < 3) {
		Tcl_WrongNumArgs(interp, 2, objv, "scriptFile");
		return TCL_ERROR;
	}
	
	fileName = Tcl_GetString(objv[objc-1]);
    if (Tcl_TranslateFileName(interp, fileName, &fileds) == NULL) {
		return TCL_ERROR;
    }
    nativeName = (CONST UInt8 *)Tcl_UtfToExternalDString(NULL, Tcl_DStringValue(&fileds), 
					  Tcl_DStringLength(&fileds), &nativeds);

    /* Get FSRef for file. */
    err = FSPathMakeRef(nativeName, &scriptRef, NULL);
	Tcl_DStringFree(&nativeds);
	Tcl_DStringFree(&fileds);
	if (err != noErr) {
		Tcl_SetResult(interp, "Could not get file reference.", TCL_STATIC);
		return TCL_ERROR;
	}

    /* Load and execute the file. */
    err = OSADoScriptFile(sAppleScriptComponent, &scriptRef, kOSANullScript, typeUTF8Text, kOSAModeNull, &resultDesc);
    if (err != noErr) {
		// If a script error occurs during processing, the resultDesc gets
		// the error message of the error, and errOSAScriptError is returned.
		result = TCL_ERROR;
    } 
	
	/* Get output from the script execution. */
	TclAS_SetResultFromDesc(interp, &resultDesc);
	AEDisposeDesc(&resultDesc);
	
	return result; 
}


/*
 *----------------------------------------------------------------------
 *
 * TclAS_GetAppleScriptComponent --
 *
 *----------------------------------------------------------------------
 */
static int TclAS_GetAppleScriptComponent()
{
	int		result = TCL_OK;
	
	if (sDefaultComponent == NULL) {
		// Get the generic scripting component
		sDefaultComponent = OpenDefaultComponent(kOSAComponentType, kOSAGenericScriptingComponentSubtype);
	}
	
	if (sDefaultComponent != NULL) {
		OSAGetScriptingComponent(sDefaultComponent, kAppleScriptSubtype, &sAppleScriptComponent);
	} else {
		result = TCL_ERROR;
	}
	
	return result; 
}


/*
 *----------------------------------------------------------------------
 *
 * TclAS_SetResultFromDesc --
 *
 * Get output from the script execution.
 *
 *----------------------------------------------------------------------
 */
static void TclAS_SetResultFromDesc(Tcl_Interp *interp, AEDesc * inDesc)
{
    Tcl_DString		ds;
	Size			maxSize;
	void *          dataPtr;
	
	maxSize = AEGetDescDataSize(inDesc);
	dataPtr = malloc(maxSize+1);
	AEGetDescData(inDesc, dataPtr, maxSize);
	
	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, (char *)dataPtr, maxSize);
	Tcl_DStringResult(interp,&ds);
	Tcl_DStringFree(&ds);
	free(dataPtr);
}


