#include "xlisp.h"
#include "xlstat.h"
#include <ddeml.h>
#include <alloc.h>
#include "ledit.h"
#include "winutils.h"
#include "wxlisp.h"
#include "version.h"

/* command line arguments */
static int argc;
static char **argv;
#ifdef WIN32
#define APPNAME "WXLS32"
#else
#define APPNAME "WXLS"
#endif

/* global variables */
static char szFrameClass[] = "MdiFrame";
static char szListenerClass[] = "MdiListenerChild";
static char listenerSection[] = "Listener";
static char xlispSection[] = "Xlisp";
#ifdef WIN32
long win32stsz;
char *iniFile = "wxls32.ini";
#else
char *iniFile = "wxls.ini";
#endif /* WIN32 */
HINSTANCE hInst;
HWND hWndFrame, hWndClient;
static HWND hEditWnd, hEditFrame;
HMENU hMainMenu;
HMENU hWinMenu;
HANDLE hAccel;
static HFONT hListenerFont = NULL;
int Exiting = FALSE;
extern char *defaultpath, *resfile;
extern char buf[];
#ifdef WIN32
BOOL win32s;
#endif
extern LVAL s_in_callback;

static DWORD ddeInst = 0;
static HSZ service, topic;
static jmp_buf exit_tag;

/* forward declarations */
static BOOL CheckSystem(void);
static BOOL InitApplication(HANDLE);
static BOOL InitInstance(HANDLE, int);
BOOL InitApplDialogs(HANDLE);
BOOL InitInstDialogs(HANDLE);
BOOL InitApplGraphics(HANDLE);
BOOL InitInstGraphics(HANDLE);
LONG CALLBACK FrameWndProc(HWND, UINT, WPARAM, LONG);
BOOL CALLBACK CloseEnumProc(HWND, LONG);
LONG CALLBACK ListenerWndProc(HWND, UINT, WPARAM, LONG);
HDDEDATA CALLBACK DdeProc(UINT, UINT, HCONV, HSZ, HSZ, HDDEDATA, DWORD, DWORD);
static void mainloop(void);
static void close_all_conversations(void);
static void set_dde_result(HCONV, LVAL);
static LVAL get_dde_result(HCONV);
static void delete_dde_result(HCONV);

#define LSGR_LINES 0
#define LSGR_POINTS 1
#define LSGR_MARGIN 10

