libedit4pl.c

/*  Part of SWI-Prolog

    Author:        Jan Wielemaker
    E-mail:        jan@swi-prolog.org
    WWW:           http://www.swi-prolog.org
    Copyright (c)  2017-2026, 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>
#include <stdarg.h>
#include <stdio.h>
#ifdef O_PLMT
#include <pthread.h>
#endif

#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
#ifndef __WINDOWS__
#include <termios.h>			/* reclaim_tty() */
#endif
#ifdef __WINDOWS__
#include <io.h>
#endif

/* libedit's included config.h doesn't carry a SIZEOF_WCHAR_T define on
 * every platform.  Fall back to the compiler-provided intrinsic so
 * the `#if SIZEOF_WCHAR_T == 2` branches here actually fire where they
 * should (e.g. MinGW/MSVC Windows with 16-bit wchar_t). */
#ifndef SIZEOF_WCHAR_T
#  ifdef __SIZEOF_WCHAR_T__
#    define SIZEOF_WCHAR_T __SIZEOF_WCHAR_T__
#  else
#    define SIZEOF_WCHAR_T 4
#  endif
#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 atom_t ATOM_editor;
static atom_t ATOM_bracketed_paste;
static atom_t ATOM_prompt_marks;
static atom_t ATOM_attrs;

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 MAX_LINE_TAIL 512		/* Longer than a prompt ever is.  See
					   THE UNFINISHED LINE below. */

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

		 /*******************************
		 *          PAINT LOCK          *
		 *******************************/

/* Serialise painting the input line between the thread that reads it
 * and any thread that writes to the terminal.  A single threaded build
 * has no second writer, so the lock compiles away and the binding does
 * not need pthreads at all.  See Swrite_libedit().
 */

#ifdef O_PLMT
typedef pthread_mutex_t paint_lock_t;
#define paint_lock_init(l)	pthread_mutex_init(l, NULL)
#define paint_lock_destroy(l)	pthread_mutex_destroy(l)
#define paint_lock(l)		pthread_mutex_lock(l)
#define paint_unlock(l)		pthread_mutex_unlock(l)
#else
typedef char paint_lock_t;
#define paint_lock_init(l)	((void)0)
#define paint_lock_destroy(l)	((void)0)
#define paint_lock(l)		((void)0)
#define paint_unlock(l)		((void)0)
#endif

		 /*******************************
		 *           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_raw;	/* Prompt as Prolog gave it */
  char		       *prompt;		/* Same, with literals delimited */
  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 */
  bool			bracketed_paste;/* Keep bracketed paste mode enabled */
  bool			prompt_marks;	/* Mark prompt and input (OSC 133) */
  bool			output_open;	/* Wrote OSC 133 C, owe a D */
  bool			prompt_cont;	/* ... and it continues an input */
  short			dispatching;	/* We are dispatching an event */
  short			cols;		/* Terminal size we told libedit */
  short			rows;		/* about.  See check_terminal_size() */
  paint_lock_t		paint_lock;	/* Serialise painting the input line */
  bool			line_hidden;	/* Input line is off the screen */
  bool			at_bol;		/* Foreign output ended a line */
  char		       *line_tail;	/* Output on the line it did not end */
  size_t		line_tail_len;	/* Bytes of it we hold */
  size_t		line_tail_cols;	/* Roughly what it paints; only
					   used to refuse a long one */
  bool			line_tail_ok;	/* ... and we can hand it to libedit */
  bool			prompt_from_bol;/* The prompt holds it, so paint from
					   column 0 */
  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
#if SIZEOF_WCHAR_T == 2
  int			pending_trail;	/* Queued UTF-16 trail surrogate;
					   0 if none.  Needed when the
					   decoded input is a supplementary
					   code point but wchar_t holds only
					   16 bits: read_char returns the
					   lead first and the trail on the
					   next call. */
#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->at_bol = true;
  c->line_tail = malloc(MAX_LINE_TAIL+1);
  c->line_tail_ok = (c->line_tail != NULL);
  paint_lock_init(&c->paint_lock);
  c->next  = el_clist;
  el_clist = c;

  return c;
}


		 /*******************************
		 *	THE UNFINISHED LINE	*
		 *******************************/

/* The text on the output line the client has not ended.
 *
 * A read that starts where the output left the caret has no prompt of
 * its own.  `format("name: "), read_line_to_string(user_input, S)' puts
 * `name: ' on the screen as ordinary output and then reads, so libedit
 * is handed an empty prompt and takes the line to start in column 0 --
 * six columns to the left of where it does.  While it moves the caret
 * relatively that goes unseen, but a full refresh (a SIGWINCH, a resize
 * it notices at a keypress, ^L) redraws the input over `name: ' and
 * leaves the caret six columns out.
 *
 * The column alone would not mend it: libedit repaints the columns it
 * counts, so it has to be given the text.  Remember what went on the
 * line and hand it to libedit as the front of its prompt.  libedit then
 * counts those columns, paints them itself, and puts them back whenever
 * it redraws.  See update_prompt() and the `\r' before el_siggets().
 *
 * What arrives here is what a stream write handler is given: bytes in
 * the stream's encoding, while a prompt is UTF-8 (PL_prompt_string()).
 * Only the encodings that convert without a decoder are taken; the rest
 * give up, and give up is also what a line too long to put back on one
 * row does.  Either way the line stays as it is today.
 */

/* How the units of a write become the UTF-8 of a prompt. */

typedef enum
{ TAIL_UTF8,				/* already UTF-8; copy the bytes */
  TAIL_CODE,				/* one code point per unit */
  TAIL_ASCII				/* the same, if it stays ASCII */
} tail_encoding;

static tail_encoding
tail_encoding_of(IOSTREAM *s)
{ switch(s ? s->encoding : ENC_ANSI)
  { case ENC_UTF8:
      return TAIL_UTF8;
    case ENC_ISO_LATIN_1:
    case ENC_OCTET:
    case ENC_WCHAR:
      return TAIL_CODE;
    default:				/* ENC_ANSI and friends: a decoder */
      return TAIL_ASCII;		/* we do not have */
  }
}


