/*
 * $Header: /home/campbell/Languages/Scheme/scm/x-scm/RCS/xm.c,v 1.5 1992/08/10 22:48:49 campbell Beta $
 *
 * Author: Larry Campbell (campbell@redsox.bsw.com)
 *
 * Copyright 1992 by The Boston Software Works, Inc.
 * Permission to use for any purpose whatsoever granted, as long
 * as this copyright notice remains intact.  Please send bug fixes
 * or enhancements to the above email address.
 *
 * Class and function definitions for scm interface to Motif toolkit
 */

#include <stdio.h>
#include <X11/Intrinsic.h>
#include <X11/Shell.h>
#include <X11/StringDefs.h>
#include <Xm/Xm.h>
#include <Xm/ArrowB.h>
#include <Xm/ArrowBG.h>
#include <Xm/BulletinB.h>
#include <Xm/CascadeB.h>
#include <Xm/CascadeBG.h>
#include <Xm/DialogS.h>
#include <Xm/DrawingA.h>
#include <Xm/DrawnB.h>
#include <Xm/FileSB.h>
#include <Xm/Form.h>
#include <Xm/Frame.h>
#include <Xm/Label.h>
#include <Xm/LabelG.h>
#include <Xm/List.h>
#include <Xm/MainW.h>
#include <Xm/MenuShell.h>
#include <Xm/MessageB.h>
#include <Xm/PanedW.h>
#include <Xm/PushB.h>
#include <Xm/PushBG.h>
#include <Xm/RowColumn.h>
#include <Xm/Scale.h>
#include <Xm/ScrollBar.h>
#include <Xm/ScrolledW.h>
#include <Xm/SelectioB.h>
#include <Xm/Separator.h>
#include <Xm/SeparatoG.h>
#include <Xm/Text.h>
#include <Xm/TextF.h>
#include <Xm/ToggleB.h>
#include <Xm/ToggleBG.h>

#include "scm.h"
#include "x.h"
#include "xt.h"

static char	s_xm_create_popup_menu[]	= "xm:create-popup-menu";
static char	s_xm_create_pulldown_menu[]	= "xm:create-pulldown-menu";
static char	s_xm_list_delete_item[]		= "xm:list-delete-item";
static char	s_xm_list_deselect_all_items[]	= "xm:list-deselect-all-items";
static char	s_xm_menu_position[]		= "xm:menu-position";
static char	s_xm_string_create[]		= "xm:string-create";
static char	s_xm_string_get_first_segment[]	= "xm:string-get-first-segment";
static char	s_xm_text_get_string[]		= "xm:text-get-string";
static char	s_xm_vector_to_xmstringtable[]	= "xm:vector->xmstringtable";
static char	s_xm_xmstringp[]		= "xm:xmstring?";
static char	s_xm_xmstringtablep[]		= "xm:xmstringtable?";
static char	s_xm_xmstringtable_to_vector[]	= "xm:xmstringtable->vector";

xt_widget_class_t xm_widget_classes[] = {
    "xm:arrow-button",		&xmArrowButtonWidgetClass,
    "xm:arrow-button-gadget",	&xmArrowButtonGadgetClass,
    "xm:bulletin-board",	&xmBulletinBoardWidgetClass,
    "xm:cascade-button",	&xmCascadeButtonWidgetClass,
    "xm:cascade-button-gadget",	&xmCascadeButtonGadgetClass,
    "xm:dialog-shell",		&xmDialogShellWidgetClass,
    "xm:drawing-area",		&xmDrawingAreaWidgetClass,
    "xm:drawn-button",		&xmDrawnButtonWidgetClass,
    "xm:file-selection-box",	&xmFileSelectionBoxWidgetClass,
    "xm:form",			&xmFormWidgetClass,
    "xm:frame",			&xmFrameWidgetClass,
    "xm:gadget",		&xmGadgetClass,
    "xm:label",			&xmLabelWidgetClass,
    "xm:label-gadget",		&xmLabelGadgetClass,
    "xm:list",			&xmListWidgetClass,
    "xm:main-window",		&xmMainWindowWidgetClass,
    "xm:menu-shell",		&xmMenuShellWidgetClass,
    "xm:message-box",		&xmMessageBoxWidgetClass,
    "xm:paned-window",		&xmPanedWindowWidgetClass,
    "xm:push-button",		&xmPushButtonWidgetClass,
    "xm:push-button-gadget",	&xmPushButtonGadgetClass,
    "xm:row-column",		&xmRowColumnWidgetClass,
    "xm:scale",			&xmScaleWidgetClass,
    "xm:scroll-bar",		&xmScrollBarWidgetClass,
    "xm:scrolled-window",	&xmScrolledWindowWidgetClass,
    "xm:selection-box",		&xmSelectionBoxWidgetClass,
    "xm:separator",		&xmSeparatorWidgetClass,
    "xm:separator-gadget",	&xmSeparatorGadgetClass,
    "xm:text",			&xmTextWidgetClass,
    "xm:text-field",		&xmTextFieldWidgetClass,
    "xm:toggle-button",		&xmToggleButtonWidgetClass,
    "xm:toggle-button-gadget",	&xmToggleButtonGadgetClass,
    "xm:vendor-shell",		&vendorShellWidgetClass
};