int WINAPI WinMain(HINSTANCE hInstance,
		   HINSTANCE hPrevInstance,
		   LPSTR lpCmdLine,
		   int nCmdShow)
{
  MSG msg;
  PFNCALLBACK lpDdeProc;

  /* check system characteristics */
  if (! CheckSystem()) return(FALSE);

  /* Try to cooperate with other running instances of the application */
  if (! hPrevInstance)
    if (! InitApplication(hInstance))
      return(FALSE);

  /* initialize the specific instance */
  if (! InitInstance(hInstance, nCmdShow))
    return(FALSE);

  /* initialize DDEML */
  lpDdeProc = (PFNCALLBACK) MakeProcInstance((FARPROC) DdeProc, hInst);
  DdeInitialize(&ddeInst, lpDdeProc,
                APPCLASS_STANDARD |
                CBF_FAIL_ADVISES | CBF_FAIL_POKES |
                CBF_SKIP_CONNECT_CONFIRMS |
                CBF_SKIP_REGISTRATIONS | CBF_SKIP_UNREGISTRATIONS,
                0L);

  service = DdeCreateStringHandle(ddeInst, "XLISP-STAT", CP_WINANSI);
  topic = DdeCreateStringHandle(ddeInst, "XLISP-STAT", CP_WINANSI);
  DdeNameService(ddeInst, service, NULL, DNS_REGISTER);

  /* parse the argument list into argv */
  {
    extern char buf[];
    int i=0, j, argcount;

    /* get number of arguments */
    /* The Win32 documentaion on-line at Microsoft says that lpCmdLine
       contains the parameters, not the entire command line. Borland's
       documentation with 5.0 (Programmers Manual p. 186) claims
       otherwise. The runtime in the old version of Borland C I use,
       with __BORLANDC__ = 0x452, actually does pass the whole command
       line. The runtime under 5.0 does not. Hence this weird
       conditional. */
#if defined(WIN32) && defined(__BORLANDC__) && (__BORLANDC__ <= 0x452)
    argc = 0;
#else
    argc = 1;
#endif /* WIN32 */
    while (sscanf(&lpCmdLine[i], "%128s%n", buf, &j) == 1) {
      i += j;
      argc++;
    }

    /* now fill in arguments */
    argv = (char **) calloc(argc, sizeof(char *));
    i = 0;
#if defined(WIN32) && defined(__BORLANDC__) && (__BORLANDC__ <= 0x452)
    argcount = 0;
#else
    argv[0] = APPNAME;
    argcount = 1;
#endif /* WIN32 */
    while (sscanf(&lpCmdLine[i],"%128s%n", buf, &j)==1) {
      i += j;
      argv[argcount] = (char *) malloc(strlen(buf) + 1);
      strcpy(argv[argcount++], buf);
    }
  }

  if (setjmp(exit_tag) == 0)
    xlsmain(argc, argv);

  /* process orderly shutdown */
  close_all_conversations();
  Exiting = TRUE;
  while (GetMessage(&msg, 0, 0, 0)) {
    TranslateMessage(&msg);
    DispatchMessage(&msg);
  }

  /* drop DDEML */
  DdeFreeStringHandle(ddeInst, service);
  DdeNameService(ddeInst, NULL, NULL, DNS_UNREGISTER);
  DdeUninitialize(ddeInst);
  (void) FreeProcInstance((FARPROC) lpDdeProc);

  MSWCloseHelp();
  MSWGraphCleanup();
  MSWDLLCleanup();

  if (hListenerFont)
    DeleteObject(hListenerFont);

#ifndef WIN32
  malloc_cleanup();
#endif /* WIN32 */
  return(msg.wParam);
}

void ExitXLS(void)
{
  longjmp(exit_tag, 1);
}

static BOOL CheckSystem(void)
{
  DWORD vinfo = GetVersion();
#ifndef WIN32
  LONG flags = GetWinFlags();
  if (! flags & WF_PMODE) {
    MessageBox((HWND) NULL,
	       "XLISP-STAT must be run in protected mode.",
	       NULL,
	       MB_ICONHAND);
    return(FALSE);
  }
#else
  win32s = ((1<<15) & HIWORD(vinfo)) ? TRUE : FALSE;
  win32stsz = win32s ? WIN32S_STSZ : WIN32NT_STSZ;
#endif /* WIN32 */
  if (! ((LOBYTE(LOWORD(vinfo)) > 3) ||
         (LOBYTE(LOWORD(vinfo)) == 3 && HIBYTE(LOWORD(vinfo)) >= 10))) {
    MessageBox((HWND) NULL,
               "XLISP-STAT requires Windows 3.1 or higher",
               NULL,
               MB_ICONHAND);
    return(FALSE);
  }
  return(TRUE);
}

static BOOL InitApplication(HANDLE hInstance)
{
  WNDCLASS wc;

  /* class structure for the MDI frame window */
  wc.style = CS_HREDRAW | CS_VREDRAW;
  wc.lpfnWndProc = FrameWndProc;
  wc.cbClsExtra = 0;
  wc.cbWndExtra = 0;
  wc.hInstance = hInstance;
  wc.hIcon = LoadIcon(hInstance, "WXLSIcon");
  wc.hCursor = LoadCursor((HWND) NULL, IDC_ARROW);
  wc.hbrBackground = (HBRUSH) (COLOR_APPWORKSPACE + 1);
  wc.lpszMenuName = NULL;
  wc.lpszClassName = szFrameClass;
  if (! RegisterClass(&wc)) return(FALSE);

  /* class structure for the listener frame window */
  wc.style = CS_HREDRAW | CS_VREDRAW;
  wc.lpfnWndProc = ListenerWndProc;
  wc.cbClsExtra = 0;
  wc.cbWndExtra = 0;
  wc.hInstance = hInstance;
  wc.hIcon = LoadIcon(hInstance, "LEditIcon");
  wc.hCursor = LoadCursor((HWND) NULL, IDC_ARROW);
  wc.hbrBackground = GetStockObject(WHITE_BRUSH);
  wc.lpszMenuName = NULL;
  wc. lpszClassName = szListenerClass;
  if (! RegisterClass(&wc)) return(FALSE);

  if (! InitApplDialogs(hInstance)) return(FALSE);
  if (! InitApplGraphics(hInstance)) return(FALSE);

  return(TRUE);
}