static void
line_tail_clear(el_context *ctx)
{ ctx->line_tail_len  = 0;
  ctx->line_tail_cols = 0;
  ctx->line_tail_ok   = true;
}


/* Append one unit, or give up on the line.  Giving up is sticky until
 * the line ends: half a prompt is worse than none.
 */

static void
line_tail_add(el_context *ctx, int c, tail_encoding enc, bool visible)
{ char buf[6];
  size_t len, at;

  if ( !ctx->line_tail_ok )
    return;

  if ( enc == TAIL_UTF8 || (c >= 0 && c < 0x80) )
  { buf[0] = (char)c;
    len = 1;
  } else if ( enc == TAIL_ASCII ||
	      c < 0 || c > 0x10ffff ||	/* not a code point, or half of */
	      (c >= 0xd800 && c <= 0xdfff) ) /* one: a UTF-16 surrogate */
  { ctx->line_tail_ok = false;		/* we cannot name this character */
    return;
  } else				/* TAIL_CODE: encode as UTF-8 */
  { len = 0;
    if ( c < 0x800 )
    { buf[len++] = (char)(0xc0|(c>>6));
    } else if ( c < 0x10000 )
    { buf[len++] = (char)(0xe0|(c>>12));
      buf[len++] = (char)(0x80|((c>>6)&0x3f));
    } else
    { buf[len++] = (char)(0xf0|(c>>18));
      buf[len++] = (char)(0x80|((c>>12)&0x3f));
      buf[len++] = (char)(0x80|((c>>6)&0x3f));
    }
    buf[len++] = (char)(0x80|(c&0x3f));
  }

  at = ctx->line_tail_len;		/* read once: two threads may write */
  if ( at+len > MAX_LINE_TAIL )		/* to the same line, and neither */
  { ctx->line_tail_ok = false;		/* may run off the buffer */
    return;
  }
  memcpy(ctx->line_tail+at, buf, len);
  ctx->line_tail[at+len] = '\0';
  ctx->line_tail_len = at+len;
  if ( visible )
    ctx->line_tail_cols++;
}


/* The text to put in front of the prompt, or NULL to leave the line as
 * the client left it.  A tail that does not fit on a row is refused:
 * the `\r' that puts libedit at the start of it would land on the wrong
 * one.
 */

static const char *
adopted_line_tail(el_context *ctx)
{ if ( !ctx->line_tail_ok || ctx->line_tail_len == 0 )
    return NULL;
  if ( ctx->cols > 0 && ctx->line_tail_cols >= (size_t)ctx->cols )
    return NULL;

  return ctx->line_tail;
}


/* The OSC 133 "semantic prompt" marks of FinalTerm, as spoken by
 * iTerm2, kitty, WezTerm, VS Code and the Epilog terminal: `A' starts a
 * prompt, `B' ends the prompt and starts the line the user edits, `C'
 * ends that line and starts the output of what was entered, and `D' ends
 * that output.  A terminal that reads them knows what is prompt, what
 * the user typed and what came out of it.  Epilog uses `B' and `C' to
 * know that there is a line being edited and where it starts, so that a
 * click in it can ask us to move the caret there, and the four together
 * to hand the whole command over to <-blocks.
 *
 * `A' and `B' are part of the prompt rather than written from here, so
 * that libedit emits them from its display, at the place where the
 * prompt and the input really start.  See marked_prompt().  A read that
 * asks for a single character is not marked at all: there is no line
 * being edited there.
 *
 * `D' is written before the next prompt rather than when the output
 * stops, because nothing tells us that it has: the caret sits where the
 * output left it until something asks for another line.  ctx->output_open
 * keeps each `C' to one `D', so a read from inside a read -- the
 * debugger, a nested toplevel -- cannot close a command that is still
 * running.
 */

#define OSC133_PROMPT  "\033]133;A\033\\"
#define OSC133_PROMPT2 "\033]133;A;k=s\033\\"
#define OSC133_INPUT   "\033]133;B\033\\"
#define OSC133_ENTERED "\033]133;C\033\\"
#define OSC133_DONE    "\033]133;D\033\\"

#define PROMPT_LITERAL '\001'		/* our EL_PROMPT_ESC delimiter */

/* escape_length() returns the length of the ANSI escape sequence starting
 * at `in' or 0 if there is none.  Recognised are CSI (ESC [ ... final
 * byte), OSC (ESC ] ... BEL or ESC \) and two-character sequences.
 */

static size_t
escape_length(const char *in)
{ const char *s = in;

  if ( *s != '\033' )
    return 0;

  switch(*++s)
  { case '[':				/* CSI */
      while ( *++s >= 0x20 && *s <= 0x3f )
	;
      return (*s >= 0x40 && *s <= 0x7e) ? (size_t)(s+1-in) : 0;
    case ']':				/* OSC */
      while ( *++s )
      { if ( *s == '\007' )
	  return (size_t)(s+1-in);
	if ( *s == '\033' && s[1] == '\\' )
	  return (size_t)(s+2-in);
      }
      return 0;
    default:
      while ( *s >= 0x20 && *s <= 0x2f )	/* intermediate bytes */
	s++;
      return *s ? (size_t)(s+1-in) : 0;
  }
}


/* prompt_with_literals() surrounds each run of escape sequences with the
 * EL_PROMPT_ESC delimiter, so libedit emits them without counting them as
 * columns.  Delimiters already present are honoured (\002 is mapped to
 * \001, as readline uses two different ones).  Adjacent runs are merged:
 * libedit attaches the character following a group to it, so two groups
 * in a row would make the delimiter itself that character.
 */

