/*
 *                             E D I T . C
 *
 *  Implements the scheme edit command for editing scheme functions.
 *
 *  Version      : $Revision: 1.5 $
 *
 *  Created      : Thu Jun 30 02:28:33 1994
 *  Author       : Ulrich Drepper <drepper@mydec>
 *
 *  Last modified: Sat Jul 16 18:13:19 1994
 *  Author       : Ulrich Drepper <drepper@mydec>
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 1, or (at your option)
 *  any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 *
 */
#if !defined(lint)
static const char *vcid = "$Id: edit.c,v 1.5 1994/07/17 22:27:22 drepper Exp $";
#endif /* lint */

#include <assert.h>
#include <X11/Intrinsic.h>
#include <X11/StringDefs.h>
#include <X11/Shell.h>
#include <X11/Xaw/AsciiText.h>
#include <X11/Xaw/Command.h>
#include <X11/Xaw/Form.h>
#include <X11/Xaw/Paned.h>

#include "scheme.h"
#include "empire.h"

/*
 * prototypes for local functions
 */
static Scheme_Object *edit(Scheme_Object *form, Scheme_Env *env);
static void init_edit(void);
static void callbackCodeEditExit(Widget widget, XtPointer closure,
				 XtPointer callData);
static void callbackCodeEditTest(Widget widget, XtPointer closure,
				 XtPointer callData);
static void codeEditAdd(Bool active, XawTextBlock *textBlock, Bool async);

/*
 * local variables
 */
static Bool editIsUp = False;
static Widget codeEditPopup;
static Widget editField;
static Widget outputField;
static void (*oldEditAdd)(Bool, XawTextBlock *, Bool);
static Widget currentTextWidget;

/*
 * exported functions
 */
void
scheme_init_edit(Scheme_Env *env)
{
    editIsUp = False;
    scheme_add_global("edit", scheme_make_syntax(edit), env);
}

/*
 * local functions
 */
static Scheme_Object *
edit(Scheme_Object *form, Scheme_Env *env)
{
    int len = scheme_list_length(form);
    Scheme_Object *closName;
    Scheme_Object *closure;
    Scheme_Object *expr;
    
    SCHEME_ASSERT((len==2), "edit: wrong number of args");

    closName = SCHEME_CAR(SCHEME_CDR(form));
    SCHEME_ASSERT(SCHEME_SYMBOLP(closName),
		  "edit: arg must only single symbol");
    if (scheme_lookup_value(closName, env)) {
	closure  = scheme_eval(closName, env);
	SCHEME_ASSERT(SCHEME_CLOSUREP(closure), "edit: arg must be closure");
    } else {
	closure = NULL;
    }
    SCHEME_ASSERT(xIsUp, "edit: X error");
    SCHEME_ASSERT(!editIsUp, "edit: already running");
    SCHEME_ASSERT(scheme_lookup_value(
	              scheme_intern_symbol("generic-write"),
                      env),
		  "edit: pretty print function `generic-write' not defined");

    init_edit();
    XtRealizeWidget(codeEditPopup);

    XawTextSetInsertionPoint(editField, 0);
    XtVaSetValues(
        editField,
        XtNstring, "",
        NULL);
    XtVaSetValues(
        outputField,
        XtNstring, "",
        NULL);

    editIsUp = True;

     /* prepare edit widget communication */
    currentTextWidget = editField;

    if (closure) {
	oldEditAdd = currentEditAdd;
	currentEditAdd = codeEditAdd;

	XawTextDisableRedisplay(editField);
	
    /* (generic-write '(define (<name> <params>) <body>) #t NR_COLS display) */
#define NR_COLS 50
	scheme_eval(scheme_make_pair(
	    scheme_intern_symbol("generic-write"),
            scheme_make_pair(
	        scheme_make_pair(
                    scheme_quote_symbol,
	            scheme_make_pair(
		        scheme_make_pair(
		            scheme_intern_symbol("define"),
	                    scheme_make_pair(
		                scheme_make_pair(
			            closName,
		                    SCHEME_CAR(SCHEME_CLOS_CODE(closure))),
		                SCHEME_CDR(SCHEME_CLOS_CODE(closure)))),
		        scheme_null)),
	        scheme_make_pair(
		    scheme_true,
	            scheme_make_pair(
		        scheme_make_integer(NR_COLS),
		        scheme_make_pair(
		            scheme_intern_symbol("display"),
		            scheme_null))))), env);

	XawTextEnableRedisplay(editField);
	
	currentEditAdd = oldEditAdd;
    } else {
	char begin[100];
#if XtSpecificationRelease<6 || defined(UseXaw3d)
	XawTextBlock block = { 0, 0, begin, FMT8BIT };
#else
	XawTextBlock block = { 0, 0, begin, XawFmt8Bit };
#endif
	sprintf(begin, "(define (%s ", SCHEME_STR_VAL(closName));
	block.length = strlen(begin);

	codeEditAdd(True, &block, False);
    }
    
    return scheme_true;
}