static BOOL InitInstance(HANDLE hInstance, int nCmdShow)
{
  MDICREATESTRUCT mdicreate;
  RECT r;
  LOGFONT lf;

  hInst = hInstance;

  InitInstDialogs(hInstance);
  InitInstGraphics(hInstance);

  memset(&lf, 0, sizeof(LOGFONT));
  GetPrivateProfileString(listenerSection, "Font", "FIXEDSYS",
                          lf.lfFaceName, LF_FACESIZE, iniFile);
  lf.lfHeight = -GetPrivateProfileInt(listenerSection,
                                      "FontSize", 0, iniFile);
  hListenerFont = CreateFontIndirect(&lf);

  if (GetPrivateProfileString(xlispSection, "Libdir", "", buf, 128, iniFile)) {
    int n;
    n = strlen(buf);
    if (n > 0 && buf[n - 1] != '\\')
      strcat(buf, "\\");
    defaultpath = malloc(strlen(buf) + 1);
    strcpy(defaultpath, buf);
  }

  if (GetPrivateProfileString(xlispSection, "Workspace", "", buf, 128, iniFile)) {
    resfile = malloc(strlen(buf) + 1);
    strcpy(resfile, buf);
  }
  else if (defaultpath != NULL) {
    FILE *fp;
    if ((fp = fopen(resfile, "r")) != NULL)
      fclose(fp);
    else {
      strcpy(buf, defaultpath);
      strcat(buf, resfile);
      if ((fp = fopen(buf, "r")) != NULL) {
        fclose(fp);
        resfile = malloc(strlen(buf) + 1);
        strcpy(resfile, buf);
      }
    }
  }

  InitLEditClass(mainloop, hListenerFont);

  hAccel = LoadAccelerators(hInst, "MdiAccel");

  hMainMenu = LoadMenu(hInst, "MdiMenu");
  hWinMenu = GetSubMenu(hMainMenu, GetMenuItemCount(hMainMenu) - 1);

  /* create MDI frame for this instance */
  hWndFrame = CreateWindow(szFrameClass,
			   "XLISP-STAT",
			   WS_OVERLAPPEDWINDOW | WS_CLIPCHILDREN |
                           MDIS_ALLCHILDSTYLES,
			   CW_USEDEFAULT,
			   CW_USEDEFAULT,
			   CW_USEDEFAULT,
			   CW_USEDEFAULT,
			   (HWND) NULL,
			   hMainMenu,
			   hInstance,
			   NULL);
  if (! hWndFrame) return(FALSE);

  hWndClient = GetWindow(hWndFrame, GW_CHILD);
  if (! hWndClient) {
    DestroyWindow(hWndFrame);
    return(FALSE);
  }

  ShowWindow(hWndFrame, nCmdShow);
  UpdateWindow(hWndFrame);

  /* create the listener frame */
  GetClientRect(hWndClient, (LPRECT) &r);
  mdicreate.szClass = szListenerClass;
  mdicreate.szTitle = "Listener";
  mdicreate.hOwner = hInst;
  mdicreate.x = CW_USEDEFAULT;
  mdicreate.y = CW_USEDEFAULT;
  mdicreate.cx = r.right - r.left;
  mdicreate.cy = CW_USEDEFAULT;
  mdicreate.style = WS_MINIMIZE;
  mdicreate.lParam = NULL;
  hEditFrame = MDICreateWindow(hWndClient, &mdicreate);
  if (! hEditFrame) {
    DestroyWindow(hWndClient);
    DestroyWindow(hWndFrame);
    return(FALSE);
  }
  SetWindowStyle(hEditFrame, GetWindowStyle(hEditFrame) & ~WS_MAXIMIZEBOX);

  /* create the listener editor window pane */
  hEditWnd = CreateLEditWindow(hEditFrame, (HMENU) IDC_EDIT, hInst);
  if (! hEditWnd) {
    DestroyWindow(hEditFrame);
    DestroyWindow(hWndClient);
    DestroyWindow(hWndFrame);
    return(FALSE);
  }

  MDIRestoreWindow(hWndClient, hEditFrame);
  ShowWindow(hEditFrame, SW_SHOW);
  UpdateWindow(hEditFrame);
  SetFocus(hEditWnd);

  return(TRUE);
}