static char *
prompt_with_literals(const char *in)
{ char *out = malloc(strlen(in)*2+1);	/* worst case: all escapes */
  const char *s;
  char *o;
  bool literal = false;			/* inside a delimited run */

  if ( !out )
    return NULL;

  for(s=in, o=out; *s; )
  { size_t esclen;

    if ( *s == PROMPT_LITERAL || *s == '\002' )
    { *o++ = PROMPT_LITERAL;
      literal = !literal;
      s++;
    } else if ( !literal && (esclen=escape_length(s)) )
    { if ( o > out && o[-1] == PROMPT_LITERAL )
	o--;				/* merge with the previous run */
      else
	*o++ = PROMPT_LITERAL;
      do
      { memcpy(o, s, esclen);
	o += esclen;
	s += esclen;
      } while ( (esclen=escape_length(s)) );
      *o++ = PROMPT_LITERAL;
    } else
    { *o++ = *s++;
    }
  }
  *o = '\0';

  return out;
}


/* marked_prompt() surrounds the prompt with the OSC 133 marks that say
 * where a prompt starts and where the line the user edits starts, and
 * delimits the result for libedit.  The marks ride along in the prompt
 * rather than being written once because libedit emits the prompt from
 * its display: that puts each mark at the place it talks about, and
 * puts it there again whenever the prompt is drawn somewhere else.
 */

static char *
marked_prompt(const char *prompt, bool continuation)
{ const char *a = continuation ? OSC133_PROMPT2 : OSC133_PROMPT;
  size_t len = strlen(a)+strlen(prompt)+strlen(OSC133_INPUT);
  char *marked = malloc(len+1);
  char *delimited;

  if ( !marked )
    return NULL;

  snprintf(marked, len+1, "%s%s%s", a, prompt, OSC133_INPUT);
  delimited = prompt_with_literals(marked);
  free(marked);

  return delimited;
}


/* The prompt libedit is to draw, which is what Prolog asked for behind
 * whatever the client already put on the line.  Both are prompt as far
 * as the user is concerned, and taking them together is what puts
 * libedit's columns where the screen's are; see MAX_LINE_TAIL.
 */

static char *
raw_prompt(el_context *ctx)
{ const char *pre = adopted_line_tail(ctx);
  const char *np  = PL_prompt_string(ctx->istream);

  ctx->prompt_from_bol = (pre != NULL);
  if ( !pre )
    return np ? strdup(np) : NULL;
  if ( !np )
    return strdup(pre);

  { size_t len = strlen(pre)+strlen(np);
    char *raw = malloc(len+1);

    if ( raw )
      snprintf(raw, len+1, "%s%s", pre, np);

    return raw;
  }
}


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

  /* Before raw_prompt(), which is what asks for the prompt: asking is
     what makes the one of a first line used up, and after that every
     prompt is a continuation. */
  np = raw_prompt(ctx);

  if ( ctx->prompt_raw && np && strcmp(np, ctx->prompt_raw) == 0 &&
       ctx->prompt_cont == cont )
  { free(np);
    return;
  }

  free(ctx->prompt);
  free(ctx->prompt_raw);
  ctx->prompt = ctx->prompt_raw = NULL;
  ctx->prompt_cont = cont;
  if ( ctx->prompt_marks )
  { /* Prolog writes no prompt for a read that starts where the output
       left the caret.  The input still starts there and is still
       edited, so it is still marked.
    */
    ctx->prompt = marked_prompt(np ? np : "", cont);
  } else if ( np )
  { ctx->prompt = prompt_with_literals(np);
  }
  ctx->prompt_raw = np;
}


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

/* el_cursor_cp_delta():
 *	Translate a CODE-POINT delta (the count Prolog hands us via
 *	`string_length` and matching_open's index) into a WCHAR_T
 *	delta, which is what the underlying el_cursor() takes.
 *
 *	On Linux with sizeof(wchar_t) == 4 the two are equal and this
 *	is the identity.  On Windows wchar_t is 16 bits and a non-BMP
 *	code point lives as a UTF-16 surrogate pair (two wchar_t),
 *	so the wchar_t step is bigger than the code-point step.
 *	Without translating, electric-caret jumps over emoji / CJK
 *	Ext B land mid-surrogate.
 */
#if SIZEOF_WCHAR_T == 2
#  define IS_UTF16_LEAD_(c)  ((c) >= 0xD800 && (c) <= 0xDBFF)
#  define IS_UTF16_TRAIL_(c) ((c) >= 0xDC00 && (c) <= 0xDFFF)
#endif

static int
el_cursor_cp_delta(EditLine *el, int cp_delta)
{
#if SIZEOF_WCHAR_T == 2
  const LineInfoW *li = el_wline(el);
  const wchar_t *p = li->cursor;
  int wchar_delta = 0;

  if ( cp_delta == 0 )
    return 0;

  if ( cp_delta > 0 )
  { for(int i = 0; i < cp_delta && p < li->lastchar; i++)
    { if ( IS_UTF16_LEAD_(p[0]) && p+1 < li->lastchar &&
	   IS_UTF16_TRAIL_(p[1]) )
      { p += 2; wchar_delta += 2;
      } else
      { p += 1; wchar_delta += 1;
      }
    }
  } else
  { for(int i = 0; i < -cp_delta && p > li->buffer; i++)
    { p -= 1; wchar_delta -= 1;
      if ( p > li->buffer && IS_UTF16_TRAIL_(*p) &&
	   IS_UTF16_LEAD_(p[-1]) )
      { p -= 1; wchar_delta -= 1;
      }
    }
  }
  return wchar_delta;
#else
  (void)el;
  return cp_delta;
#endif
}


/* el_write_terminal():
 *	Write a control sequence straight to the terminal, behind the
 *	editor's display.  On Windows the output handle is obtained via
 *	EL_GETHANDLE; on Unix via EL_GETFP.
 */
static void
el_write_terminal(EditLine *el, const char *seq)
{ size_t len = strlen(seq);

#ifdef __WINDOWS__
  { HANDLE hOut;
    DWORD written;
    if ( el_get(el, EL_GETHANDLE, 1, &hOut) == 0 )
      WriteFile(hOut, seq, (DWORD)len, &written, NULL);
  }
#else
  { FILE *fout;
    if ( el_get(el, EL_GETFP, 1, &fout) == 0 )
    { fwrite(seq, 1, len, fout);
      fflush(fout);
    }
  }
#endif
}

/* el_bracketed_paste():
 *	Ask the terminal to bracket pasted text (enable=1) or to stop
 *	doing so (enable=0).
 */
