/*  Part of SWI-Prolog

    Author:        Jan Wielemaker
    E-mail:        J.Wielemaker@vu.nl
    WWW:           http://www.swi-prolog.org
    Copyright (c)  2017-2025, VU University Amsterdam
			      CWI, Amsterdam
			      SWI-Prolog Solutions b.v.
    All rights reserved.

    Redistribution and use in source and binary forms, with or without
    modification, are permitted provided that the following conditions
    are met:

    1. Redistributions of source code must retain the above copyright
       notice, this list of conditions and the following disclaimer.

    2. Redistributions in binary form must reproduce the above copyright
       notice, this list of conditions and the following disclaimer in
       the documentation and/or other materials provided with the
       distribution.

    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
    POSSIBILITY OF SUCH DAMAGE.
*/

#define SWIPL_WINDOWS_NATIVE_ACCESS 1 /* get Swinhandle() */
#include <string.h>
#include <stdlib.h>
#include <SWI-Stream.h>
#include <SWI-Prolog.h>
#include <config.h>
#include <signal.h>
#include <assert.h>
#include <histedit.h>
#include <errno.h>
#include <limits.h>

#if defined(HAVE_POLL_H) && defined(HAVE_POLL)
#include <poll.h>
#elif defined(HAVE_SYS_SELECT_H)
#include <sys/select.h>
#endif
#ifdef HAVE_UNISTD_H
#include <unistd.h>
#endif
#ifdef HAVE_UXNT_H
#include <uxnt.h>
#endif
#ifdef HAVE_FCNTL_H
#include <fcntl.h>
#endif
#ifdef HAVE_SYS_IOCTL_H
#include <sys/ioctl.h>
#endif
#ifdef __WINDOWS__
#include <io.h>
#endif

#ifndef EPILOG
#define EPILOG 0x400		/* Windows: Epilog using pipes */
#endif

static atom_t ATOM_norm;
static atom_t ATOM_newline;
static atom_t ATOM_eof;
static atom_t ATOM_arghack;
static atom_t ATOM_refresh;
static atom_t ATOM_refresh_beep;
static atom_t ATOM_cursor;
static atom_t ATOM_redisplay;
static atom_t ATOM_error;
static atom_t ATOM_fatal;
static atom_t ATOM_clear;
static atom_t ATOM_setsize;
static atom_t ATOM_getsize;
static atom_t ATOM_setunique;
static atom_t ATOM_set;
static atom_t ATOM_prev_str;
static atom_t ATOM_next_str;
static atom_t ATOM_event;
static atom_t ATOM_wordchars;

static functor_t FUNCTOR_error2;
static functor_t FUNCTOR_editline1;
static functor_t FUNCTOR_line2;
static functor_t FUNCTOR_electric3;
static functor_t FUNCTOR_pair2;

#ifdef __WINDOWS__
#define REP_EL REP_UTF8
#else
#define REP_EL REP_MB
#endif

#ifdef _MSC_VER
#define strdup(s) _strdup(s)
#endif

#define STR_OPTIONS (CVT_ATOM|CVT_STRING|CVT_LIST|REP_EL|CVT_EXCEPTION)

		 /*******************************
		 *           WIN/UNIX           *
		 *******************************/

#ifdef __WINDOWS__

typedef HANDLE os_handle;
#define Soshandle(s) Swinhandle(s)
#define OSNOHANDLE NULL
#define isatty(fd) isconsole(fd)
static bool
isconsole(HANDLE h)
{ DWORD mode;
  return GetConsoleMode(h, &mode);
}
#undef EL_GETFP			/* avoid accidental use */

#else/*__WINDOWS__*/

typedef int os_handle;
#define OSNOHANDLE (-1)
#define Soshandle(s) Sfileno(s)

#endif/*__WINDOWS__*/

		 /*******************************
		 *	      CONTEXT		*
		 *******************************/

typedef struct command
{ struct command       *next;
  atom_t		name;		/* name of the command */
  record_t		closure;	/* called goal */
  module_t		module;		/* target module */
} command;

typedef struct binding
{ struct binding       *next;
  int			ch;
  command	       *command;
} binding;


typedef enum electric_state
{ E_NONE = 0,				/* idle state */
  E_WAIT,				/* Wait for timeout */
  E_COMMAND				/* get second char */
} electric_state;

#define EL_CTX_MAGIC 1329760607

typedef struct el_context
{ struct el_context    *next;		/* Next in list */
  int			magic;		/* EL_CTX_MAGIC */
  os_handle		fd;		/* Input file we are attached to */
  IOSTREAM	       *istream;	/* Input stream */
  IOSTREAM	       *ostream;	/* Output stream */
  IOSTREAM	       *estream;	/* Error stream */
  EditLine	       *el;		/* EditLine context */
  char *		buffered;	/* Buffered long line */
  int			sig_no;		/* For read_char() */
  HistEvent		ev;		/* History event */
  History	       *history;	/* Complete history */
  char		       *prompt;		/* Current prompt */
  IOFUNCTIONS	       *orig_functions;	/* Original functions */
  IOFUNCTIONS		functions;	/* SIO function block */
  command	       *commands;	/* User commands */
  binding	       *bindings;	/* Bindings to user commands */
  int			reader;		/* Current reader thread */
  bool			is_stdin;	/* Reading from file 0 */
  short			dispatching;	/* We are dispatching an event */
  unsigned int		flags;		/* Misc flags */
  int			histsize;	/* History size */
  struct
  { int timeout;			/* Time to wait */
    int move;				/* Amount to move */
    electric_state state;
  } electric;
#ifndef HAVE_EL_CURSOR
  int			move_cursor;	/* Amount to move the cursor */
#endif
} el_context;

static el_context *el_clist = NULL;

static el_context *
get_context(os_handle fd)
{ el_context *c;

  for(c=el_clist; c; c=c->next)
  { if ( c->fd == fd )
      return c;
  }

  return NULL;
}

#ifdef O_SIGNALS
static el_context *
get_std_context(void)
{ el_context *c;

  for(c=el_clist; c; c=c->next)
  { if ( c->is_stdin )
      return c;
  }

  return NULL;
}
#endif

static el_context *
get_context_from_handle(void *handle)
{ el_context *c;

  for(c=el_clist; c; c=c->next)
  { IOSTREAM *s;

    if ( (s=c->istream) && s->handle == handle )
      return c;
  }

  return NULL;
}

static el_context *
get_context_from_ohandle(void *handle)
{ el_context *c;

  for(c=el_clist; c; c=c->next)
  { IOSTREAM *s;

    if ( (s=c->ostream) && s->handle == handle )
      return c;
    if ( (s=c->estream) && s->handle == handle )
      return c;
  }

  return NULL;
}

static el_context *
alloc_context(os_handle fd)
{ el_context *c = PL_malloc(sizeof(*c));

  memset(c, 0, sizeof(*c));
  c->fd    = fd;
  c->magic = EL_CTX_MAGIC;
  c->next  = el_clist;
  el_clist = c;

  return c;
}


static void
update_prompt(el_context *ctx)
{ char *np = PL_prompt_string(ctx->istream);

  if ( ctx->prompt && np && strcmp(np, ctx->prompt) == 0 )
    return;
  if ( ctx->prompt )
    free(ctx->prompt);
  ctx->prompt = np ? strdup(np) : NULL;
}


static bool
el_error(const char *msg)
{ term_t ex;

  return ( (ex=PL_new_term_ref()) &&
	   PL_unify_term(ex, PL_FUNCTOR, FUNCTOR_error2,
			       PL_FUNCTOR, FUNCTOR_editline1,
				 PL_STRING, msg,
			       PL_VARIABLE) &&
	   PL_raise_exception(ex) );
}

		 /*******************************
		 *		PORT		*
		 *******************************/

#ifndef HAVE_EL_CURSOR
#define el_cursor(el, cnt) el_cursor_emulated(el, cnt)

static int
el_cursor_emulated(EditLine *el, int count)
{ el_context *ctx;
  const LineInfo *li;

  el_get(el, EL_CLIENTDATA, (void**)&ctx);
  li = el_line(ctx->el);

  if ( count < 0 )			/* backward */
  { if ( -count > li->cursor - li->buffer )
      count = li->buffer - li->cursor;
  } else
  { if ( count > li->lastchar - li->cursor )
      count = li->lastchar - li->cursor;
  }

  ctx->move_cursor = count;

  return li->cursor - li->buffer + count;
}
#endif


		 /*******************************
		 *	  SIGNAL HANDLING	*
		 *******************************/

#ifdef O_SIGNALS

/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Signal handling.   The original design  sets up and tears  down signal
handlers  while   inside  libedit's  main  function   el_gets().   See
el_siggets() in this file.  Signal handling is only setup for the main
thread, i.e., for `swipl`.