extern void xt__make_arglist();

static sizet xm_free_xmstring();
static sizet xm_free_xmstringtable();

/*
 * Scheme types defined in this module
 */

#define XM_SMOBS							\
XX(xmstring,		mark_no_further,	xm_free_xmstring)	\
XX(xmstringtable,	mark_no_further,	xm_free_xmstringtable)

#undef XX
#define XX(name, mark, free)			\
long TOKEN_PASTE(tc16_,name);			\
static int TOKEN_PASTE(print_,name)();		\
static smobfuns TOKEN_PASTE(smob,name) =	\
	{ mark, free, TOKEN_PASTE(print_,name) };

XM_SMOBS


SCM make_xmstring()
{
  SCM s;
  NEWCELL(s);
  CAR(s) = tc16_xmstring;
  CDR(s) = 0;
  return s;
}

SCM make_xmstringtable(len)
int len;
{
  SCM v;
  XmString *p;

  NEWCELL(v);
  DEFER_INTS;
  SET_XMSTRINGTABLE_LENGTH(v,len,tc16_xmstringtable);
  SETCHARS(v,must_malloc(len*sizeof(XmString),"make_xmstringtable"));
  p = (XmString *) CDR(v);
  while(--len>=0)
    p[len] = 0;
  ALLOW_INTS;
  return v;
}

static sizet xm_free_xmstring(ptr)
SCM ptr;
{
  sizet n = XmStringLength(XMSTRING(ptr));
  XmStringFree(XMSTRING(ptr));
  return n;
}

static sizet xm_free_xmstringtable(ptr)
SCM ptr;
{
  int i;
  sizet n = 0;
  XmString *p = (XmString *) CDR(ptr);

  for (i = 0; i < XMSTRINGTABLE_LENGTH(ptr); i++) {
    n += XmStringLength(p[i]);
    XmStringFree(p[i]);
  }
  return n;
}

SCM xm_text_get_string(sw)
SCM sw;
{
  char *p;
  SCM s;

  ASSERT(NIMP(sw) && WIDGETP(sw),sw,ARG1,s_xm_text_get_string);
  p = XmTextGetString(WIDGET(sw));
  s = makfromstr(p, strlen(p));
  XtFree(p);
  return s;
}


SCM xm_create_popup_menu(sparent, sname, args)
SCM sparent, sname, args;
{
  char *name;
  ArgList arglist;
  int n;
  Widget w;

  ASSERT(NIMP(sparent) && WIDGETP(sparent), sparent, ARG1, s_xm_create_popup_menu);
  ASSERT(NIMP(sname) && STRINGP(sname), sname, ARG2, s_xm_create_popup_menu);
  name = CHARS(sname);
  xt__make_arglist(args, &arglist, &n, s_xm_create_popup_menu);

  w = XmCreatePopupMenu(WIDGET(sparent), name, arglist, n);

  return make_widget(w);
}


SCM xm_create_pulldown_menu(sparent, sname, args)
SCM sparent, sname, args;
{
  char *name;
  ArgList arglist;
  int n;
  Widget w;
  SCM sw;

  ASSERT(NIMP(sparent) && WIDGETP(sparent), sparent, ARG1, s_xm_create_pulldown_menu);
  ASSERT(NIMP(sname) && STRINGP(sname), sname, ARG2, s_xm_create_pulldown_menu);
  name = CHARS(sname);
  xt__make_arglist(args, &arglist, &n, s_xm_create_pulldown_menu);

  w = XmCreatePulldownMenu(WIDGET(sparent), name, arglist, n);

  return make_widget(w);
}


SCM xm_list_delete_item(sw, ss)
SCM sw, ss;
{
  ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xm_list_delete_item);
  ASSERT(NIMP(ss) && XMSTRINGP(ss), ss, ARG2, s_xm_list_delete_item);
  XmListDeleteItem(WIDGET(sw), XMSTRING(ss));
}


SCM xm_list_deselect_all_items(sw, ss)
SCM sw, ss;
{
  ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xm_list_deselect_all_items);
  XmListDeselectAllItems(WIDGET(sw));
}


SCM xm_menu_position(sw, se)
SCM sw, se;
{
  XButtonPressedEvent *e;

  ASSERT(NIMP(sw) && WIDGETP(sw), sw, ARG1, s_xm_menu_position);
  ASSERT(NIMP(se) && XEVENTP(se), se, ARG2, s_xm_menu_position);
  e = (XButtonPressedEvent *) XEVENT(se);
  XmMenuPosition(WIDGET(sw), e);
  return UNSPECIFIED;
}


