#include "../xt/xt.h"
#include <X11/List.h>

static char **Get_List (x) Object x; {
    register i, n;
    register char *s, **l;

    Check_List (x);
    n = Internal_Length (x);
    l = (char **)XtMalloc ((n+1) * sizeof (char *));
    for (i = 0; i < n; i++, x = Cdr (x)) {
	Make_C_String (Car (x), s);
	l[i] = XtNewString (s);
    }
    l[i] = 0;
    return l;
}

static Object S_List_Callback (x) XtArgVal x; {
   XtListReturnStruct *p = (XtListReturnStruct *)x;
    return Cons (Make_String (p->string, strlen (p->string)),
	Make_Fixnum (p->list_index));
}

static XtArgVal C_List_List (x) Object x; {
   return (XtArgVal)Get_List (x);
}

static Object P_List_Change (w, x, resize) Object w, x, resize; {
   Check_Widget_Class (w, listWidgetClass);
    Check_Type (resize, T_Boolean);
    XtListChange (WIDGET(w)->widget, Get_List (x), 0, 0, EQ (resize, True));
    return Void;
}

static Object P_List_Highlight (w, i) Object w, i; {
   Check_Widget_Class (w, listWidgetClass);
    XtListHighlight (WIDGET(w)->widget, Get_Integer (i));
    return Void;
}

static Object P_List_Unhighlight (w) Object w; {
   Check_Widget_Class (w, listWidgetClass);
    XtListUnhighlight (WIDGET(w)->widget);
    return Void;
}

static Object P_List_Current (w) Object w; {
   XtListReturnStruct *p;

    Check_Widget_Class (w, listWidgetClass);
    p = XtListShowCurrent (WIDGET(w)->widget);
    if (p->list_index == XT_LIST_NONE)
	return False;
    return Cons (Make_String (p->string, strlen (p->string)),
	Make_Fixnum (p->list_index));
}

init_list () {
    XtResourceList r = 0;
    Define_Class ("list", listWidgetClass, r, 0);
    Define_Callback ("list", "callback", 1);
    Define_Primitive (P_List_Current, "list-current", 1, 1, EVAL);
    Define_Primitive (P_List_Unhighlight, "list-unhighlight", 1, 1, EVAL);
    Define_Primitive (P_List_Highlight, "list-highlight", 2, 2, EVAL);
    Define_Primitive (P_List_Change, "list-change!", 3, 3, EVAL);
    Define_Converter_To_C ("list-list", C_List_List);
    Define_Converter_To_Scheme ("list-callback", S_List_Callback);
}