static void
el_bracketed_paste(EditLine *el, bool enable)
{ el_write_terminal(el, enable ? "\033[?2004h" : "\033[?2004l");
}

		 /*******************************
		 *	  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);
  /* Re-enable bracketed paste mode in case a subprocess or a single
     character read (see Sread_libedit()) disabled it. */
  if ( ctx->bracketed_paste )
    el_bracketed_paste(el, true);

  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)
{ /* Foreign output that did not end its line (see Swrite_libedit())
   * left the caret after the text: start a new line rather than draw
   * the prompt over what was written. */
  const char *nl = ( ctx->line_hidden && !ctx->at_bol ) ? "\r\n" : "\r";

  paint_lock(&ctx->paint_lock);
#if __WINDOWS__
  HANDLE hErr;
  el_get(ctx->el, EL_GETHANDLE, 2, &hErr);
  el_resize(ctx->el);
  if ( (ctx->flags&EPILOG) )
  { WriteFile(hErr, nl, (DWORD)strlen(nl), NULL, NULL);
  } else
  { const wchar_t *wnl = ( nl[1] ? L"\r\n" : L"\r" );
    WriteConsoleW(hErr, wnl, (DWORD)wcslen(wnl), NULL, NULL);
  }
#else
  FILE *err;

  el_get(ctx->el, EL_GETFP, 2, &err);
  el_resize(ctx->el);
  fprintf(err, "%s", nl);
#endif
  el_set(ctx->el, EL_REFRESH);
  ctx->line_hidden = false;
  ctx->at_bol = true;
  paint_unlock(&ctx->paint_lock);
}


/* Has the terminal been resized since we last told libedit its size?
 *
 * Read from read_char(), where the prompt and the input line are on the
 * screen and the cursor sits at the end of the input -- the state
 * el_resize()'s repaint assumes.  Without this libedit keeps computing
 * rows and columns from a size the terminal no longer has, and editing
 * an input line that wraps paints on the wrong rows.
 *
 * An Epilog window on Windows cannot raise SIGWINCH on the client
 * thread: resizing it only updates the size on the stream (see
 * rlc_resize_pty() in pce/src/txt/terminal.c), so there the poll is the
 * only way the size ever arrives.  On Unix the resize does raise
 * SIGWINCH, but a signal is not something to rely on for this: one that
 * arrives while we are already repainting used to be cleared with the
 * one we were handling, and the size that raised it was then never
 * picked up.  Both leave libedit painting a wrapped line on rows that
 * hold something else.
 *
 * The first look only records the size: the terminal has not been
 * resized, we simply had not asked yet.
 */

static bool
terminal_size_changed(el_context *ctx)
{ short cols = 0, rows = 0;

#ifdef __WINDOWS__
  if ( !(ctx->flags&EPILOG) ||
       Sgetttysize(ctx->ostream, &cols, &rows) != 0 )
    return false;
#else
  FILE *in;
  struct winsize ws;

  if ( el_get(ctx->el, EL_GETFP, 0, &in) != 0 ||
       ioctl(fileno(in), TIOCGWINSZ, &ws) != 0 )
    return false;
  cols = (short)ws.ws_col;
  rows = (short)ws.ws_row;
#endif

  if ( cols > 0 && rows > 0 &&
       ( cols != ctx->cols || rows != ctx->rows ) )
  { bool first = ( ctx->cols == 0 );

    ctx->cols = cols;
    ctx->rows = rows;
    return !first;
  }

  return false;
}

/* Act on a resize before the character we just read is: a key moves the
 * caret by rows and columns that libedit has to have right.  A SIGWINCH
 * repaints whether or not the size itself changed; without one we go by
 * the size on the terminal.
 */

static void
check_terminal_size(el_context *ctx)
{ bool winch = ( ctx->sig_no == SIGWINCH );

  if ( winch )
    ctx->sig_no = 0;		/* before the repaint, not after: a resize
				 * that arrives while we are in it must not
				 * be cleared along with this one */
  if ( terminal_size_changed(ctx) || winch )
    refresh(ctx);
}


#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

/* Take a still pending read down before we return.  The kernel owns `ov'
 * and the buffer we were reading into, and both are locals: `ov' of this
 * function, the buffer of read_char().  Leaving the read queued lets the
 * kernel write the next character into a stack frame that is gone by
 * then, and signal an event we already closed.
 *
 * CancelIoEx() races completion, so the wait is not optional.  A
 * character the kernel delivered while we were cancelling is lost, which
 * is what we want on the paths that get here: they abandon the read
 * because Prolog is unwinding, not because anyone waits for the byte.
 */