We must ensure Epilog windows  handle resizing properly.  On an Epilog
window resize, Epilog  updates the size in the PTY  and sends SIGWINCH
to the Prolog client thread using pthread_kill().  We must ensure that
SIGWINCH is always handled.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

typedef struct
{ int			signo;		/* number of the signal */
  bool			prepared;	/* Is currently prepared */
  struct sigaction	old_state;	/* old state for the signal */
} sigstate;

static void el_sighandler(int sig);

/* Signals that should always be handled by this library */
static sigstate always_signals[] =
{ { SIGWINCH },
  { -1 }
};
static bool always_signals_prepared = false;

/* Signals handled while we are inside el_gets().
 * el_signals[0] is SWI-Prolog's _alert_ signal, i.e., the signal
 * used to make blocking system calls return using EINTR such that
 * we can process synchronous Prolog signals.
 */
static sigstate el_signals[] =
{ { SIGUSR2 },			/* See above.  Must be first */
  { SIGINT },
#ifdef SIGTSTP
  { SIGTSTP },
  { SIGCONT },
  { SIGTTOU },
  { SIGTTIN },
#endif
  { SIGALRM },
  { SIGTERM },
  { SIGQUIT },
  { -1 }
};

/* Signals after we were stopped by SIGTSTP */
static sigstate cont_signals[] =
{
#ifdef SIGCONT
  { SIGCONT },
#endif
  { -1 }
};


static void
prepare_signals(sigstate *s)
{ for(; s->signo != -1; s++)
  { if ( !s->prepared )
    { struct sigaction new;

      memset(&new, 0, sizeof(new));
      new.sa_handler = el_sighandler;
      sigaction(s->signo, &new, &s->old_state);
      s->prepared = true;
    }
  }
}


static void
restore_signals(sigstate *s)
{ for(; s->signo != -1; s++)
  { sigaction(s->signo, &s->old_state, NULL);
    s->prepared = false;
  }
}


/** Our signal handler.  Deals with
 *
 *  - SIGWINCH
 *    Just causes read() to return.
 *  - SIGTSTP/SIGCONT
 *    Restores terminal around ^Z/fg
 *  - SIGINT
 *    Clears accumulated line
 *  - SWI-Prolog alert signal
 *    Just causes a return.  This implies the synchronous
 *    interrupt handler is executed while editline is enabled,
 *    but there is little we can do about that.  Possibly we
 *    need a hook in Prolog to save/restore the terminal during
 *    the actual synchronous signal handling?
 *  - Other signals
 *    Restores terminal while calling the default handler.
 */

static void
el_sighandler(int sig)
{ sigstate *s;
  el_context *ctx;

  for(ctx=el_clist; ctx; ctx=ctx->next)
    ctx->sig_no = sig;

  switch(sig)
  { case SIGWINCH:
      return;
    case SIGCONT:
      if ( (ctx = get_std_context()) )
	el_set(ctx->el, EL_PREP_TERM, 1);
      restore_signals(cont_signals);
      prepare_signals(el_signals);
      return;
    case SIGTSTP:
      restore_signals(el_signals);
      prepare_signals(cont_signals);
      if ( (ctx = get_std_context()) )
	el_set(ctx->el, EL_PREP_TERM, 0);
      kill(getpid(), sig);
      return;
    case SIGINT:
    { if ( (ctx = get_std_context()) )
      { FILE *err;
	int size = el_cursor(ctx->el, 10000);

	el_deletestr(ctx->el, size);
	el_get(ctx->el, EL_GETFP, 2, &err);
	fprintf(err, "^C\n");
      }
    }
    default:
      /* The Prolog alert signal */
      if ( sig == el_signals[0].signo )
	return;
  }

  restore_signals(el_signals);
  if ( (ctx = get_std_context()) )
    el_set(ctx->el, EL_PREP_TERM, 0);

  for(s=el_signals; s->signo != -1; s++)
  { if ( s->signo == sig )
    { void (*func)(int) = s->old_state.sa_handler;

      if ( func == SIG_DFL )
      { PL_raise(sig);			/* was: kill(getpid(), sig); */
      } else if ( func != SIG_IGN )
      { (*func)(sig);
      }

      break;
    }
  }

  if ( (ctx = get_std_context()) )
    el_set(ctx->el, EL_PREP_TERM, 1);
  prepare_signals(el_signals);
}


static const char *
el_siggets(EditLine *el, int *count)
{ el_context *ctx;
  const char *line;

  el_get(el, EL_CLIENTDATA, (void**)&ctx);
  if ( ctx->is_stdin )
  { prepare_signals(el_signals);
    line = el_gets(el, count);
    restore_signals(el_signals);
  } else
  { line = el_gets(el, count);
  }

  return line;
}

static void
update_always_signals(void)
{ if ( el_clist && !always_signals_prepared )
  { prepare_signals(always_signals);
    always_signals_prepared = true;
  } else if ( !el_clist && always_signals_prepared )
  { restore_signals(always_signals);
    always_signals_prepared = false;
  }
}

#else /* O_SIGNALS */

#define el_siggets(el, count) el_gets(el, count)
#define update_always_signals() (void)0
#define SIGWINCH 1

#endif /* O_SIGNALS */

		 /*******************************
		 *     ELECTRIC CARET SUPPORT	*
		 *******************************/

static unsigned char
electric_end(EditLine *el, int ch)
{ el_context *ctx;

  el_get(el, EL_CLIENTDATA, (void**)&ctx);
  el_cursor(el, ctx->electric.move);
  ctx->electric.move = 0;
  return CC_CURSOR;
}

static void
electric_init(EditLine *el)
{ el_set(el, EL_ADDFN, "electric-end", "Restore electric caret", electric_end);
  el_set(el, EL_BIND,  "^[^A", "electric-end", NULL);
}


		 /*******************************
		 *	  LOW-LEVEL READ	*
		 *******************************/

#ifdef __WINDOWS__
#define MAX_PEEK 64

static bool
has_interesting_event(HANDLE hIn)
{ INPUT_RECORD buffer[MAX_PEEK];
  DWORD done;
  BOOL rc = PeekConsoleInput(hIn, buffer, MAX_PEEK, &done);
  if ( rc )
  { for(DWORD i=0; i<done; i++)
    { INPUT_RECORD *ev = &buffer[i];
      switch(ev->EventType)
      { case KEY_EVENT:
	  if ( ev->Event.KeyEvent.bKeyDown )
	    return true;
	  break;
	case WINDOW_BUFFER_SIZE_EVENT:
	  return true;
	default:
	  (void)0;
      }
    }
    return false;
  }

  return true;			/* error, so wakeup */
}

static bool
win_wait_for_key_down(HANDLE hIn, int timeout)
{ ULONGLONG start = GetTickCount64();
  for(;;)
  { int wait = timeout - (int)(GetTickCount64()-start);
    if ( wait > 0 )
    { DWORD rc = WaitForSingleObject(hIn, wait);
      if ( rc == WAIT_OBJECT_0 )
      { if ( has_interesting_event(hIn) )
	{ return true;
	} else
	{ FlushConsoleInputBuffer(hIn);
	  continue;
	}
      }
    }
    return false;
  }
}
#endif/*__WINDOWS__*/