LONG CALLBACK FrameWndProc(HWND hWnd, UINT message, WPARAM wParam, LONG lParam)
{
  static HWND hWndClient;
  WNDENUMPROC lpfnEnum;
  DLGPROC lpProcAbout;
  HWND hWndChild;
  CLIENTCREATESTRUCT clientcreate;

  switch (message) {
  case WM_CREATE:
    clientcreate.hWindowMenu = hWinMenu;
    clientcreate.idFirstChild = IDM_FIRSTCHILD;
    hWndClient = CreateWindow("MDICLIENT",
			      NULL,
			      WS_CHILD | WS_CLIPCHILDREN | WS_VISIBLE,
			      0,
			      0,
			      0,
			      0,
			      hWnd,
			      (HMENU) 1,
			      hInst,
			      (LPSTR) &clientcreate);
    return(0);
  case WM_COMMAND:
    switch (GET_WM_COMMAND_ID(wParam, lParam)) {
    case IDM_ABOUT:
      sprintf(buf, "XLISP-STAT Release %d.%d.%d (%s)",
              XLS_MAJOR_RELEASE,
              XLS_MINOR_RELEASE,
              XLS_SUBMINOR_RELEASE,
#ifdef WIN32
              "Win32"
#else
              "Win16"
#endif
              );
      MessageBox(NULL, buf, "XLISP-STAT", MB_TASKMODAL);
      break;
    case IDM_CLOSE:
      hWndChild = MDIGetActiveWindow(hWndClient);
      SendMessage(hWndChild, WM_CLOSE, 0, 0);
      return(0);
    case IDM_EXIT:
      SendMessage(hWnd, WM_CLOSE, 0, 0);
      return(0);
    case IDM_TILE:
      SendMessage(hWndClient, WM_MDITILE, 0, 0);
      return(0);
    case IDM_CASCADE:
      SendMessage (hWndClient, WM_MDICASCADE, 0, 0);
      return(0);
    case IDM_ARRANGE:
      SendMessage(hWndClient, WM_MDIICONARRANGE, 0, 0);
      return(0);
    case IDM_CLOSEALL:
      lpfnEnum = (WNDENUMPROC) MakeProcInstance((FARPROC) CloseEnumProc, hInst);
      EnumChildWindows(hWndClient, lpfnEnum, 0);
      (void) FreeProcInstance((FARPROC) lpfnEnum);
      return(0);
    default:
      if (IsLispMenuItem(GET_WM_COMMAND_ID(wParam, lParam))) {
	LispMenuSelect(GET_WM_COMMAND_ID(wParam, lParam));
	return(0);
      }
      hWndChild = MDIGetActiveWindow(hWndClient);
      if (IsWindow(hWndChild))
	SendMessage(hWndChild, WM_COMMAND, wParam, lParam);
      break;
    }
    break;
  case WM_INITMENUPOPUP:
    if (IsLispMenuHandle((HMENU) wParam)) LispMenuUpdate((HMENU) wParam);
    break;
  case WM_QUERYENDSESSION:
  case WM_CLOSE:
    if (Exiting)
      break;
    if (OKorCancelBox("Do you really want to quit?") == IDCANCEL)
      return(0);
    Exiting = TRUE;
    break;
  case WM_DESTROY:
    xexit();
    //PostQuitMessage(0);
    return(0);
  }

  /* pass unprocessed messages to DefFrameProc (not DefWindowProc) */
  return(DefFrameProc(hWnd, hWndClient, message, wParam, lParam));
}