static void
cancel_pending_read(HANDLE hPipe, OVERLAPPED *ov)
{ DWORD bytes;

  CancelIoEx(hPipe, ov);
  GetOverlappedResult(hPipe, ov, &bytes, TRUE); /* ERROR_OPERATION_ABORTED */
}

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)
	    { cancel_pending_read(hPipe, &ov);
	      CloseHandle(ov.hEvent);
	      return PIPE_READ_EOF;
	    }
	    TranslateMessage(&msg);
	    DispatchMessage(&msg);
	  }
	  if ( PL_handle_signals() < 0 )
	  { cancel_pending_read(hPipe, &ov);
	    CloseHandle(ov.hEvent);
	    return PIPE_READ_PROLOG_EXCEPTION;
	  }
	} else
	{ cancel_pending_read(hPipe, &ov);
	  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__ */

#ifndef __WINDOWS__
/**
 * Reconnect our private duplicates of the terminal after the kernel
 * revoked it.
 *
 * A process that makes a terminal its controlling terminal -- a child
 * of shell/1 or process_create/3 on the pty of an epilog window -- is
 * the session leader of a session that owns a terminal, and BSD
 * kernels, MacOS among them, revoke such a terminal when its session
 * leader exits.  Every descriptor on it is detached from the device,
 * in this process as well, and fails with EIO from then on.
 *
 * Prolog reconnects the descriptors of the streams it handed us (see
 * restore_ctty() in src/os/pl-os.c), but el_wrap/4 gave libedit
 * duplicates of its own and those it cannot see.  Take the streams as
 * they are now: if a duplicate is dead where the stream it came from
 * is alive, it was revoked and the stream has been reconnected, so
 * duplicating it again puts us back on the terminal.  The stdio error
 * flags are cleared with it; without that a FILE that saw the EIO
 * refuses to write.
 *
 * Nothing here happens on a system that does not revoke: the
 * duplicates stay alive and the loop finds nothing to do.
 */

static bool
reclaim_tty(el_context *ctx)
{ IOSTREAM * const streams[3] = { ctx->istream, ctx->ostream, ctx->estream };
  bool reclaimed = false;

  for(int i=0; i<3; i++)
  { FILE *fp = NULL;
    struct termios tio;

    if ( el_get(ctx->el, EL_GETFP, i, &fp) == 0 && fp )
    { int ours   = fileno(fp);
      int theirs = Sfileno(streams[i]);

      if ( ours >= 0 && theirs >= 0 &&
	   tcgetattr(ours, &tio) < 0 &&	    /* ours is gone ... */
	   tcgetattr(theirs, &tio) == 0 &&  /* ... and Prolog has a live one */
	   dup2(theirs, ours) >= 0 )
      { clearerr(fp);
	reclaimed = true;
      }
    }
  }

  return reclaimed;
}
#endif

#ifdef __WINDOWS__
/* Does this key event merely say that a modifier went down?
 *
 * Such an event carries no character, and reporting it as one hands
 * libedit a NUL.  Windows queues it for the modifier of every combination
 * typed, including ^C: with ENABLE_PROCESSED_INPUT the console turns the
 * "C" into a CTRL_C_EVENT and drops it, but leaves the Control that
 * preceded it in the input buffer.  The interrupt handler then read that
 * as the answer to its "Action (h for help) ?" and printed "Unknown
 * option" before the user had touched a key.  See issue #1515.
 */

static bool
is_modifier_key(WORD vk)
{ switch(vk)
  { case VK_SHIFT:
    case VK_CONTROL:
    case VK_MENU:
    case VK_LSHIFT:
    case VK_RSHIFT:
    case VK_LCONTROL:
    case VK_RCONTROL:
    case VK_LMENU:
    case VK_RMENU:
    case VK_LWIN:
    case VK_RWIN:
    case VK_CAPITAL:
    case VK_NUMLOCK:
    case VK_SCROLL:
      return true;
    default:
      return false;
  }
}
#endif /*__WINDOWS__*/

static int
read_char(EditLine *el, el_char_t *cp)
{ el_context *ctx;
  ssize_t num_read;
#ifndef __WINDOWS__
  bool tried = false;
  bool reclaimed = 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;
    }
  }

  check_terminal_size(ctx);

#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;

#if SIZEOF_WCHAR_T == 2
    /* Finish emitting a supplementary code point held over from a
     * previous read_char call. */
    if ( ctx->pending_trail != 0 )
    { *cp = (el_char_t)ctx->pending_trail;
      ctx->pending_trail = 0;
      return 1;
    }
#endif

    ctx->dispatching++;
    bytes = pipe_read_or_msg(hIn, &buffer[start], 1);
    ctx->dispatching--;
    /* A resize during the wait raises no signal here, so look again
     * before handing the character to libedit: the terminal has already
     * rewrapped, and a key acted on with the old width moves the caret
     * to a row that no longer holds what libedit thinks it does. */
    check_terminal_size(ctx);
    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);
#if SIZEOF_WCHAR_T == 2
	/* On Windows wchar_t is a 16-bit UTF-16 code unit, so a
	 * supplementary code point (U+10000 and above — emoji, CJK
	 * extensions) cannot fit into one el_char_t.  Return the lead
	 * surrogate now and queue the trail for the next read_char
	 * call. */
	if ( chr > 0xFFFF )
	{ int c = chr - 0x10000;
	  ctx->pending_trail = 0xDC00 | (c & 0x3FF);
	  *cp = (el_char_t)(0xD800 | (c >> 10));
	} else
	{ *cp = (el_char_t)chr;
	}
#else
	*cp = chr;