SCM xm_string_create(str)
SCM str;
{
  SCM s;

  ASSERT(NIMP(str) && STRINGP(str), str, ARG1, s_xm_string_create);
  s = make_xmstring();
  SETCDR(s, XmStringCreateLtoR(CHARS(str), XmSTRING_DEFAULT_CHARSET));

  return s;
}


SCM xm_xmstringp(x)
SCM x;
{
  if (NIMP(x) && XMSTRINGP(x))
    return BOOL_T;
  else
    return BOOL_F;
}


SCM xm_xmstringtablep(x)
SCM x;
{
  if (NIMP(x) && XMSTRINGTABLEP(x))
    return BOOL_T;
  else
    return BOOL_F;
}


SCM xm_string_get_first_segment(sstr)
SCM sstr;
{
  XmString str;
  char *p;
  SCM s;

  ASSERT(NIMP(sstr) && XMSTRINGP(sstr), sstr, ARG1, s_xm_string_get_first_segment);
  XmStringGetLtoR(XMSTRING(sstr), XmSTRING_DEFAULT_CHARSET, &p);
  s = makfromstr(p, strlen(p));
  return s;
}


SCM xm_xmstringtable_to_vector(sl)
SCM sl;
{
  int i, len;
  SCM v, s;

  ASSERT(NIMP(sl) && XMSTRINGTABLEP(sl), sl, ARG1, s_xm_xmstringtable_to_vector);
  len = XMSTRINGTABLE_LENGTH(sl);
  if (len == 0) return nullvect;
  v = make_vector(MAKINUM((long) len), UNDEFINED);
  for (i = 0; i < len; i++) {
    s = make_xmstring();
    SETCDR(s, XmStringCopy(XMSTRINGTABLE(sl)[i]));
    VELTS(v)[i] = s;
  }
  return v;
}

SCM xm_vector_to_xmstringtable(sv)
SCM sv;
{
  SCM sl, s;
  int i, len;
  XmStringTable p;

  ASSERT(NIMP(sv) && VECTORP(sv), sv, ARG1, s_xm_vector_to_xmstringtable);
  len = LENGTH(sv);
  sl = make_xmstringtable(len);
  p = XMSTRINGTABLE(sl);
  for (i = 0; i < len; i++) {
    s = VELTS(sv)[i];
    ASSERT(NIMP(s) && XMSTRINGP(s), s, "vector elements must be XmStrings", s_xm_vector_to_xmstringtable);
    p[i] = XmStringCopy(XMSTRING(s));
  }
  return sl;  
}


static int print_xmstring(exp, f, writing)
SCM exp;
FILE *f;
int writing;
{
  lputs("#<XmString>", f);
  return 1;
}

static int print_xmstringtable(exp, f, writing)
SCM exp;
FILE *f;
int writing;
{
  lputs("#<XmStringTable of ", f);
  intprint(XMSTRINGTABLE_LENGTH(exp), 10, f);
  lputc('>',f);
  return 1;
}


iproc xm_lsubr2s[] = {
  {s_xm_create_popup_menu,	xm_create_popup_menu},
  {s_xm_create_pulldown_menu,	xm_create_pulldown_menu},
  {0, 0}
};

iproc xm_subr2s[] = {
  {s_xm_list_delete_item,		xm_list_delete_item},
  {s_xm_menu_position,			xm_menu_position},
  {0, 0}
};

iproc xm_subr1s[] = {
  {s_xm_list_deselect_all_items,	xm_list_deselect_all_items},
  {s_xm_string_create,			xm_string_create},
  {s_xm_string_get_first_segment,	xm_string_get_first_segment},
  {s_xm_text_get_string,		xm_text_get_string},
  {s_xm_xmstringp,			xm_xmstringp},
  {s_xm_xmstringtablep,			xm_xmstringtablep},
  {s_xm_xmstringtable_to_vector,	xm_xmstringtable_to_vector},
  {s_xm_vector_to_xmstringtable,	xm_vector_to_xmstringtable},
  {0, 0}
};

#undef XX
#define XX(name, mark, free) \
    TOKEN_PASTE(tc16_,name) = newsmob(&TOKEN_PASTE(smob,name));

void init_xm()
{
  init_iprocs(xm_lsubr2s, tc7_lsubr_2);
  init_iprocs(xm_subr2s,  tc7_subr_2);
  init_iprocs(xm_subr1s,  tc7_subr_1);
  XM_SMOBS
  xt_init_widget_classes(
    xm_widget_classes,
    XtNumber(xm_widget_classes),
    "*motif-widget-classes*");
}