HDDEDATA CALLBACK DdeProc(UINT type, UINT fmt, HCONV hconv,
                          HSZ hsz1, HSZ hsz2, HDDEDATA hdata,
                          DWORD dw1, DWORD dw2)
#pragma argsused type fmt hconv hsz1 hsz2
{
  switch (type) {
  case XTYP_CONNECT:
    if (! DdeCmpStringHandles(topic, hsz1) &&
        ! DdeCmpStringHandles(service, hsz2))
      return (HDDEDATA) TRUE;
    else
      return (HDDEDATA) FALSE;
  case XTYP_EXECUTE:
    {
      CONTEXT cntxt;
      char *p = (char *) DdeAccessData(hdata, NULL);

      /**** check for proper topic */
      /**** check for format doesn't work -- seems to pass 0 */

      /* This code traps any non-local exit attempts -- the unwind stops */
      /* here. I think this is safe as far as XLISP is concerned; it is  */
      /* necessary for self sends to work properly.                      */
      xlbegin(&cntxt, CF_UNWIND | CF_ERROR, NIL);
      if (! setjmp(cntxt.c_jmpbuf)) {
        LVAL olddenv = xldenv;
        xldbind(s_breakenable, NIL);
        set_dde_result(hconv, readevalstream(string2stream(p)));
        xlunbind(olddenv);
      }
      xlend(&cntxt);

      DdeUnaccessData(hdata);
      return (HDDEDATA) DDE_FACK;
    }
  case XTYP_DISCONNECT:
    delete_dde_result(hconv);
    return NULL;
  case XTYP_REQUEST:
    {
      CONTEXT cntxt;
      LVAL val, stream;
      HDDEDATA result = NULL;

      /**** check for proper topic */
      DdeQueryString(ddeInst, hsz2, buf, STRMAX, CP_WINANSI);
      if (stricmp(buf, "VALUE"))
        return NULL;
      if (fmt != CF_TEXT)
        return NULL;

      /* This code traps any non-local exit attempts -- the unwind stops */
      /* here. I think this is safe as far as XLISP is concerned; it is  */
      /* necessary for self sends to work properly.                      */
      xlbegin(&cntxt, CF_UNWIND | CF_ERROR, NIL);
      if (! setjmp(cntxt.c_jmpbuf)) {
        LVAL olddenv = xldenv;
        xldbind(s_breakenable, NIL);
        val = get_dde_result(hconv);
        xlsave1(stream);
        stream = newustream();
        xlcallsubr2(xprin1, val, stream);
        stream = xlcallsubr1(xgetstroutput, stream);
        result = DdeCreateDataHandle(ddeInst,
                                     (unsigned char *) getstring(stream),
                                     getslength(stream) + 1, 0,
                                     hsz2, CF_TEXT, 0);
        xlpop();
        xlunbind(olddenv);
      }
      xlend(&cntxt);
      return result;
    }
  default:
    return NULL;
  }
}

/**** fix this up ****/
BOOL CALLBACK CloseEnumProc(HWND hWnd, LONG lParam)
#pragma argsused hWnd
{
  if (GetWindow(hWnd, GW_OWNER)) // check for icon title
    return(1);
  if (hWnd == hEditFrame)
    return(1);
  MDIRestoreWindow(GetParent(hWnd), hWnd);
  if (! SendMessage(hWnd, WM_QUERYENDSESSION, 0, 0))
    return(1);
  MDIDestroyWindow(GetParent(hWnd), hWnd);
  return(1);
}