#endif
	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;

    /* Explicit W variant: the A version would deliver paste/typed
     * characters as the console's OEM/ANSI codepage byte in
     * ev.Event.KeyEvent.uChar.AsciiChar, which leaves uChar.UnicodeChar
     * with at best a low-byte-truncated value.  On a CP_437 console
     * that turns a pasted 'à' (U+00E0) into 0x85 (the CP_437 byte for
     * à), which libedit then renders as its control-char escape
     * '^Å' (^ followed by 0x85|0x40 = 0xC5 = Å).  Using W makes the
     * event carry the real UTF-16 code unit. */
    /* Record that this thread is the one waiting for a key, the way
     * do_read() does on Unix.  Swrite_libedit() reads that to tell
     * output from another thread apart from output by the reader
     * itself: only for the former may it take the input line off the
     * screen, write, and put the line back below.  Without it the
     * console branch never looked like it was reading, and a
     * background thread's output was written straight into the line
     * the user was editing. */
    BOOL rc;
    int oreader = ctx->reader;

    ctx->reader = PL_thread_self();
    rc = ReadConsoleInputW(hIn, &ev, 1, &done);
    ctx->reader = oreader;
    if ( rc )
    { if ( done == 1 )
      { switch(ev.EventType)
	{ case KEY_EVENT:
	  { if ( ev.Event.KeyEvent.bKeyDown &&
		 !is_modifier_key(ev.Event.KeyEvent.wVirtualKeyCode) )
	    { *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 ( e == EIO && !reclaimed && reclaim_tty(ctx) )
    { reclaimed = true;		/* the terminal was revoked; we are back */
      errno = save_errno;
      continue;
    }

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

  check_terminal_size(ctx);	/* before libedit acts on the character */

  /* 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;
  }

#ifndef __WINDOWS__
  reclaim_tty(ctx);	  /* a child may have taken the terminal down */
#endif

  switch( ttymode )
  { case PL_RAWTTY:			/* get_single_char/1 */
    case PL_NOTTY:			/* -tty */
    { /* No line editor owns the input for this read, so say so.  The
       * Epilog terminal turns a click in the line being edited into
       * cursor keys while bracketed paste is on, and a single character
       * read would answer with the ESC of the first of them.
       * el_siggets() turns the mode back on for the next line.
       */
      if ( ctx->bracketed_paste )
	el_bracketed_paste(ctx->el, false);

      PL_write_prompt(ttymode == PL_NOTTY);
      if ( !PL_dispatch(ctx->istream, PL_DISPATCH_WAIT) )
      { Sset_exception(ctx->istream, PL_exception(0));
	return -1;
      }
#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 ( ctx->prompt_from_bol )
	el_write_terminal(ctx->el, "\r");   /* the prompt holds what the
						client put on the line;
						libedit paints it over
						itself */
      if ( ctx->prompt_marks && ctx->output_open )
      { el_write_terminal(ctx->el, OSC133_DONE); /* the output of the line
						    before this one is over.
						    After the `\r': what the
						    prompt took over is no
						    longer output */
	ctx->output_open = false;
      }
      line = el_siggets(ctx->el, &len);
      line_tail_clear(ctx);		/* the line the user entered ended */
      if ( ctx->prompt_marks )			/* the line was entered: */
      { el_write_terminal(ctx->el, OSC133_ENTERED); /* what follows is its
						       output */
	ctx->output_open = true;
      }
      if ( line && 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.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */

/* One unit of the encoded text a stream write handler is given. */

static int
enc_unit(const char *buf, size_t i, bool wide)
{ if ( wide )
  { wchar_t wc;

    memcpy(&wc, buf+i, sizeof(wc));
    return (int)wc;
  }

  return (int)(unsigned char)buf[i];
}


/* Note what this write did to the line it went on: keep the record of
 * an unfinished line (see MAX_LINE_TAIL above) and answer whether the
 * write left the caret at the start of a new one.
 *
 * Whether it ended the line is not a question the last byte can answer.
 * A write handler is handed the *encoded* text, and the encoding of a
 * Windows console stream is wchar: writeln/1 arrives as "hello\r\n" in
 * UTF-16, whose last byte is the zero half of the newline.  Taking that
 * for a line that had not ended left the input line off the screen --
 * the output overwrote the prompt and no new prompt appeared until a
 * key was pressed.
 *
 * So walk the text a character at a time and report on the last one
 * that actually moves the caret.  A carriage return puts the caret in
 * column 0 but leaves the line's content, so it does not count as
 * having ended it -- though it does mean the next character lands on
 * top of the first, which is where the record of the line starts over.
 *
 * The escape sequences move no caret and paint no column, but they go
 * into the record: a prompt written in colour is put back in colour.
 * prompt_with_literals() delimits them so libedit emits them without
 * counting them.
 */

static bool
note_output(el_context *ctx, const char *buf, size_t size)
{ bool wide = ( ctx->ostream && ctx->ostream->encoding == ENC_WCHAR );
  tail_encoding enc = tail_encoding_of(ctx->ostream);
  size_t step = wide ? sizeof(wchar_t) : 1;
  bool bol = false;

  for(size_t i=0; i+step <= size; i += step)
  { int c = enc_unit(buf, i, wide);

    if ( c == 27 )				/* ESC: skip the sequence */
    { line_tail_add(ctx, c, enc, false);
      i += step;
      if ( i+step <= size && enc_unit(buf, i, wide) == '[' )
      { line_tail_add(ctx, '[', enc, false);
	i += step;				/* CSI: parameters, then */
	while( i+step <= size )			/* one final byte */
	{ int p = enc_unit(buf, i, wide);

	  if ( p < 0x20 || p > 0x3F )
	    break;
	  line_tail_add(ctx, p, enc, false);
	  i += step;
	}
      }
      if ( i+step <= size )
	line_tail_add(ctx, enc_unit(buf, i, wide), enc, false);
    } else if ( c == '\n' )
    { bol = true;
      line_tail_clear(ctx);
    } else if ( c == '\r' )
    { line_tail_clear(ctx);
    } else
    { bol = false;
      line_tail_add(ctx, c, enc, true);
    }
  }

  return bol;
}


/* Trace of the decisions that put foreign output on the screen.  Set
 * SWIPL_LIBEDIT_DEBUG to a file name to switch it on; it is off
 * otherwise.  It writes straight to a file rather than through a Prolog
 * stream, which is the very thing being traced.
 */

static void
el_debug(const char *fmt, ...)
{ const char *fname = getenv("SWIPL_LIBEDIT_DEBUG");
  va_list args;
  FILE *fd;

  if ( !fname || !fname[0] || !(fd=fopen(fname, "a")) )
    return;

  va_start(args, fmt);
  vfprintf(fd, fmt, args);
  va_end(args);
  fclose(fd);
}


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

  el_debug("Swrite: size=%d dispatching=%d reader=%d self=%d hidden=%d\n",
	   (int)size, ctx->dispatching, ctx->reader, PL_thread_self(),
	   (int)ctx->line_hidden);

  if ( ctx->dispatching ||
       ( ctx->reader &&
	 ctx->reader != PL_thread_self() ) )
  { /* Someone writes while the line editor owns the screen.  The test
     * above holds only while the reader waits for input rather than
     * paints, so we may take the input line off the screen, write, and
     * put the line back below the output.  Otherwise the text lands
     * wherever the caret happens to be -- inside the user's input --
     * and stays there until the next keystroke redraws the line.
     *
     * Output that does not end its line leaves the input line hidden:
     * the next write continues where this one stopped, and refresh()
     * completes the line if the user types first.
     *
     * Taking the line off the screen needs EL_ERASELINE, which is an
     * addition of ours: the binding still builds against a stock
     * libedit (SYSTEM_LIBEDIT, never on Windows), and there the text
     * goes out where the caret is and the line is put back on the next
     * key, which is all that can be done without it.
     */
    ssize_t rc;

    paint_lock(&ctx->paint_lock);
#ifdef EL_ERASELINE			/* our copy of libedit; see below */
    if ( !ctx->line_hidden )
    { el_set(ctx->el, EL_ERASELINE);
      ctx->line_hidden = true;
      ctx->at_bol = true;
    }
#endif
    rc = (*ctx->orig_functions->write)(handle, buf, size);
    if ( rc > 0 )
      ctx->at_bol = note_output(ctx, buf, (size_t)rc);
    { char tail[64];
      bool wide = ( ctx->ostream && ctx->ostream->encoding == ENC_WCHAR );
      size_t step = wide ? sizeof(wchar_t) : 1;
      size_t i, n = 0, from = ((size_t)rc > 24*step) ? (size_t)rc-24*step : 0;

      from -= from % step;
      for(i=from; i+step<=(size_t)rc && n < sizeof(tail)-6; i += step)
      { int c = enc_unit(buf, i, wide);

	if ( c == 27 )
	  n += (size_t)snprintf(tail+n, sizeof(tail)-n, "<ESC>");
	else if ( c == '\n' )
	  n += (size_t)snprintf(tail+n, sizeof(tail)-n, "<NL>");
	else if ( c == '\r' )
	  n += (size_t)snprintf(tail+n, sizeof(tail)-n, "<CR>");
	else if ( c >= 0x20 && c < 0x7F )
	  tail[n++] = (char)c;
	else
	  n += (size_t)snprintf(tail+n, sizeof(tail)-n, "<%04x>", c);
      }
      tail[n] = 0;
      el_debug("  took the line down, wrote rc=%d at_bol=%d tail=\"%s\" -> %s\n",
	       (int)rc, (int)ctx->at_bol, tail,
	       ctx->at_bol ? "EL_REFRESH" : "defer to the next key");
    }
    if ( ctx->at_bol && ctx->line_hidden )
    { el_set(ctx->el, EL_REFRESH);
      ctx->line_hidden = false;
    } else
    { ctx->sig_no = SIGWINCH;		/* restore the line on input */
    }
    paint_unlock(&ctx->paint_lock);

    return rc;
  }

  { ssize_t rc = (*ctx->orig_functions->write)(handle, buf, size);

    if ( rc > 0 )			/* remember an unfinished line, so */
      note_output(ctx, buf, (size_t)rc);/* a read starting on it has a
					   prompt.  See MAX_LINE_TAIL. */
    return rc;
  }
}


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

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

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


#ifdef EL_WCWIDTH
/* Column width of a code point as rendered by an Epilog terminal.
 *
 * When libedit drives an Epilog (xpce) terminal (el_flags&EPILOG), the
 * on-screen width of a glyph is decided by the terminal font, not by
 * the static, locale-independent Unicode tables PL_wcwidth() reads.
 * Symbol and emoji code points that PL_wcwidth() reports as width 1 are
 * routinely drawn two cells wide by an emoji-presenting font, which
 * makes libedit's column tracking drift against what Epilog paints.
 *
 * Ask Prolog: editline:el_wcwidth/2 (supplied by library(epilog)) which
 * measures the code point in the current thread's terminal font.  ASCII
 * is font-independent, so it is handled here without entering Prolog.
 * Fall back to PL_wcwidth() when the hook is absent, fails or raises. */
static int
epilog_wcwidth(int chr)
{ static predicate_t pred = NULL;
  int width;

  if ( chr < 0x80 )			/* ASCII: same in any fixed font */
    return PL_wcwidth(chr);

  if ( !pred )
    pred = PL_predicate("el_wcwidth", 2, "editline");

  width = PL_wcwidth(chr);		/* used if the hook fails or errors */
  if ( width < 0 )			/* non-printable */
    return width;

  fid_t fid;
  if ( (fid = PL_open_foreign_frame()) )
  { term_t av = PL_new_term_refs(2);

    if ( av && PL_put_integer(av+0, chr) )
    { qid_t qid = PL_open_query(NULL, PL_Q_NODEBUG, pred, av);
      if ( qid )
      { int w;

	if ( PL_next_solution(qid) && PL_get_integer(av+1, &w) )
	  width = w;
	PL_close_query(qid);		/* discards any pending exception */
      }
    }

    PL_discard_foreign_frame(fid);
  }

  return width;
}
#endif


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->bracketed_paste = false;
	ctx->prompt_marks    = true;
	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_ESC, prompt, PROMPT_LITERAL);
	el_set( ctx->el, EL_HIST,       history, ctx->history);
	el_set( ctx->el, EL_EDITOR,     "emacs");
	el_set( ctx->el, EL_CLIENTDATA, ctx);
#ifdef EL_WCWIDTH
	/* Column tracking must agree with what the terminal paints.  On a
	 * real tty that is PL_wcwidth() (the kernel's Unicode tables, as
	 * used by pl-write/pl-fmt).  On an Epilog terminal the width is
	 * font-dependent, so route through epilog_wcwidth(), which asks
	 * Prolog to measure the glyph in the terminal font. */
	el_set( ctx->el, EL_WCWIDTH,
		(ctx->flags&EPILOG) ? epilog_wcwidth : PL_wcwidth);
#endif
	electric_init(ctx->el);

#ifdef __WINDOWS__
	/* el_init_handles() ran terminal_init() before EL_GETSZFN and
	 * EL_CLIENTDATA were set, so it could not ask the Epilog terminal
	 * for its size and fell back to the console -- which an Epilog
	 * window does not have.  Now that the hook can find its context,
	 * ask again.  Without this libedit runs on whatever the fallback
	 * produced and its column/row arithmetic has nothing to do with
	 * the window: editing an input line that wraps then paints on the
	 * wrong rows. */
	if ( terminal_size_changed(ctx) )
	  el_resize(ctx->el);
#endif

	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);
    if ( ctx->prompt_raw )
      free(ctx->prompt_raw);
    if ( ctx->line_tail )
      free(ctx->line_tail);

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

    history_end(ctx->history);
    el_bracketed_paste(ctx->el, false);
#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);
    paint_lock_destroy(&ctx->paint_lock);
    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) )
	    { int wmove = el_cursor_cp_delta(el, move);
	      el_cursor(el, wmove);
	      ctx->electric.timeout = timeout;
	      ctx->electric.move    = -wmove;
	      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;
  const char *p = key;
  size_t len;

  /* Strip ESC prefix: either '^[' notation or raw ESC byte */
  if ( p[0] == '^' && p[1] == '[' )
    p += 2;					/* See (*) */
  else if ( (unsigned char)p[0] == 0x1b && p[1] )
    p += 1;					/* raw ESC byte */

  len = strlen(p);

  /* libedit passes the last character of the sequence as ch to
   * prolog_function().  For a simple X or ^X use get_key(); for longer
   * sequences (e.g. ESC[200~) use the last raw byte.
   */
  if ( len == 0 ||
       (len <= 2 && (len < 2 || p[0] == '^')) )
  { if ( !get_key(p, &k) )
      return TRUE;
  } else
  { k = (unsigned char)p[len-1];
  }

  { atom_t cname = PL_new_atom(cmd);
    command *c;

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

	/* libedit's keymap replaces on re-bind; mirror that here so
	 * repeated el_bind calls for the same key don't stack multiple
	 * entries (which prolog_function would then all dispatch). */
	for(b=ctx->bindings; b; b=b->next)
	{ if ( b->ch == k )
	  { b->command = c;
	    PL_unregister_atom(cname);
	    return TRUE;
	  }
	}

	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
      if ( arity == 1 && name == ATOM_bracketed_paste )
      { int v;

	if ( PL_get_arg(1, option, a) &&
	     PL_get_bool_ex(a, &v) )
	{ if ( ctx->bracketed_paste != v )
	  { ctx->bracketed_paste = v;
	    el_bracketed_paste(ctx->el, v);
	  }
	  return true;
	}
	return false;
      } else
      if ( arity == 1 && name == ATOM_prompt_marks )
      { int v;

	if ( PL_get_arg(1, option, a) &&
	     PL_get_bool_ex(a, &v) )
	{ if ( ctx->prompt_marks != v )
	  { ctx->prompt_marks = v;
	    free(ctx->prompt);		/* the marks live in the prompt, */
	    free(ctx->prompt_raw);	/* so build it again */
	    ctx->prompt = ctx->prompt_raw = NULL;
	  }
	  return true;
	}
	return false;
      } else
#ifdef EL_ATTRS
      if ( arity == 2 && name == ATOM_attrs )
      { char *off, *on;
	term_t b = PL_new_term_ref();

	if ( PL_get_arg(1, option, a) &&
	     PL_get_chars(a, &off, CVT_ATOM|CVT_STRING|CVT_EXCEPTION|REP_MB) &&
	     PL_get_arg(2, option, b) &&
	     PL_get_chars(b, &on, CVT_ATOM|CVT_STRING|CVT_EXCEPTION|REP_MB) )
	  return el_set(ctx->el, EL_ATTRS, off, on) == 0;

	return false;
      } else
#endif
      { return false;
      }

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



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

  if ( !get_el_context(tin, &ctx) )
    return false;

  atom_t name;
  size_t arity;

  if ( !PL_get_name_arity(option, &name, &arity) )
    return PL_type_error("compound", option);

  if ( arity == 1 && name == ATOM_editor )
  { const wchar_t *ed = NULL;
    term_t a = PL_new_term_ref();

    if ( el_wget(ctx->el, EL_EDITOR, &ed) != 0 || ed == NULL )
      return false;

    return PL_get_arg(1, option, a) &&
           PL_unify_wchars(a, PL_ATOM, (size_t)-1, ed);
  }

  if ( arity == 1 && name == ATOM_bracketed_paste )
  { term_t a = PL_new_term_ref();

    return PL_get_arg(1, option, a) &&
           PL_unify_bool(a, ctx->bracketed_paste);
  }

  if ( arity == 1 && name == ATOM_prompt_marks )
  { term_t a = PL_new_term_ref();

    return PL_get_arg(1, option, a) &&
           PL_unify_bool(a, ctx->prompt_marks);
  }

  return PL_domain_error("editline_property", option);
}


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, el_cursor_cp_delta(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;
    /* libedit hands us LineInfo bytes encoded by ct_encode_char: UTF-8
     * unconditionally on Windows, locale-mb on POSIX.  Use REP_EL so
     * decoding matches that, instead of always going through mbrtowc
     * (which fails on non-ASCII bytes when the C runtime's LC_CTYPE
     * is the legacy ANSI codepage). */

    return ( (before = PL_new_term_ref()) &&
	     (after = PL_new_term_ref()) &&
	     PL_unify_chars(before, PL_STRING|REP_EL,
			    li->cursor - li->buffer, li->buffer) &&
	     PL_unify_chars(after, PL_STRING|REP_EL,
			    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:
      {
#if SIZEOF_WCHAR_T == 2
	/* On Windows wchar_t is a 16-bit UTF-16 code unit, so a
	 * supplementary code point (emoji, non-BMP CJK) arrives from
	 * the line buffer as a surrogate pair — two successive
	 * el_wgetc calls.  Reassemble the pair into a single code
	 * point so callers (e.g. editline.pl:bracketed_paste/3 with
	 * its string_codes/2) receive a valid Unicode scalar value
	 * instead of a lone surrogate that Prolog refuses to encode. */
	if ( wc >= 0xD800 && wc <= 0xDBFF )	/* UTF-16 lead */
	{ wchar_t wt;
	  if ( el_wgetc(ctx->el, &wt) == 1 &&
	       wt >= 0xDC00 && wt <= 0xDFFF )	/* UTF-16 trail */
	  { int cp = ((wc - 0xD800) << 10) + (wt - 0xDC00) + 0x10000;
	    return PL_unify_integer(c, cp);
	  }
	  /* malformed — no trail available; surface the lead as-is */
	}
#endif
	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_EL, 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);
  MKATOM(editor);
  MKATOM(bracketed_paste);
  MKATOM(prompt_marks);
  MKATOM(attrs);

  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_get",	             2,	pl_get,		    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
}