/*
 * local functions
 */
void
init_edit(void)
{
    Widget form;
    Widget OK;
    Widget Cancel;
    Widget Test;
    Widget codeEditPane;
    
    codeEditPopup = XtVaCreateManagedWidget(
	"codeeditpopup",
        topLevelShellWidgetClass,
        topLevel,
        NULL);
    codeEditPane = XtVaCreateManagedWidget(
	"codeeditpane",
        panedWidgetClass,
        codeEditPopup,
        NULL);
    editField = XtVaCreateManagedWidget(
        "edit",
        asciiTextWidgetClass,
        codeEditPane,
        XtNeditType, XawtextEdit,
        NULL);
    XtSetKeyboardFocus(
        codeEditPane,
        editField);
    outputField = XtVaCreateManagedWidget(
        "output",
        asciiTextWidgetClass,
        codeEditPane,
        NULL);
    form = XtVaCreateManagedWidget(
        "form",
        formWidgetClass,
        codeEditPane,
        NULL);
    OK = XtVaCreateManagedWidget(
	"OK",
        commandWidgetClass,
        form,
        NULL);
    XtAddCallback(
	OK,
        XtNcallback, callbackCodeEditExit,
        (XtPointer)True);
    Cancel = XtVaCreateManagedWidget(
	"Cancel",
        commandWidgetClass,
        form,
        NULL);
    XtAddCallback(
	Cancel,
        XtNcallback, callbackCodeEditExit,
        (XtPointer)False);
    Test = XtVaCreateManagedWidget(
	"Test",
        commandWidgetClass,
        form,
        NULL);
    XtAddCallback(
	Cancel,
        XtNcallback, callbackCodeEditTest,
        (XtPointer)False);
    
    XawPanedSetMinMax(
	form,
        30, 30);     /* I don't know why automatic placement don't work */
}

static void
callbackCodeEditExit(Widget widget, XtPointer closure, XtPointer callData)
{
    if ((Bool)closure) {
	Scheme_Object *obj;
	Widget source = XawTextGetSource(editField);
	char buffer[65536];
	char *cp = buffer;
	XawTextBlock block;
        int len = 0;
	int readNow;

	while (1) {
	    readNow = XawTextSourceRead(
		source,
	        len,
	        &block,
	        1024);
	    if (block.length == 0) break;
	    strcpy(&buffer[len], block.ptr);
	    len += readNow;
	    assert(len < sizeof(buffer));
	}
	buffer[len] = '\0';

	if ((obj=scheme_read_str(&cp)) == scheme_eos) {
	    message(WARN, "edit: error while parsing");
	    return;
	}

	if (!scheme_eval(obj, globalSchemeEnv)) {
	    message(WARN, "edit: error while evaluating");
	    return;
	}
    }
    
    XtUnrealizeWidget(codeEditPopup);
    editIsUp = False;

    
}

static void
callbackCodeEditTest(Widget widget, XtPointer closure, XtPointer callData)
{
}

/* ARGSUSED */
static void
codeEditAdd(Bool active, XawTextBlock *textBlock, Bool async)
{
    if (textBlock) {
        XawTextPosition pos = XawTextGetInsertionPoint(currentTextWidget);

        XawTextReplace(
            currentTextWidget,
            pos,
            pos,
            textBlock);

        XawTextSetInsertionPoint(currentTextWidget, pos+textBlock->length);
    } else {
        XawTextDisplayCaret(currentTextWidget, active);
    }
}


/*
 * Local Variables:
 *  mode:c
 *  c-indent-level:4
 *  c-continued-statement-offset:4
 *  c-continued-brace-offset:0
 *  c-brace-offset:0
 *  c-imaginary-offset:0
 *  c-argdecl-indent:4
 *  c-label-offset:-2
 * End:
 */