LONG CALLBACK ListenerWndProc(HWND hWnd, UINT message, WPARAM wParam, LONG lParam)
{
  switch (message) {
  case WM_CREATE:
    return(0);
  case WM_SIZE:
    MoveWindow(hEditWnd, 0, 0, LOWORD(lParam), HIWORD(lParam), TRUE);
    if (! IsIconic(hWnd)) { // ### to avoid problems with maximizing
      DefMDIChildProc(hWnd, message, wParam, lParam);
      MDIRestoreWindow(hWndClient, hWnd);
      return(0);
    }
    break;
  case WM_SETFOCUS:
    SetFocus(hEditWnd);
    break;
  case WM_COMMAND:
    switch (GET_WM_COMMAND_ID(wParam, lParam)) {
    case IDM_UNDO:
      WarningBox("Command Not Implemented");
      break;
    case IDM_CUT:
      TTYSelToClip();
      TTYClearSel();
      break;
    case IDM_COPY:
      TTYSelToClip();
      break;
    case IDM_PASTE:
      TTYPasteFromClip();
      break;
    case IDM_CLEAR:
      TTYClearSel();
      break;
    case IDM_COPYPASTE:
      TTYSelToClip();
      TTYPasteFromClip();
      break;
    case IDC_EDIT:
      if (GET_WM_COMMAND_CMD(wParam, lParam) == EN_ERRSPACE) {
	TTYTrimBuffer();
      	xlfail("listener window out of memory");
      }
      break;
    case IDM_TOPLEVEL:
      xlsigint();
      break;
    }
    return(0);
  case WM_MDIACTIVATE:
    return(0);
  case WM_QUERYENDSESSION:
    break;
  case WM_CLOSE:
    ShowWindow(hWnd, SW_MINIMIZE);
    return(0);
  case WM_DESTROY:
    return(0);
  }
  return(DefMDIChildProc(hWnd, message, wParam, lParam));
}

static int handle_message(MSG *pmsg)
{
  if(! TranslateMDISysAccel(hWndClient, pmsg)
     && ! TranslateAccelerator(hWndFrame, hAccel, pmsg)) {
    TTYFlushOutput();
    TranslateMessage(pmsg);
    DispatchMessage(pmsg);
    if (TTYHasInput()) return TRUE;
    else return FALSE;
  }
  else return FALSE;
}

static void mainloop(void)
{
  MSG msg;

  while (1) {
    if (PeekMessage(&msg, 0, 0, 0, PM_REMOVE)) {
      if (handle_message(&msg)) break;
    }
    else {
      MSWDoIdleActions();
      MSWDoEventQueue();
    }
    if (! MSWAnyIdleActions() && ! MSWAnyEventsQueued()
        && GetMessage(&msg, 0, 0, 0)) {
      if (handle_message(&msg)) break;
    }
  }
}

void oscheck()
{
#ifdef DODO
  if (HIBIT(GetAsyncKeyState(VK_CONTROL))
      && HIBIT(GetAsyncKeyState(VK_CANCEL))) {
    FlushAllEvents();
    xlsigint();
  }
#endif /* DODO */
  MSG msg;

  if (PeekMessage(&msg, NULL, WM_KEYDOWN, WM_KEYDOWN, PM_NOREMOVE)) {
    while (PeekMessage(&msg, NULL, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE)) {
      TranslateAccelerator(hWndFrame, hAccel, &msg);
    }
  }
  if (null(getvalue(s_in_callback))) {
    while (PeekMessage(&msg, 0, 0, 0, PM_REMOVE)) {
      if(! TranslateMDISysAccel(hWndClient, &msg) &&
         ! TranslateAccelerator(hWndFrame, hAccel, &msg)) {
        TTYFlushOutput();
        TranslateMessage(&msg);
        DispatchMessage(&msg);
      }
    }
  }
}