static bool				  /* true if there is input */
wait_for_input(EditLine *el, int timeout) /* milliseconds */
{
#ifdef __WINDOWS__
  HANDLE hIn;
  el_get(el, EL_GETHANDLE, 0, &hIn);
  return win_wait_for_key_down(hIn, timeout);
#else/*__WINDOWS__*/
  FILE *in;
  el_get(el, EL_GETFP, 0, &in);
  int fd = fileno(in);

#ifdef HAVE_POLL
  struct pollfd fds[1];

  fds[0].fd = fd;
  fds[0].events = POLLIN;

  return poll(fds, 1, timeout) != 0;
#else
  fd_set rfds;
  struct timeval tv;

#if defined(FD_SETSIZE) && !defined(__WINDOWS__)
  if ( fd >= FD_SETSIZE )
  { Sdprintf("input_on_fd(%d) > FD_SETSIZE\n", fd);
    return 1;
  }
#endif

  FD_ZERO(&rfds);
  FD_SET(fd, &rfds);
  tv.tv_sec = 0;
  tv.tv_usec = timeout*1000;

  return select(fd+1, &rfds, NULL, NULL, &tv) != 0;
#endif
#endif /*__WINDOWS__*/
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Copied from read.c from the NetBSD sources  for libedit. We need to redo
this to deal with our signal handling  and to include event dispatching.
We could have done this without copying if we could get a pointer to the
default  read  function,   but   el_get()    using   EL_GETCFN   returns
EL_BUILTIN_GETCFN, which is simple defined as NULL.

 *-
 * Copyright (c) 1992, 1993
 *	The Regents of the University of California.  All rights reserved.
 *
 * This code is derived from software contributed to Berkeley by
 * Christos Zoulas of Cornell University.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 * 3. Neither the name of the University nor the names of its contributors
 *    may be used to endorse or promote products derived from this software
 *    without specific prior written permission.
 *
 * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

#ifndef __WINDOWS__
static int
read__fixio(int fd, int e)
{ (void)fd;

  switch (e)
  { case -1:		/* Make sure that the code is reachable */
#ifdef EWOULDBLOCK
    case EWOULDBLOCK:
#ifndef TRY_AGAIN
#define TRY_AGAIN
#endif
#endif /* EWOULDBLOCK */

#if defined(POSIX) && defined(EAGAIN)
#if defined(EWOULDBLOCK) && EWOULDBLOCK != EAGAIN
    case EAGAIN:
#ifndef TRY_AGAIN
#define TRY_AGAIN
#endif
#endif /* EWOULDBLOCK && EWOULDBLOCK != EAGAIN */
#endif /* POSIX && EAGAIN */

      e = 0;
#ifdef TRY_AGAIN
#if defined(F_SETFL) && defined(O_NDELAY)
      if ( (e = fcntl(fd, F_GETFL, 0) ) == -1)
	return -1;

      if (fcntl(fd, F_SETFL, e & ~O_NDELAY) == -1)
	return -1;
      else
	e = 1;
#endif /* F_SETFL && O_NDELAY */

#ifdef FIONBIO
    { int zero = 0;

      if (ioctl(fd, FIONBIO, &zero) == -1)
	return -1;
      else
	e = 1;
    }
#endif /* FIONBIO */

#endif /* TRY_AGAIN */
      return e ? 0 : -1;

    case EINTR:
      return 0;

    default:
      return -1;
  }
}

static ssize_t
do_read(el_context *ctx, int fd, char *buf, size_t size)
{ ssize_t rc;
  int oreader = ctx->reader;

  ctx->reader = PL_thread_self();
  rc = read(fd, buf, size);
  ctx->reader = oreader;

  return rc;
}
#endif/*__WINDOWS__*/


static void
refresh(el_context *ctx)
{
#if __WINDOWS__
  HANDLE hErr;
  el_get(ctx->el, EL_GETHANDLE, 2, &hErr);
  el_resize(ctx->el);
  if ( (ctx->flags&EPILOG) )
  { WriteFile(hErr, "\r", 1, NULL, NULL);
  } else
  { const wchar_t *nl = L"\r";
    WriteConsoleW(hErr, nl, (DWORD)wcslen(nl), NULL, NULL);
  }
#else
  FILE *err;

  el_get(ctx->el, EL_GETFP, 2, &err);
  el_resize(ctx->el);
  fprintf(err, "\r");
#endif
  el_set(ctx->el, EL_REFRESH);
}


#ifdef HAVE_EL_WSET
#define el_char_t wchar_t
#else
#define el_char_t unsigned char
#endif

static ssize_t
electric_cursor_read_char(el_context *ctx, el_char_t *cp)
{
#ifndef HAVE_EL_CURSOR
  if ( ctx->move_cursor )
  { if ( ctx->move_cursor > 0 )
    { *cp = (el_char_t)('F'-'@');
      ctx->move_cursor--;
    } else
    { *cp = (el_char_t)('B'-'@');
      ctx->move_cursor++;
    }
    return 1;
  }
#endif

  if ( ctx->electric.move )
  { switch(ctx->electric.state)
    { case E_WAIT:				/* "^[" */
	ctx->electric.state = E_COMMAND;
	wait_for_input(ctx->el, ctx->electric.timeout);
	*cp = (el_char_t)27;			/* ESC */
	return 1;
      case E_COMMAND:
	ctx->electric.state = E_NONE;
	*cp = (el_char_t)'\1';			/* "^A" */
	return 1;
      case E_NONE:
	break;
    }
  }
  return 0;
}

/* from SWI-Prolog src/os/pl-utf8.h */
#define ISUTF8_CB(c)  (((c)&0xc0) == 0x80) /* Is continuation byte */
#define ISUTF8_FB2(c) (((c)&0xe0) == 0xc0)
#define ISUTF8_FB3(c) (((c)&0xf0) == 0xe0)
#define ISUTF8_FB4(c) (((c)&0xf8) == 0xf0)
#define ISUTF8_FB5(c) (((c)&0xfc) == 0xf8)
#define ISUTF8_FB6(c) (((c)&0xfe) == 0xfc)

#define UTF8_FBN(c) (!(c&0x80)     ? 0 : \
		     ISUTF8_FB2(c) ? 1 : \
		     ISUTF8_FB3(c) ? 2 : \
		     ISUTF8_FB4(c) ? 3 : \
		     ISUTF8_FB5(c) ? 4 : \
		     ISUTF8_FB6(c) ? 5 : -1)