// access string resources created by spp
char *GetStringResource(int id)
{
  static char gsr_buffer[256];

  if (LoadString(hInst, id, (LPSTR)gsr_buffer, 255) < 1) {
    SysBeep(10);
    WarningBox("LoadString Error -- bailing out.");
    xexit();
  }
  return gsr_buffer;
}

#define MAXCONV 30

static HCONV hconvs[MAXCONV] = { NULL };

static int find_conv_index(void)
{
  int i;
  for (i = 0; i < MAXCONV; i++)
    if (hconvs[i] == NULL)
      return i;
  return -1;
}

static int get_conversation_index(void)
{
  int hcd = (int) getfixnum(xlgafixnum());
  if (0 <= hcd && hcd < MAXCONV && hconvs[hcd] != NULL)
    return hcd;
  else
    return -1;
}

static void close_all_conversations(void)
{
  int i;
  for (i = 0; i < MAXCONV; i++) {
    if (hconvs[i] != NULL) {
      DdeDisconnect(hconvs[i]);
      hconvs[i] = NULL;
    }
  }
}

LVAL dde_connect(void)
{
  char *servicename, *topicname;
  HSZ service, topic;
  HCONV hconv;
  int hcd;

  servicename = getstring(xlgastring());
  topicname = moreargs() ? getstring(xlgastring()) : servicename;
  xllastarg();

  if ((hcd = find_conv_index()) < 0)
    xlfail("too many conversations in progress");

  service = DdeCreateStringHandle(ddeInst, servicename, CP_WINANSI);
  topic = DdeCreateStringHandle(ddeInst, topicname, CP_WINANSI);
  hconv = DdeConnect(ddeInst, service, topic, NULL);
  DdeFreeStringHandle(ddeInst, service);
  DdeFreeStringHandle(ddeInst, topic);

  if (hconv != NULL) {
    hconvs[hcd] = hconv;
    return cvfixnum((FIXTYPE) hcd);
  }
  else
    return NIL;
}

LVAL dde_client_transaction(void)
{
  LVAL tmp;
  char *data, *item;
  int hcd;
  UINT type;
  DWORD timeout;

  hcd = get_conversation_index();
  if (xlgetkeyarg(k_data, &tmp) && stringp(tmp))
    data = getstring(tmp);
  else
    data = NULL;
  if (xlgetkeyarg(k_type, &tmp) && tmp == k_request)
    type = XTYP_REQUEST;
  else
    type = XTYP_EXECUTE;
  if (xlgetkeyarg(k_item, &tmp) && stringp(tmp))
    item = getstring(tmp);
  else
    item = NULL;
  if (xlgetkeyarg(k_timeout, &tmp) && fixp(tmp) && getfixnum(tmp) > 0)
    timeout = getfixnum(tmp);
  else
    timeout = 60000L;
  xllastkey();

  if (hcd >= 0) {
    switch (type) {
    case XTYP_EXECUTE:
      if (data == NULL)
        return NIL;
      else if (DdeClientTransaction((LPVOID) data, strlen(data) + 1,
                                    hconvs[hcd], NULL, CF_TEXT, type,
                                    timeout, NULL))
        return s_true;
      else
        return NIL;
    case XTYP_REQUEST:
      {
        CONTEXT cntxt,*target;
        int mask,sts;
        LVAL val;
        HSZ hsz;
        HDDEDATA hdata;

        if (item != NULL)
          hsz = DdeCreateStringHandle(ddeInst, item, CP_WINANSI);
        else
          hsz = NULL;
        xlbegin(&cntxt,CF_UNWIND,NIL);
        if ((sts = setjmp(cntxt.c_jmpbuf)) != 0) {
          target = xltarget;
          mask = xlmask;
          val = xlvalue;
        }
        else {
          if ((hdata = DdeClientTransaction(NULL, 0, hconvs[hcd], hsz, CF_TEXT,
                                            type, timeout, NULL)) != NULL)
            val = cvstring((char *) DdeAccessData(hdata, NULL));
          else
            val = NIL;
        }
        xlend(&cntxt);

        if (hsz != NULL)
          DdeFreeStringHandle(ddeInst, hsz);
        if (hdata != NULL)
          DdeUnaccessData(hdata);

        /* if unwinding, continue unwinding */
        if (sts)
	  xljump(target,mask,val);

        return val;
      }
    /**** add POKE? */
    /**** allow for asynchronous transactions? */
    default:
      return NIL;
    }
  }
  else return NIL;
}