static int
utf8_code_point(const char **i, const char *e, int *cp)
{ unsigned char c = (unsigned char)**i;
  int code;
  int n;

  ++(*i);
  *cp = c;
  if ( c < 0x80 )
    return 1;
  if ( c < 0xc0 )
    return -1;

  if ( c < 0xe0)
  { code = c & 0x1f;
    n = 1;
  } else if ( c < 0xf0 )
  { code = c & 0x0f;
    n = 2;
  } else if ( c < 0xf8 )
  { code = c & 0x07;
    n = 3;
  } else if ( c < 0xfc )
  { code = c & 0x03;
    n = 4;
  } else if (c < 0xfe)
  { code = c & 0x01;
    n = 5;
  } else
  { return -1;
  }

  for (int k = 0; k < n; ++k)
  { if ( *i + k == e )
      return -1;

    c = (*i)[k];
    if ( c < 0x80 || c >= 0xc0 )
      return -1;

    code = (code << 6) | (c & 0x3f);
  }

  *i += n;
  *cp = code;

  return n + 1;
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
Deprecated old API for decoding UTF-8 strings.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

char *
utf8_get_char(const char *in, int *chr)
{ const char *i = in;

  utf8_code_point(&i, NULL, chr);

  return (char*)i;
}


#ifdef __WINDOWS__
#define PIPE_READ_EOF               0   // End of file
#define PIPE_READ_ERROR            -1   // Error occurred
#define PIPE_READ_PROLOG_EXCEPTION -2	// Prolog exception

static ssize_t
pipe_read_or_msg(HANDLE hPipe, void *buf, size_t len)
{ OVERLAPPED ov = {0};
  ov.hEvent = CreateEvent(NULL, TRUE, FALSE, NULL);
  if (!ov.hEvent)
    return PIPE_READ_ERROR;

  DWORD bytesRead = 0;
  BOOL ok = ReadFile(hPipe, buf, (DWORD)len, &bytesRead, &ov);

  if ( !ok )
  { DWORD err = GetLastError();

    if ( err == ERROR_IO_PENDING )
    { // Wait for pipe read OR Windows message
      for (;;)
      { DWORD res = MsgWaitForMultipleObjectsEx(
			1, &ov.hEvent, INFINITE, QS_POSTMESSAGE, MWMO_INPUTAVAILABLE);

	if ( res == WAIT_OBJECT_0 )
	{ // Read completed
	  if ( GetOverlappedResult(hPipe, &ov, &bytesRead, FALSE) )
	  { CloseHandle(ov.hEvent);
	    return (ssize_t)bytesRead;
	  } else
	  { DWORD e = GetLastError();
	    CloseHandle(ov.hEvent);
	    return (e == ERROR_BROKEN_PIPE) ? PIPE_READ_EOF : PIPE_READ_ERROR;
	  }
	} else if (res == WAIT_OBJECT_0 + 1)
	{ // Message in queue
	  MSG msg;
	  while (PeekMessage(&msg, NULL, 0, 0, PM_REMOVE))
	  { if (msg.message == WM_QUIT)
	    { CloseHandle(ov.hEvent);
	      return PIPE_READ_EOF;
	    }
	    TranslateMessage(&msg);
	    DispatchMessage(&msg);
	  }
	  if ( PL_handle_signals() < 0 )
	  { CloseHandle(ov.hEvent);
	    return PIPE_READ_PROLOG_EXCEPTION;
	  }
	} else
	{ CloseHandle(ov.hEvent);
	  return PIPE_READ_ERROR;
	}
      }
    } else if ( err == ERROR_BROKEN_PIPE )
    { CloseHandle(ov.hEvent);
      return PIPE_READ_EOF;
    } else if ( err == ERROR_INVALID_PARAMETER )
    { Sdprintf("Input pipe did not enable FILE_FLAG_OVERLAPPED?\n");
      CloseHandle(ov.hEvent);
      return PIPE_READ_ERROR;
    } else
    { CloseHandle(ov.hEvent);
      return PIPE_READ_ERROR;
    }
  }

  // Immediate completion (no pending I/O)
  CloseHandle(ov.hEvent);
  return (ssize_t)bytesRead;
}

#endif/* __WINDOWS__ */

static int
read_char(EditLine *el, el_char_t *cp)
{ el_context *ctx;
  ssize_t num_read;
#ifndef __WINDOWS__
  bool tried = false;
  char cbuf[MB_LEN_MAX];
  size_t cbp = 0;
  int save_errno = errno;
#endif

  el_get(el, EL_CLIENTDATA, (void**)&ctx);	/* What to do if we have no context? */
  if ( (num_read=electric_cursor_read_char(ctx, cp)) > 0 )
    return (int)num_read;

 again:
  if ( !(ctx->flags&EPILOG) )	/* Epilog event dispatching is from the console thread */
  { ctx->dispatching++;
    bool rc = PL_dispatch(ctx->istream, PL_DISPATCH_WAIT);
    ctx->dispatching--;

    if ( !rc )
    { Sset_exception(ctx->istream, PL_exception(0));
      *cp = (el_char_t)'\0';
      return -1;
    }
  }

  if ( ctx->sig_no == SIGWINCH )
  { // fprintf(stderr, "Refreshing\n");
    refresh(ctx);
    ctx->sig_no = 0;
  }

#ifdef __WINDOWS__
  HANDLE hIn;

  el_get(el, EL_GETHANDLE, 0, &hIn);
  if ( ctx->flags & EPILOG )	/* hIn is a Windows pipe */
  { char buffer[10];
    size_t start = 0;
    ssize_t bytes;

    ctx->dispatching++;
    bytes = pipe_read_or_msg(hIn, &buffer[start], 1);
    ctx->dispatching--;
    if ( bytes == 0 )
    { *cp = 0;		/* end of file */
      return 0;
    } else if ( bytes > 0 )
    { ssize_t more = UTF8_FBN(buffer[0]);
      if ( more == 0 )
      { *cp = buffer[0]&0xff;
	return 1;
      } else
      { start++;
	while( more > 0 )
	{ ctx->dispatching++;
	  bytes = pipe_read_or_msg(hIn, &buffer[start], more);
	  ctx->dispatching--;
	  if ( bytes > 0 )
	  { more -= bytes;
	    start += bytes;
	  } else
	  { if ( bytes == PIPE_READ_PROLOG_EXCEPTION )
	      Sset_exception(ctx->istream, PL_exception(0));
	    *cp = (el_char_t)'\0';
	    return -1;
	  }
	}
	int chr;
	utf8_get_char(buffer, &chr);
	*cp = chr;
	return 1;
      }
    } else
    { if ( bytes == PIPE_READ_PROLOG_EXCEPTION )
	Sset_exception(ctx->istream, PL_exception(0));
      *cp = (el_char_t)'\0';
      return -1;		/* read error */
    }
  } else
  { INPUT_RECORD ev;
    DWORD done;

    BOOL rc = ReadConsoleInput(hIn, &ev, 1, &done);
    if ( rc )
    { if ( done == 1 )
      { switch(ev.EventType)
	{ case KEY_EVENT:
	  { if ( ev.Event.KeyEvent.bKeyDown )
	    { *cp = ev.Event.KeyEvent.uChar.UnicodeChar;
	      return 1;
	    }
	    break;
	  }
	  case WINDOW_BUFFER_SIZE_EVENT:
	  { //int cols = ev.Event.WindowBufferSizeEvent.dwSize.X;
	    //int rows = ev.Event.WindowBufferSizeEvent.dwSize.Y;
	    refresh(ctx);
	    break;
	  }
	  case MOUSE_EVENT:
	  default:
	    (void)0;
	}
      }
      goto again;
    } else
    { return -1;		/* set errno? */
    }
  }
#else/*__WINDOWS__*/
  FILE *in;
  el_get(el, EL_GETFP, 0, &in);
  while ( (num_read = do_read(ctx, fileno(in), cbuf + cbp, (size_t)1)) == -1 )
  { int e = errno;

    switch (ctx->sig_no)
    { case SIGCONT:
	el_set(el, EL_REFRESH);
	goto again;
      case SIGWINCH:
	goto again;
      default:
	break;
    }
    ctx->dispatching++;
    int rc = PL_handle_signals();
    ctx->dispatching--;
    if ( rc < 0 )
    { Sset_exception(ctx->istream, PL_exception(0));
      *cp = (el_char_t)'\0';
      return -1;
    }
    if ( e == EINTR )
      continue;

    if ( !tried && read__fixio(fileno(in), e) == 0 )
    { errno = save_errno;
      tried = true;
    } else
    { errno = e;
      *cp = (el_char_t)'\0';
      return -1;
    }
  }

  if ( ctx->sig_no == SIGWINCH )
    refresh(ctx);

  /* Test for EOF */
  if ( num_read == 0 )
  { *cp = (el_char_t)'\0';
    return 0;
  }

#ifdef HAVE_EL_WSET
  for (;;)
  { mbstate_t mbs;

    ++cbp;
    /* This only works because UTF8 is stateless. */
    memset(&mbs, 0, sizeof(mbs));
    switch (mbrtowc(cp, cbuf, cbp, &mbs))
    { case (size_t)-1:
	if (cbp > 1)
	{ /*
	   * Invalid sequence, discard all bytes
	   * except the last one.
	   */
	  cbuf[0] = cbuf[cbp - 1];
	  cbp = 0;
	  break;
	} else
	{ /* Invalid byte, discard it. */
	  cbp = 0;
	  goto again;
	}
      case (size_t)-2:
	/*
	 * We don't support other multibyte charsets.
	 * The second condition shouldn't happen
	 * and is here merely for additional safety.
	 */
	 if ( /*(el->el_flags & CHARSET_IS_UTF8 ) == 0 || We don't have that */
	      cbp >= MB_LEN_MAX) {
	   errno = EILSEQ;
	   *cp = (el_char_t)'\0';
	   return -1;
	 }
	 /* Incomplete sequence, read another byte. */
	 goto again;
       default:
	 /* Valid character, process it. */
	 return 1;
    }
  }
#else/*HAVE_EL_WSET*/
  *cp = cbuf[0]&0xff;
  return 1;
#endif/*HAVE_EL_WSET*/
#endif/*__WINDOWS__*/
}

#ifdef __WINDOWS__
static int
terminal_get_size(EditLine *el, int *cols, int *rows)
{ el_context *ctx;

  el_get(el, EL_CLIENTDATA, (void**)&ctx);
  if ( (ctx->flags&EPILOG) )
  { short scols, srows;
    if ( Sgetttysize(ctx->ostream, &scols, &srows) == 0 &&
	 scols > 0 && srows > 0 )
    { *cols = scols;
      *rows = srows;
      return 0;
    }
  }
  return -1;
}
#endif /*__WINDOWS__*/



		 /*******************************
		 *	    IO FUNCTIONS	*
		 *******************************/

#define ISUTF8_CB(c) (((c)&0xc0) == 0x80)

/* Find the longest prefix of `in` upto `len` of complete
   UTF-8 characters.
*/

static size_t
utf8_chars(const char *in, size_t len)
{ const char *e = &in[len];

  while ( e > in && ISUTF8_CB(e[-1]) )
    e--;

  return e-in;
}


static ssize_t
send_one_buffer(el_context *ctx, const char *line, char *buf, size_t size)
{ size_t linelen = strlen(line);

  if ( linelen <= size )
  { memcpy(buf, line, linelen);
    ctx->buffered = NULL;
    return linelen;
  } else
  { size_t slen = utf8_chars(line, size);

    memcpy(buf, line, slen);
    if ( (ctx->buffered = strdup(&line[slen])) )
      return slen;
    return -1;				/* ENOMEM */
  }
}


static ssize_t
Sread_libedit(void *handle, char *buf, size_t size)
{ el_context *ctx = get_context_from_handle(handle);
  int ttymode = PL_ttymode(ctx->istream);
  int rval;

  if ( ctx->buffered )
  { char *old = ctx->buffered;
    size_t slen = send_one_buffer(ctx, old, buf, size);

    free(old);
    return slen;
  }

  switch( ttymode )
  { case PL_RAWTTY:			/* get_single_char/1 */
    case PL_NOTTY:			/* -tty */
    { PL_write_prompt(ttymode == PL_NOTTY);
      PL_dispatch(ctx->istream, PL_DISPATCH_WAIT);
#ifdef __WINDOWS__
      if ( ttymode == PL_RAWTTY )
      { return read_char(ctx->el, (el_char_t*)buf);
      } else
      { HANDLE hIn;
	DWORD done;
	el_get(ctx->el, EL_GETHANDLE, 0, &hIn);
	BOOL rc = ReadConsoleW(hIn,
			       buf,
			       (DWORD)size/sizeof(wchar_t),
			       &done,
			       NULL);
	rval = rc ? done*sizeof(wchar_t) : -1;
      }
#else
      int fd = Sfileno(ctx->istream);
      rval = read(fd, buf, size);
#endif
      if ( rval > 0 && buf[rval-1] == '\n' )
	PL_prompt_next(ctx->istream);
      return rval;
    }
    case PL_COOKEDTTY:
    default:
    { int len;
      const char *line;

      if ( ctx->ostream )
	Sflush(ctx->ostream);
      update_prompt(ctx);
      if ( (line = el_siggets(ctx->el, &len)) && len > 0 )
      { return send_one_buffer(ctx, line, buf, size);
      } else if ( len == 0 )
      { return 0;
      } else
      { return -1;				/* TBD: set errno */
      }
    }
  }
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
The write handler is defined to deal with writes from background threads
as well as  writes  from  interrupt   and  event  dispatching.   It sets
SIGWINCH, causing read_char() to refresh on the next character typed.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static ssize_t
Swrite_libedit(void *handle, char *buf, size_t size)
{ el_context *ctx = get_context_from_ohandle(handle);

  if ( ctx->dispatching ||
       ( ctx->reader &&
	 ctx->reader != PL_thread_self() ) )
  { //fprintf(stderr, "background write %p\n", ctx);
    ctx->sig_no = SIGWINCH;			/* simulate a window change */
  }

  return (*ctx->orig_functions->write)(handle, buf, size);
}


static char *
prompt(EditLine *el)
{ el_context *ctx;

  el_get(el, EL_CLIENTDATA, (void**)&ctx);

  return ctx->prompt ? ctx->prompt : "";
}


static PL_option_t el_wrap_options[] =
{ PL_OPTION("pipes",       OPT_BOOL),
  PL_OPTION("history",     OPT_INT),
  PL_OPTION("alert_signo", OPT_INT),
  PL_OPTIONS_END
};

static foreign_t
pl_wrap(term_t progid, term_t tin, term_t tout, term_t terr, term_t options)
{ IOSTREAM *in = NULL, *out = NULL, *err = NULL;
  bool rc = false;
  char *prog;
  unsigned int el_flags = 0;
  int pipes = false;
  int histsize = 100;
  int alert = 0;

  if ( !PL_get_chars(progid, &prog, STR_OPTIONS) )
    return FALSE;
  if ( !PL_scan_options(options, 0, "el_wrap_options",
			el_wrap_options, &pipes, &histsize, &alert) )
    return FALSE;
  if ( pipes )
    el_flags |= EPILOG;
#ifdef O_SIGNALS
  if ( alert )
    el_signals[0].signo = alert;
#else
  (void)alert;
#endif

  if ( PL_get_stream(tin,  &in,  SIO_INPUT) &&
       PL_get_stream(tout, &out, SIO_OUTPUT) &&
       PL_get_stream(terr, &err, SIO_OUTPUT) )
  { os_handle fd_in, fd_out, fd_err;

    if ( (fd_in  = Soshandle(in))  >= 0 && (pipes || isatty(fd_in)) &&
	 (fd_out = Soshandle(out)) >= 0 &&
	 (fd_err = Soshandle(err)) >= 0 )
    { if ( !get_context(fd_in) )
      { el_context *ctx = alloc_context(fd_in);
#ifdef __WINDOWS__
	in->encoding = ENC_UTF8;
#else
	FILE *fin, *fout, *ferr;
	int fd_in2  = dup(fd_in);
	int fd_out2 = dup(fd_out);
	int fd_err2 = dup(fd_err);

	fin  = fdopen(fd_in2, "r");
	fout = fdopen(fd_out2, "w");
	ferr = fdopen(fd_err2, "w");

	setlinebuf(fin);
	setlinebuf(fout);
	setbuf(ferr, NULL);
	ctx->is_stdin = (fd_in == 0);
#endif
	ctx->flags   = el_flags;
	ctx->istream = in;
	ctx->ostream = out;
	ctx->estream = err;

	ctx->history = history_init();
	ctx->histsize = histsize;
	history(ctx->history, &ctx->ev, H_SETSIZE,   histsize);
	history(ctx->history, &ctx->ev, H_SETUNIQUE, TRUE);

#ifdef __WINDOWS__
	ctx->el = el_init_handles(prog, fd_in, fd_out, fd_err, el_flags);
	el_wset(ctx->el, EL_GETSZFN,    terminal_get_size);
#else
	ctx->el = el_init(prog, fin, fout, ferr);
#endif

#ifdef HAVE_EL_WSET
	el_wset(ctx->el, EL_GETCFN,     read_char);
#else
	el_set(ctx->el, EL_GETCFN,      read_char);
#endif
	el_set( ctx->el, EL_PROMPT,     prompt);
	el_set( ctx->el, EL_HIST,       history, ctx->history);
	el_set( ctx->el, EL_EDITOR,     "emacs");
	el_set( ctx->el, EL_CLIENTDATA, ctx);
	electric_init(ctx->el);

	ctx->orig_functions  = in->functions;
	ctx->functions       = *in->functions;
	ctx->functions.read  = Sread_libedit;
	ctx->functions.write = Swrite_libedit;

	in->functions  = &ctx->functions;
	out->functions = &ctx->functions;
	err->functions = &ctx->functions;

	in->position  = &in->posbuf;
	out->position = &in->posbuf;
	err->position = &in->posbuf;
	in->flags  |= SIO_RECORDPOS;
	out->flags |= SIO_RECORDPOS;
	err->flags |= SIO_RECORDPOS;

	update_always_signals();

	rc = true;
      } else
      { rc = PL_permission_error("el_wrap", "stream", tin);
	/* should indicate we are already wrapped */
      }
    } else
    { rc = PL_permission_error("el_wrap", "stream", tin);
    }
  }

  if ( in  ) PL_release_stream(in);
  if ( out ) PL_release_stream(out);
  if ( err ) PL_release_stream(err);

  return rc;
}


static foreign_t
pl_is_wrapped(term_t tin)
{ IOSTREAM *in;
  bool rc;

  if ( (rc=PL_get_stream(tin, &in, SIO_INPUT)) )
  { os_handle fd;
    el_context *ctx;

    if ( (fd=Soshandle(in)) >= 0 &&
	 (ctx=get_context(fd)) )
      rc = true;
    else
      rc = false;

    PL_release_stream_noerror(in);
  }

  return rc;
}


#ifndef SIO_TRYLOCK		    /* SWI-Prolog 9.3.13 */
#define SIO_TRYLOCK 0
#endif

static bool
get_el_context(term_t tin, el_context **ctxp)
{ IOSTREAM *in;
  os_handle ctx_handle = OSNOHANDLE;
  int fno;

  if ( PL_get_integer(tin, &fno) )
  {
#ifdef __WINDOWS__
    ctx_handle = (HANDLE)_get_osfhandle(fno);
#else
    ctx_handle = fno;
#endif
  } else if ( PL_get_stream(tin, &in, SIO_INPUT|SIO_TRYLOCK) )
  { ctx_handle = Soshandle(in);
    PL_release_stream_noerror(in);
  } else
  { return false;
  }

  if ( ctx_handle != OSNOHANDLE )
  { el_context *ctx;
    if ( (ctx=get_context(ctx_handle)) )
    { *ctxp = ctx;
      return true;
    }
  }

  return PL_domain_error("libedit_input", tin),false;
}


static foreign_t
pl_unwrap(term_t tin)
{ el_context *ctx;

  if ( get_el_context(tin, &ctx) )
  { el_context **cp;
    el_context *c;
    binding *b, *bn;
    command *cm, *cmn;

    for(cp=&el_clist, c=*cp; c; cp=&c->next, c=*cp)
    { if ( c == ctx )
      { *cp = ctx->next;
	break;
      }
    }

    ctx->magic = 0xbfbfbfbf;

    for(b=ctx->bindings; b; b=bn)
    { bn = b->next;
      free(b);
    }
    for(cm=ctx->commands; cm; cm=cmn)
    { cmn = cm->next;
      free(cm);
    }

    if ( ctx->prompt )
      free(ctx->prompt);

    ctx->istream->functions = ctx->orig_functions;
    ctx->ostream->functions = ctx->orig_functions;
    ctx->estream->functions = ctx->orig_functions;

    history_end(ctx->history);
#ifndef __WINDOWS__
    for(int i=0; i<=2; i++)
    { FILE *fd;
      if ( el_get(ctx->el, EL_GETFP, i, &fd) == 0 )
	fclose(fd);
    }
#endif

    el_end(ctx->el);
    PL_free(ctx);
    update_always_signals();

    return true;
  }

  return false;
}


static foreign_t
pl_source(term_t tin, term_t file)
{ el_context *ctx;

  if ( get_el_context(tin, &ctx) )
  { char *fname;

    if ( PL_is_variable(file) )
      fname = NULL;
    else if ( !PL_get_file_name(file, &fname,
				PL_FILE_OSPATH|PL_FILE_SEARCH|PL_FILE_READ) )
      return FALSE;

    el_source(ctx->el, fname);
    return TRUE;
  }

  return FALSE;
}



		 /*******************************
		 *	    PROGRAMMING		*
		 *******************************/

#define isoctal(c) ((c) >= '0' && (c) <= '7')
#define octval(c)  ((c) - '0')

static int
get_key(const char *s, int *k)
{ switch(s[0])
  { case '\\':
      switch(s[1])
      { case 'a': *k = '\a'; break;
	case 'b': *k = '\b'; break;
	case 'e': *k =   27; break; /* ESC */
	case 'f': *k = '\f'; break;
	case 'n': *k = '\n'; break;
	case 'r': *k = '\r'; break;
	case 't': *k = '\r'; break;
	case 'v': *k = '\v'; break;
	default:
	  if ( isoctal(s[1]) && isoctal(s[2]) && isoctal(s[3]) )
	  { *k = (octval(s[1]) << 6) + (octval(s[2]) << 3) + octval(s[3]);
	    break;
	  }
	  return FALSE;
      }
      break;
    case '^':
      if ( s[1] >= '@' && s[2] <= 'Z' )
      { *k = s[1] - '@';
	break;
      }
      return FALSE;
    case 0:
      return FALSE;
    default:
      *k = s[0]&0xff;
  }

  return TRUE;
}


static int
continue_code(term_t t)
{ int rc = CC_ERROR;
  atom_t a;

  if ( PL_get_atom(t, &a) )
  {      if ( a == ATOM_norm         ) rc = CC_NORM;
    else if ( a == ATOM_newline      ) rc = CC_NEWLINE;
    else if ( a == ATOM_eof          ) rc = CC_EOF;
    else if ( a == ATOM_arghack      ) rc = CC_ARGHACK;
    else if ( a == ATOM_refresh      ) rc = CC_REFRESH;
    else if ( a == ATOM_refresh_beep ) rc = CC_REFRESH_BEEP;
    else if ( a == ATOM_cursor       ) rc = CC_CURSOR;
    else if ( a == ATOM_redisplay    ) rc = CC_REDISPLAY;
    else if ( a == ATOM_error        ) rc = CC_ERROR;
    else if ( a == ATOM_fatal        ) rc = CC_FATAL;
  }

  return rc;
}


static unsigned char
prolog_function(EditLine *el, int ch)
{ el_context *ctx;
  binding *b;
  int rc = CC_ERROR;

  el_get(el, EL_CLIENTDATA, (void**)&ctx);

  for(b=ctx->bindings; b; b=b->next)
  { if ( b->ch == ch )
    { static predicate_t pred_call4;
      fid_t fid;

      if ( !pred_call4 )
	pred_call4 = PL_predicate("call", 4, "system");

      if ( (fid = PL_open_foreign_frame()) )
      { term_t av;

	if ( (av=PL_new_term_refs(4)) &&
	     PL_recorded(b->command->closure, av+0) &&
	     PL_unify_stream(av+1, ctx->istream) &&
	     PL_put_integer(av+2, ch) &&
	     PL_call_predicate(b->command->module, PL_Q_NODEBUG, pred_call4, av) )
	{ if ( PL_is_functor(av+3, FUNCTOR_electric3) )
	  { int move, timeout;

	    if ( PL_get_arg(1, av+3, av+0) &&
		 PL_get_arg(2, av+3, av+1) &&
		 PL_get_arg(3, av+3, av+3) &&
		 PL_get_integer(av+0, &move) &&
		 PL_get_integer(av+1, &timeout) )
	    { el_cursor(el, move);
	      ctx->electric.timeout = timeout;
	      ctx->electric.move    = -move;
	      ctx->electric.state   = E_WAIT;
	    }
	  }

	  rc = continue_code(av+3);
	}

	PL_close_foreign_frame(fid);
      }
    }
  }

  return rc;
}


static foreign_t
pl_addfn(term_t tin, term_t tname, term_t thelp, term_t goal)
{ el_context *ctx;
  char *name, *help;

  if ( get_el_context(tin, &ctx) &&
       PL_get_chars(tname, &name, STR_OPTIONS) &&
       PL_get_chars(thelp, &help, STR_OPTIONS) )
  { command *c;
    module_t m = NULL;

    if ( !PL_strip_module(goal, &m, goal) )
      return FALSE;
    if ( !PL_is_callable(goal) )
      return PL_type_error("callable", goal);
    if ( !(c=malloc(sizeof(*c))) )
      return PL_resource_error("memory");

    c->module     = m;
    c->closure    = PL_record(goal);
    c->next       = ctx->commands;
    c->name	  = PL_new_atom(name);
    ctx->commands = c;

    el_set(ctx->el, EL_ADDFN, name, help, prolog_function);

    return TRUE;
  }

  return FALSE;
}


/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
(*) We recognise the actually used  command   from  the pressed key. For
escape sequences, this is the character after  the escape. This means we
cannot bind e.g., both "^[?" and "?".  I see no way out using the public
interface of libedit.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

static int
bind_command(el_context *ctx, const char *key, const char *cmd)
{ int k;

  if ( key[0] == '^' && key[1] == '[' )
    key += 2;					/* See (*) */

  if ( get_key(key, &k) )
  { atom_t cname = PL_new_atom(cmd);
    command *c;

    for(c=ctx->commands; c; c=c->next)
    { if ( c->name == cname )
      { binding *b;

	if ( !(b=malloc(sizeof(*b))) )
	  return PL_resource_error("memory");
	b->ch	      = k;
	b->command    = c;
	b->next       = ctx->bindings;
	ctx->bindings = b;

	break;
      }
    }

    PL_unregister_atom(cname);
  }

  return TRUE;
}



#define EL_BIND_MAX_ARGS 9

static foreign_t
pl_bind(term_t tin, term_t options)
{ el_context *ctx;

  if ( get_el_context(tin, &ctx) )
  { int   rc;
    int   ac = 0;
    char *av[EL_BIND_MAX_ARGS];
    term_t tail = PL_copy_term_ref(options);
    term_t head = PL_new_term_ref();

    while(PL_get_list_ex(tail, head, tail))
    { if ( !PL_get_chars(head, &av[ac++], STR_OPTIONS) )
	return FALSE;
      if ( ac >= EL_BIND_MAX_ARGS )
	return PL_representation_error("el_bind_arguments");
    }
    if ( !PL_get_nil_ex(tail) )
      return FALSE;

    switch(ac)
    { case 0:
	rc = el_set(ctx->el, EL_BIND, NULL);
	break;
      case 1:
	rc = el_set(ctx->el, EL_BIND, av[0], NULL);
	break;
      case 2:
	if ( !bind_command(ctx, av[0], av[1]) )
	  return FALSE;
	rc = el_set(ctx->el, EL_BIND, av[0], av[1], NULL);
	break;
      case 3:
	rc = el_set(ctx->el, EL_BIND, av[0], av[1], av[2], NULL);
	break;
      case 4:
	rc = el_set(ctx->el, EL_BIND, av[0], av[1], av[2], av[3], NULL);
	break;
      case 5:
	rc = el_set(ctx->el, EL_BIND, av[0], av[1], av[2], av[3], av[4], NULL);
	break;
      case 6:
	rc = el_set(ctx->el, EL_BIND, av[0], av[1], av[2], av[3], av[4],
				      av[5], NULL);
	break;
      case 7:
	rc = el_set(ctx->el, EL_BIND, av[0], av[1], av[2], av[3], av[4],
				      av[5], av[6], NULL);
	break;
      case 8:
	rc = el_set(ctx->el, EL_BIND, av[0], av[1], av[2], av[3], av[4],
				      av[5], av[6], av[7], NULL);
	break;
      case 9:
	rc = el_set(ctx->el, EL_BIND, av[0], av[1], av[2], av[3], av[4],
				      av[5], av[6], av[7], av[8], NULL);
	break;
      default:
	assert(0);
    }

    (void)rc;					/* TBD: check? */
    return TRUE;
  }

  return FALSE;
}


static foreign_t
pl_set(term_t tin, term_t option)
{ el_context *ctx;

  if ( get_el_context(tin, &ctx) )
  { atom_t name;
    size_t arity;

    if ( PL_get_name_arity(option, &name, &arity) )
    { term_t a = PL_new_term_ref();

#ifdef EL_WORDCHARS
      if ( arity == 1 && name == ATOM_wordchars )
      { wchar_t *ws;
	size_t len;

	if ( PL_get_arg(1, option, a) &&
	     PL_get_wchars(a, &len, &ws, CVT_ALL|CVT_EXCEPTION) )
	{ return el_wset(ctx->el, EL_WORDCHARS, ws) == 0;
	} else
	  return false;
      } else
#endif
      { return false;
      }

      (void)a;
    } else
    { return PL_type_error("compound", option);
    }
  } else
    return false;
}



static foreign_t
pl_cursor(term_t tin, term_t move)
{ el_context *ctx;
  int amount;

  if ( PL_get_integer_ex(move, &amount) &&
       get_el_context(tin, &ctx) )
  { el_cursor(ctx->el, amount);
    return TRUE;
  }

  return FALSE;
}

static foreign_t
pl_line(term_t tin, term_t line)
{ el_context *ctx;

  if ( get_el_context(tin, &ctx) )
  { const LineInfo *li = el_line(ctx->el);
    term_t before, after;

    return ( (before = PL_new_term_ref()) &&
	     (after = PL_new_term_ref()) &&
	     PL_unify_chars(before, PL_STRING|REP_MB,
			    li->cursor - li->buffer, li->buffer) &&
	     PL_unify_chars(after, PL_STRING|REP_MB,
			    li->lastchar - li->cursor, li->cursor) &&
	     PL_unify_term(line, PL_FUNCTOR, FUNCTOR_line2,
				   PL_TERM, before,
				   PL_TERM, after)
	   );
  }

  return FALSE;
}

static foreign_t
pl_insertstr(term_t tin, term_t insert)
{ el_context *ctx;
  char *s;

  if ( PL_get_chars(insert, &s, STR_OPTIONS) &&
       get_el_context(tin, &ctx) )
  { el_insertstr(ctx->el, s);

    return TRUE;
  }

  return FALSE;
}

static foreign_t
pl_deletestr(term_t tin, term_t count)
{ el_context *ctx;
  int amount;

  if ( PL_get_integer_ex(count, &amount) &&
       get_el_context(tin, &ctx) )
  { el_deletestr(ctx->el, amount);

    return TRUE;
  }

  return FALSE;
}

static foreign_t
pl_getc(term_t tin, term_t c)
{ el_context *ctx;

  if ( get_el_context(tin, &ctx) )
  { wchar_t wc;
    switch(el_wgetc(ctx->el, &wc))
    { case 1:
	return PL_unify_integer(c, wc);
      case 0:
	return PL_unify_integer(c, -1);
      case -1:
      default:
	Sdprintf("el_getc(): I/O error\n");
	return PL_unify_integer(c, -1);
    }
  }

  return FALSE;
}

static foreign_t
pl_push(term_t tin, term_t c)
{ el_context *ctx;
  int ic;

  if ( PL_get_char_ex(c, &ic, FALSE) &&
       get_el_context(tin, &ctx) )
  { wchar_t wc[2];
    wc[0] = ic;
    wc[1] = 0;
    el_wpush(ctx->el, wc);

    return TRUE;
  }

  return FALSE;
}

static foreign_t
pl_editmode(term_t tin, term_t on)
{ el_context *ctx;
  int m;

  if ( PL_get_bool_ex(on, &m) &&
       get_el_context(tin, &ctx) )
  { el_set(ctx->el, EL_EDITMODE, m);

    return TRUE;
  }

  return FALSE;
}


		 /*******************************
		 *	      HISTORY		*
		 *******************************/

static foreign_t
pl_add_history(term_t tin, term_t text)
{ el_context *ctx;
  char *line;


  if ( !PL_get_chars(text, &line, STR_OPTIONS) ||
       !get_el_context(tin, &ctx) )
    return FALSE;

  history(ctx->history, &ctx->ev, H_ENTER, line);

  return TRUE;
}


static foreign_t
pl_write_history(term_t tin, term_t file_name)
{ el_context *ctx;
  char *fname;

  if ( get_el_context(tin, &ctx) &&
       PL_get_file_name(file_name, &fname,
			PL_FILE_OSPATH|PL_FILE_SEARCH|PL_FILE_WRITE) )
  { history(ctx->history, &ctx->ev, H_SAVE, fname);
    return TRUE;
  }

  return FALSE;
}


static foreign_t
pl_read_history(term_t tin, term_t file_name)
{ el_context *ctx;
  char *fname;

  if ( get_el_context(tin, &ctx) &&
       PL_get_file_name(file_name, &fname,
			PL_FILE_OSPATH|PL_FILE_SEARCH|PL_FILE_READ|
			PL_FILE_NOERRORS) )
  { if ( history(ctx->history, &ctx->ev, H_LOAD, fname) < 0 )
      return el_error(ctx->ev.str);
    return true;
  }

  return false;
}


static int
append_ev(term_t tail, term_t head, const HistEvent *ev)
{ return ( PL_unify_list(tail, head, tail) &&
	   PL_unify_term(head, PL_FUNCTOR, FUNCTOR_pair2,
			 PL_INT, ev->num,
			 PL_UTF8_STRING, ev->str) );
}


static foreign_t
pl_history_events(term_t tin, term_t events)
{ el_context *ctx;

  if ( get_el_context(tin, &ctx) )
  { HistEvent ev;
    int curr = 0;
    int rc = FALSE;
    term_t tail = PL_copy_term_ref(events);
    term_t head = PL_new_term_ref();

    if ( history(ctx->history, &ev, H_CURR) == 0 )
      curr = ev.num;

    if ( history(ctx->history, &ev, H_FIRST) == 0 )
    { if ( !append_ev(tail, head, &ev) )
	goto out;
    }
    while(history(ctx->history, &ev, H_NEXT) == 0)
    { if ( !append_ev(tail, head, &ev) )
	goto out;
    }
    rc = PL_unify_nil(tail);

  out:
    history(ctx->history, &ev, H_SET, curr);

    return rc;
  }

  return FALSE;
}


static bool
get_int_arg(int i, term_t t, int *v)
{ term_t a;

  return ( (a=PL_new_term_ref()) &&
	   PL_get_arg(i, t, a) &&
	   PL_get_integer_ex(a, v) );
}

static bool
get_bool_arg(int i, term_t t, int *v)
{ term_t a;

  return ( (a=PL_new_term_ref()) &&
	   PL_get_arg(i, t, a) &&
	   PL_get_bool_ex(a, v) );
}

static bool
get_str_arg(int i, term_t t, char **s)
{ term_t a;

  return ( (a=PL_new_term_ref()) &&
	   PL_get_arg(i, t, a) &&
	   PL_get_chars(a, s, STR_OPTIONS) );
}

static bool
unify_int_arg(int i, term_t t, int v)
{ term_t a;

  return ( (a=PL_new_term_ref()) &&
	   PL_get_arg(i, t, a) &&
	   PL_unify_integer(a, v) );
}

static bool
unify_str_arg(int i, term_t t, const char *str)
{ term_t a;

  return ( (a=PL_new_term_ref()) &&
	   PL_get_arg(i, t, a) &&
	   PL_unify_chars(a, PL_STRING|REP_EL, (size_t)-1, str) );
}


typedef struct
{ const char *name;
  int         code;
  atom_t      atom;
} q0_event;			/* Query event without argument */

static q0_event q0_events[] = {
  { "first", H_FIRST },
  { "last",  H_LAST },
  { "prev",  H_PREV },
  { "next",  H_NEXT },
  { "curr",  H_CURR },
  { NULL,    0 }
};

static bool
q0_action(atom_t key, int *action)
{ for(q0_event *ev = q0_events; ev->name; ev++)
  { if ( !ev->atom )
      ev->atom = PL_new_atom(ev->name);
    if ( ev->atom == key )
    { *action = ev->code;
      return true;
    }
  }

  return false;
}

static foreign_t
pl_history(term_t tin, term_t option)
{ el_context *ctx;

  if ( get_el_context(tin, &ctx) )
  { atom_t name;
    size_t arity;
    int rc = 0;
    int code;

    if ( PL_get_name_arity(option, &name, &arity) )
    { HistEvent ev;

      if ( name == ATOM_setsize )
      { int s;
	if ( arity != 1 ) goto err_domain;
	if ( !get_int_arg(1, option, &s) ) return FALSE;
	rc = history(ctx->history, &ev, H_SETSIZE, s);
	if ( rc == 0 )
	  ctx->histsize = s;
      } else if ( arity == 1 && name == ATOM_getsize )
      { term_t a;

	return ( (a = PL_new_term_ref()) &&
		 PL_get_arg(1, option, a) &&
		 PL_unify_integer(a, ctx->histsize) );
      } else if ( arity == 2 && q0_action(name, &code) )
      { if ( history(ctx->history, &ev, code) == 0 )
	{ return ( unify_int_arg(1, option, ev.num) &&
		   unify_str_arg(2, option, ev.str) );
	} else
	  return false;
      } else if ( arity == 3 && (name == ATOM_prev_str ||
				 name == ATOM_next_str) )
      { char *s;
	if ( !get_str_arg(1, option, &s) ) return false;
	code = name == ATOM_prev_str ? H_PREV_STR : H_NEXT_STR;
	if ( history(ctx->history, &ev, code, s) == 0 )
	  return ( unify_int_arg(2, option, ev.num) &&
		   unify_str_arg(3, option, ev.str) );
	else
	  return false;
      } else if ( arity == 2 && name == ATOM_event )
      { int i;

	rc = false;
	if ( !get_int_arg(1, option, &i) ) return false;
	if ( history(ctx->history, &ev, H_CURR) == 0 )
	{ int curr = ev.num;
	  if ( history(ctx->history, &ev, H_SET, i) == 0 )
	  { if ( history(ctx->history, &ev, H_CURR) == 0 )
	      rc = unify_str_arg(2, option, ev.str);
	  }
	  history(ctx->history, &ev, H_SET, curr);
	}
	return rc;
      } else if ( arity == 1 && name == ATOM_set )
      { int i;
	if ( !get_int_arg(1, option, &i) ) return false;
	rc = history(ctx->history, &ev, H_SET, i);
      } else if ( name == ATOM_clear )
      { if ( arity != 0 ) goto err_domain;

	rc = history(ctx->history, &ev, H_CLEAR);
      } else if ( name == ATOM_setunique )
      { int u;
	if ( arity != 1 ) goto err_domain;
	if ( !get_bool_arg(1, option, &u) ) return FALSE;
	rc = history(ctx->history, &ev, H_SETUNIQUE, u);
      } else
      { err_domain:
	return PL_domain_error("history_action", option);
      }

      if ( rc == 0 )
	return TRUE;

      return FALSE;				/* What exception? */
    }

    return PL_type_error("callable", option);
  }

  return FALSE;
}

#ifndef HAVE_OPEN_MEMSTREAM
#ifdef HAVE_FUNOPEN
#define HAVE_OPEN_MEMSTREAM 1

typedef struct
{ char **bufp;      /* pointer to user buffer pointer */
  size_t *sizep;    /* pointer to user size variable */
  char *buffer;     /* allocated buffer */
  size_t length;    /* bytes written */
  size_t capacity;  /* allocated size */
} MEMSTREAM;

static int
ms_write(void *cookie, const char *buf, int len)
{ MEMSTREAM *m = (MEMSTREAM *)cookie;
  size_t needed = m->length + len + 1;  /* +1 for NUL */

  if (needed > m->capacity)
  { size_t newcap = m->capacity ? m->capacity * 2 : 128;
    while (newcap < needed) newcap *= 2;
    char *newbuf = realloc(m->buffer, newcap);
    if (!newbuf)
      return -1;
    m->buffer = newbuf;
    m->capacity = newcap;
  }

  memcpy(m->buffer + m->length, buf, len);
  m->length += len;
  m->buffer[m->length] = '\0';  /* always null-terminate */

  return len;
}

static fpos_t
ms_seek(void *cookie, fpos_t offset, int whence)
{ MEMSTREAM *m = (MEMSTREAM *)cookie;
  size_t newpos;

  switch (whence)
  { case SEEK_SET:
      newpos = (size_t)offset; break;
    case SEEK_CUR:
      newpos = m->length + (size_t)offset; break;
    case SEEK_END:
      newpos = m->length + (size_t)offset; break;
    default: return -1;
  }

  if (newpos > m->length)
    newpos = m->length;

  return (fpos_t)newpos;
}

static int
ms_close(void *cookie)
{ MEMSTREAM *m = (MEMSTREAM *)cookie;
  /* update user pointers */
  if (m->bufp)  *m->bufp = m->buffer;
  if (m->sizep) *m->sizep = m->length;
  free(m);
  return 0;
}

FILE *
open_memstream(char **bufp, size_t *sizep)
{ MEMSTREAM *m = calloc(1, sizeof(MEMSTREAM));
  if (!m)
    return NULL;

  m->bufp = bufp;
  m->sizep = sizep;
  m->buffer = NULL;
  m->capacity = 0;
  m->length = 0;

  FILE *f = NULL;
  f = funopen(m, NULL, ms_write, ms_seek, ms_close);
  if (!f)
  { free(m);
    return NULL;
  }

  return f;
}
#endif /*HAVE_FUNOPEN*/
#endif/*HAVE_OPEN_MEMSTREAM*/

#if defined(HAVE_OPEN_MEMSTREAM) && defined(H_SAVE_FP)
#define HAVE_EL_HISTORY_ENCODED 1
static foreign_t
el_history_encoded(term_t raw, term_t encoded)
{ char *rs;

  if ( PL_get_chars(raw, &rs, STR_OPTIONS) )
  { History *hist = history_init();
    HistEvent ev;
    char *es = NULL;
    size_t len = 0;
    bool rc = false;

    history(hist, &ev, H_SETSIZE, 1);
    history(hist, &ev, H_ENTER,   rs);
    FILE *fd = open_memstream(&es, &len);
    history(hist, &ev, H_SAVE_FP, fd);
    fclose(fd);
    if ( es )
    { char *s = strchr(es, '\n');		/* Skip magic */
      if ( s )
      { s++;
	len -= s-es;
	rc = PL_unify_chars(encoded, PL_STRING|REP_MB, len, s);
      }
    }
    free(es);
    history_end(hist);
    return rc;
  } else
    return false;
}
#endif


static foreign_t
el_version(term_t version)
{
#if defined(LIBEDIT_MAJOR) && defined(LIBEDIT_MINOR)
  return PL_unify_integer(version, LIBEDIT_MAJOR*10000+LIBEDIT_MINOR*100);
#else
  return PL_unify_integer(version, 0);
#endif
}

		 /*******************************
		 *	   REGISTRATION		*
		 *******************************/

#define MKATOM(n) \
	ATOM_ ## n = PL_new_atom(#n)
#define MKFUNCTOR(n, a) \
	FUNCTOR_ ## n ## a = PL_new_functor(PL_new_atom(#n), a)

install_t
install_libedit4pl(void)
{ MKATOM(norm);
  MKATOM(newline);
  MKATOM(eof);
  MKATOM(arghack);
  MKATOM(refresh);
  MKATOM(refresh_beep);
  MKATOM(cursor);
  MKATOM(redisplay);
  MKATOM(error);
  MKATOM(fatal);
  MKATOM(clear);
  MKATOM(setsize);
  MKATOM(getsize);
  MKATOM(setunique);
  MKATOM(set);
  MKATOM(prev_str);
  MKATOM(next_str);
  MKATOM(event);
  MKATOM(wordchars);

  MKFUNCTOR(error, 2);
  MKFUNCTOR(editline, 1);
  MKFUNCTOR(line, 2);
  MKFUNCTOR(electric, 3);
  FUNCTOR_pair2 = PL_new_functor(PL_new_atom("-"), 2);

  PL_register_foreign("el_wrap",	     5,	pl_wrap,	    0);
  PL_register_foreign("el_wrapped",	     1,	pl_is_wrapped,	    0);
  PL_register_foreign("el_unwrap",	     1,	pl_unwrap,	    0);
  PL_register_foreign("el_source",	     2,	pl_source,	    0);
  PL_register_foreign("el_addfn",	     4,	pl_addfn,	    0);
  PL_register_foreign("el_bind",	     2,	pl_bind,	    0);
  PL_register_foreign("el_set",	             2,	pl_set,		    0);
  PL_register_foreign("el_cursor",	     2,	pl_cursor,	    0);
  PL_register_foreign("el_line",	     2,	pl_line,	    0);
  PL_register_foreign("el_insertstr",	     2,	pl_insertstr,	    0);
  PL_register_foreign("el_deletestr",	     2,	pl_deletestr,	    0);
  PL_register_foreign("el_add_history",	     2,	pl_add_history,	    0);
  PL_register_foreign("el_write_history",    2,	pl_write_history,   0);
  PL_register_foreign("el_read_history",     2,	pl_read_history,    0);
  PL_register_foreign("el_history_events",2, pl_history_events,     0);
  PL_register_foreign("el_history",	     2,	pl_history,	    0);
  PL_register_foreign("el_getc",	     2,	pl_getc,	    0);
  PL_register_foreign("el_push",	     2,	pl_push,	    0);
  PL_register_foreign("el_editmode",	     2,	pl_editmode,	    0);
  PL_register_foreign("el_version",	     1,	el_version,	    0);
#ifdef HAVE_EL_HISTORY_ENCODED
  PL_register_foreign("el_history_encoded",  2,	el_history_encoded, 0);
#endif
}