LVAL dde_disconnect(void)
{
  int hcd;
  if (moreargs()) {
    hcd = get_conversation_index();
    if (hcd >= 0) {
      DdeDisconnect(hconvs[hcd]);
      hconvs[hcd] = NULL;
      return s_true;
    }
    else
      return NIL;
  }
  else {
    LVAL val = NIL;
    for (hcd = 0; hcd < MAXCONV; hcd++) {
      if (hconvs[hcd] != NULL) {
        DdeDisconnect(hconvs[hcd]);
        hconvs[hcd] = NULL;
        val = s_true;
      }
    }
    return val;
  }
}

static void set_dde_result(HCONV hconv, LVAL val)
{
  LVAL s_dde_values = xlintern("*DDE-VALUES*", xlisppack);
  LVAL tmp1, tmp2, list;

  xlstkcheck(2);
  xlsave(tmp1);
  xlsave(tmp2);
  tmp1 = cvfixnum((FIXTYPE) hconv);
  list = boundp(s_dde_values) ? getvalue(s_dde_values) : NIL;
  tmp2 = xlcallsubr2(xassoc, tmp1, list);
  if (null(tmp2)) {
    tmp2 = consa(tmp1);
    setvalue(s_dde_values, cons(tmp2, list));
  }
  rplacd(tmp2, val);
  xlpopn(2);
}

static LVAL get_dde_result(HCONV hconv)
{
  LVAL s_dde_values = xlintern("*DDE-VALUES*", xlisppack);
  LVAL list, pair;
  list = boundp(s_dde_values) ? getvalue(s_dde_values) : NIL;
  pair = xlcallsubr2(xassoc, cvfixnum((FIXTYPE) hconv), list);
  return consp(pair) ? cdr(pair) : NIL;
}
static void delete_dde_result(HCONV hconv)
{
  LVAL s_dde_values = xlintern("*DDE-VALUES*", xlisppack);
  LVAL list, pair, tmp;

  tmp = cvfixnum((FIXTYPE) hconv);
  list = boundp(s_dde_values) ? getvalue(s_dde_values) : NIL;
  pair = xlcallsubr2(xassoc, tmp, list);
  setvalue(s_dde_values, xlcallsubr2(xdelete, pair, list));
}

#define stringornil(x) (stringp(x) || null(x))
#define xlgastringornil() (testarg(typearg(stringornil)))

LVAL msw_get_profile_string()
{
  char *section, *item, *file;
  LVAL arg;

  section = getstring(xlgastring());
  item = getstring(xlgastring());
  file = ! null(arg = xlgastringornil()) ? getstring(arg) : NULL;
  xllastarg();

  if (file == NULL) {
    if (GetProfileString(section, item, "", buf, STRMAX))
      return cvstring(buf);
    else
      return NIL;
  }
  else {
    if (GetPrivateProfileString(section, item, "", buf, STRMAX, file))
      return cvstring(buf);
    else
      return NIL;
  }
}

LVAL msw_write_profile_string()
{
  char *section, *item, *value, *file;
  LVAL arg;

  section = ! null(arg = xlgastringornil()) ? getstring(arg) : NULL;
  item = ! null(arg = xlgastringornil()) ? getstring(arg) : NULL;
  value = ! null(arg = xlgastringornil()) ? getstring(arg) : NULL;
  file = ! null(arg = xlgastringornil()) ? getstring(arg) : NULL;
  xllastarg();

  if (file == NULL) {
    if (WriteProfileString(section, item, value))
      return s_true;
    else
      return NIL;
  }
  else {
    if (WritePrivateProfileString(section, item, value, file))
      return s_true;
    else
      return NIL;
  }
}