[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elk] elk readline extension



dear sam,

during the further development of foo, the sound synthesis system made
with elk,  i rewrote the readline extension, which we used.

it's not longer a reader extension, but an independent dynamically
loadable extension.  it provides a (readline-read) function which is
meant as a (read) replacement for terminal input, along with some
convenience stuff like (readline-set-prompt) and
(readline-add-history).  there is also a simple toplevel symbol
completer implemented.

the patch just adds an extension directory lib/readline, adds a
slightly modified toplevel file toplevel-readline.scm which uses
(readline-read) instead of (read) and patches the lib/Makefile.am and
./configure.ac to compile the extension.  it does not yet add anything
to check for libreadline etc.

i am not sure about licensing issues.  libreadline is GPL, elk looks
like a bsd-style license, which seems no to be compatible.  i don't
know, if it is compatible for GPL-compatible projects linked with
elk.  but in any case, it's a problem to include this with elk.   i
had a look at libedit.  my readline extension compiles out of the box
with the readline-wrapper of libedit, which is BSD licensed.

the sourceforge-libeditline doesn't have an entry point of a
user-provided completion function.

what do you think, how should this extension be distributed?  included
with elk?  we could make a ./configure-option for both libreadline or
libedit support, however the user wants it, while mentioning the
license issues.

at least i hope you will like this extension...

all the best!

martin


-- 
martinrumori (martin@rumori.de)
/* home is where your home directory is */
diff -rpuN elk-trunk/configure.ac elk-trunk-patched/configure.ac
--- elk-trunk/configure.ac	2004-01-28 15:36:29.000000000 +0100
+++ elk-trunk-patched/configure.ac	2004-02-09 18:04:09.000000000 +0100
@@ -593,6 +593,7 @@ AC_OUTPUT([
   lib/xwidgets/Makefile
   lib/xwidgets/xaw/Makefile
   lib/xwidgets/motif/Makefile
+  lib/readline/Makefile
   scm/Makefile
   src/Makefile
 
diff -rpuN elk-trunk/lib/Makefile.am elk-trunk-patched/lib/Makefile.am
--- elk-trunk/lib/Makefile.am	2004-02-03 17:47:28.000000000 +0100
+++ elk-trunk-patched/lib/Makefile.am	2004-02-09 18:03:30.000000000 +0100
@@ -1 +1 @@
-SUBDIRS = misc unix xlib xwidgets
+SUBDIRS = misc unix xlib xwidgets readline
diff -rpuN elk-trunk/lib/readline/Makefile.am elk-trunk-patched/lib/readline/Makefile.am
--- elk-trunk/lib/readline/Makefile.am	1970-01-01 01:00:00.000000000 +0100
+++ elk-trunk-patched/lib/readline/Makefile.am	2004-02-09 18:02:27.000000000 +0100
@@ -0,0 +1,15 @@
+NULL = 
+
+EXTRA_DIST = TODO
+
+pkglib_LTLIBRARIES = readline.la
+
+readline_la_SOURCES = \
+	readline.c \
+	completion.c \
+	$(NULL)
+readline_la_LDFLAGS = -module -avoid-version -no-undefined -lreadline -ltermcap
+readline_la_LIBADD = $(top_builddir)/src/libelk.la
+
+extensions_HEADERS = readline.h
+extensionsdir = $(pkgincludedir)/extensions
diff -rpuN elk-trunk/lib/readline/completion.c elk-trunk-patched/lib/readline/completion.c
--- elk-trunk/lib/readline/completion.c	1970-01-01 01:00:00.000000000 +0100
+++ elk-trunk-patched/lib/readline/completion.c	2004-02-09 18:07:30.000000000 +0100
@@ -0,0 +1,98 @@
+/* completion.c
+ *
+ * $Id$
+ *
+ * Copyright 2004 Martin Rumori <martin@rumori.de>, Berlin
+ *
+ * This software was derived from Elk 1.2, which was Copyright 1987, 1988,
+ * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
+ * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
+ * between TELES and Nixdorf Microprocessor Engineering, Berlin).
+ *
+ * Oliver Laumann, TELES GmbH, Nixdorf Computer AG, Sam Hocevar and
+ * Martin Rumori, as co- owners or individual owners of copyright in
+ * this software, grant to any person or company a worldwide, royalty
+ * free, license to
+ *
+ *    i) copy this software,
+ *   ii) prepare derivative works based on this software,
+ *  iii) distribute copies of this software or derivative works,
+ *   iv) perform this software, or
+ *    v) display this software,
+ *
+ * provided that this notice is not removed and that neither Oliver Laumann
+ * nor Teles nor Nixdorf are deemed to have made any representations as to
+ * the suitability of this software for any purpose nor are held responsible
+ * for any defects of this software.
+ *
+ * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
+ */
+
+#include "readline.h"
+
+static int _erl_maxcompl;
+static char **_erl_completions;
+
+
+void
+erl_calc_completions (char *text)
+{
+  Object oblist, bucket;
+  char *symname;
+  int iter = 0, textlen = strlen(text);
+
+  for (oblist = P_Oblist(); ! Nullp(oblist); oblist = Cdr(oblist))
+    {
+      for (bucket = Car(oblist); ! Nullp(bucket); bucket = Cdr(bucket))
+	{
+	  if (! Truep(P_Boundp(Car(bucket)))) 
+	    {
+	      continue;
+	    }
+	  symname = Get_Strsym(Car(bucket));
+        
+	  if (! strncmp(text, symname, textlen))
+	    {
+	      *(_erl_completions + iter) = strdup(symname);
+	      ++iter;
+
+	      if (iter >= _erl_maxcompl)
+		{
+		  _erl_maxcompl *= 2;
+		  _erl_completions = realloc(_erl_completions, _erl_maxcompl * sizeof(char *));
+		}
+	    }
+	}
+    }
+  *(_erl_completions + iter) = NULL;
+}
+
+
+char *
+erl_complete (char *text, int state)
+{
+  if (! state)
+    {
+      erl_calc_completions (text);
+    }
+
+  return *(_erl_completions + state);
+}
+
+
+void
+elk_init_readline_completion (void)
+{
+  _erl_maxcompl = 256;
+  _erl_completions = malloc(_erl_maxcompl * sizeof(char *));
+  rl_completion_entry_function = erl_complete;
+}
+
+
+void
+elk_finit_readline_completion (void)
+{
+  free(_erl_completions);
+}
+
+/* EOF */
diff -rpuN elk-trunk/lib/readline/readline.c elk-trunk-patched/lib/readline/readline.c
--- elk-trunk/lib/readline/readline.c	1970-01-01 01:00:00.000000000 +0100
+++ elk-trunk-patched/lib/readline/readline.c	2004-02-09 18:02:27.000000000 +0100
@@ -0,0 +1,176 @@
+/* readline.c
+ *
+ * $Id$
+ *
+ * Copyright 2004 Martin Rumori <martin@rumori.de>, Berlin
+ *
+ * This software was derived from Elk 1.2, which was Copyright 1987, 1988,
+ * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
+ * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
+ * between TELES and Nixdorf Microprocessor Engineering, Berlin).
+ *
+ * Oliver Laumann, TELES GmbH, Nixdorf Computer AG, Sam Hocevar and
+ * Martin Rumori, as co- owners or individual owners of copyright in
+ * this software, grant to any person or company a worldwide, royalty
+ * free, license to
+ *
+ *    i) copy this software,
+ *   ii) prepare derivative works based on this software,
+ *  iii) distribute copies of this software or derivative works,
+ *   iv) perform this software, or
+ *    v) display this software,
+ *
+ * provided that this notice is not removed and that neither Oliver Laumann
+ * nor Teles nor Nixdorf are deemed to have made any representations as to
+ * the suitability of this software for any purpose nor are held responsible
+ * for any defects of this software.
+ *
+ * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
+ */
+
+#include "readline.h"
+
+
+static char *_prompt, *_cont_prompt;
+
+
+int
+erl_check_line (const char *line, int first)
+{
+  static int comment = 0, string = 0, braces = 0;
+  const char *c = line;
+
+  if (first)
+    { /* reset static paren and string memory */
+      comment = string = braces = 0;
+    }
+
+  while (c && *c)
+    {
+      if (comment && *c == '\n')
+	{
+	  comment = 0;
+	}
+      else if (string && *c == '"')
+	{
+	  string = 0;
+	}
+      else if (*c == ';')
+	{
+	  comment = 1;
+	}
+      else if (*c == '"')
+	{
+	  string = 1;
+	}
+      else if (*c == '(')
+	{
+	  ++braces;
+	}
+      else if (*c == ')')
+	{
+	  --braces;
+	}
+      ++c;
+    } /* while ... */
+
+  return (braces <= 0);
+}
+
+
+Object
+P_Readline_Read (void)
+{
+  char *expr, *line, *prompt = _prompt;
+  int bufsize = 1024, exprlen = 0, first = 1, llen;
+  Object ret, port;
+  GC_Node2;
+
+  /* alloc memory for expression */
+  expr = malloc(bufsize * sizeof(char));
+  *expr = '\0';
+
+  /* let's go */
+  while (1)
+    {
+      if (NULL == (line = readline(prompt)))
+	{
+	  Primitive_Error("error while reading line");
+	}
+      if (! (llen = strlen(line)))
+	{
+	  continue;
+	}
+      if ((exprlen += llen + 1) >= bufsize)
+	{
+	  bufsize *= 2;
+	  expr = realloc(expr, bufsize * sizeof(char));
+	}
+      strcat(expr, line);
+
+      if (erl_check_line(line, first))
+	{
+	  free(line);
+	  --exprlen; /* correct missing '\n' when last line */
+	  break;
+	}
+
+      if (first)
+	{
+	  first = 0;
+	  prompt = _cont_prompt;
+	}
+
+      strcat(expr, "\n");
+      free(line);
+    } /* while (1) */
+
+  /* add to history */
+  add_history(expr);
+
+  /* give the whole stuff to elk via a string port */
+  port = P_Open_Input_String(Make_String(expr, exprlen));
+  GC_Link2(port, ret);
+  ret = General_Read(port, 0);
+  GC_Unlink;
+ (void)P_Close_Input_Port(port);
+ free(expr);
+
+ return ret;
+}
+
+
+Object
+P_Readline_Add_History (Object add)
+{
+  add_history(Get_String(add));
+
+  return True;
+}
+
+
+Object
+P_Readline_Set_Prompt (Object prompt)
+{
+  free(_prompt);
+  _prompt = strdup(Get_String(prompt));
+
+  return True;
+}
+
+
+void
+elk_init_readline_readline (void)
+{
+  _prompt = strdup("> ");
+  _cont_prompt = "> ";
+  using_history();
+
+  Def_Prim(P_Readline_Read,		"readline-read",	0, 0,	EVAL);
+  Def_Prim(P_Readline_Add_History,	"readline-add-history",	1, 1,	EVAL);
+  Def_Prim(P_Readline_Set_Prompt,	"readline-set-prompt",	1, 1,	EVAL);
+
+  P_Provide(Intern("readline.la"));
+}
+
+/* EOF */
diff -rpuN elk-trunk/lib/readline/readline.h elk-trunk-patched/lib/readline/readline.h
--- elk-trunk/lib/readline/readline.h	1970-01-01 01:00:00.000000000 +0100
+++ elk-trunk-patched/lib/readline/readline.h	2004-02-09 18:02:27.000000000 +0100
@@ -0,0 +1,47 @@
+/* readline.h
+ *
+ * $Id$
+ *
+ * Copyright 2004 Martin Rumori <martin@rumori.de>, Berlin
+ *
+ * This software was derived from Elk 1.2, which was Copyright 1987, 1988,
+ * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
+ * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
+ * between TELES and Nixdorf Microprocessor Engineering, Berlin).
+ *
+ * Oliver Laumann, TELES GmbH, Nixdorf Computer AG, Sam Hocevar and
+ * Martin Rumori, as co- owners or individual owners of copyright in
+ * this software, grant to any person or company a worldwide, royalty
+ * free, license to
+ *
+ *    i) copy this software,
+ *   ii) prepare derivative works based on this software,
+ *  iii) distribute copies of this software or derivative works,
+ *   iv) perform this software, or
+ *    v) display this software,
+ *
+ * provided that this notice is not removed and that neither Oliver Laumann
+ * nor Teles nor Nixdorf are deemed to have made any representations as to
+ * the suitability of this software for any purpose nor are held responsible
+ * for any defects of this software.
+ *
+ * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
+ */
+
+#include "config.h"
+
+#include <stdio.h>
+#include <string.h>
+#include <readline/readline.h>
+#include <readline/history.h>
+
+#include "scheme.h"
+
+
+extern Object P_Readline_Read (void);
+extern Object P_Readline_Add_History (Object add);
+extern Object P_Readline_Set_Prompt (Object prompt);
+
+#define Def_Prim Define_Primitive
+
+/* EOF */
diff -rpuN elk-trunk/scm/Makefile.am elk-trunk-patched/scm/Makefile.am
--- elk-trunk/scm/Makefile.am	2004-01-28 15:36:12.000000000 +0100
+++ elk-trunk-patched/scm/Makefile.am	2004-02-09 18:14:48.000000000 +0100
@@ -24,6 +24,7 @@ SCM_FILES = \
 	toplevel.scm \
 	trace.scm \
 	unix.scm \
+	toplevel-readline.scm \
 	$(NULL)
 
 SCM_MAYBE = \
diff -rpuN elk-trunk/scm/toplevel-readline.scm elk-trunk-patched/scm/toplevel-readline.scm
--- elk-trunk/scm/toplevel-readline.scm	1970-01-01 01:00:00.000000000 +0100
+++ elk-trunk-patched/scm/toplevel-readline.scm	2004-02-09 18:05:48.000000000 +0100
@@ -0,0 +1,111 @@
+;;; -*-Scheme-*-
+;;;
+;;; Read-eval-print loop and error handler (readline extension support)
+
+
+(autoload 'pp 'pp.scm)
+(autoload 'apropos 'apropos.scm)
+(autoload 'sort 'qsort.scm)
+(autoload 'describe 'describe.scm)
+(autoload 'backtrace 'debug.scm)
+(autoload 'inspect 'debug.scm)
+
+(require 'readline.la)
+
+(define ?)
+(define ??)
+(define ???)
+(define !)
+(define !!)
+(define !!!)
+(define &)
+
+(define (rep-loop env)
+  (define input)
+  (define value)
+  (let loop ()
+    (set! ??? ??)
+    (set! ?? ?)
+    (set! ? &)
+    ;;; X Windows hack
+    (if (and (bound? 'display-flush-output) (bound? 'dpy) (display? dpy))
+	(display-flush-output dpy))
+    (if (> rep-level 0)
+	(display rep-level))
+    (set! input (readline-read))
+    (set! & input)
+    (if (not (eof-object? input))
+	(begin
+	  (set! value (eval input env))
+	  (set! !!! !!)
+	  (set! !! !)
+	  (set! ! value)
+	  (write value)
+	  (newline)
+	  (loop)))))
+
+(define rep-frames)
+(define rep-level)
+
+(set! interrupt-handler
+  (lambda ()
+    (format #t "~%\7Interrupt!~%")
+    (let ((next-frame (car rep-frames)))
+      (next-frame #t))))
+
+(define-macro (push-frame control-point)
+  `(begin
+     (set! rep-frames (cons ,control-point rep-frames))
+     (set! rep-level (1+ rep-level))))
+
+(define-macro (pop-frame)
+  '(begin
+     (set! rep-frames (cdr rep-frames))
+     (set! rep-level (1- rep-level))))
+
+(define (error-print error-msg)
+  (format #t "~s: " (car error-msg))
+  (apply format `(#t ,@(cdr error-msg)))
+  (newline))
+
+(set! error-handler
+  (lambda error-msg
+    (error-print error-msg)
+    (let loop ((intr-level (enable-interrupts)))
+      (if (positive? intr-level)
+	  (loop (enable-interrupts))))
+    (let loop ()
+      (if (call-with-current-continuation
+	   (lambda (control-point)
+	     (push-frame control-point)
+	     (rep-loop (the-environment))
+	     #f))
+	  (begin
+	    (pop-frame)
+	    (loop))))
+    (newline)
+    (pop-frame)
+    (let ((next-frame (car rep-frames)))
+      (next-frame #t))))
+
+(define top-level-environment (the-environment))
+
+(define (top-level)
+  (let loop ()
+    ;;; Allow GC to free old rep-frames when we get here on "reset":
+    (set! rep-frames (list top-level-control-point))
+    (if (call-with-current-continuation
+	 (lambda (control-point)
+	   (set! rep-frames (list control-point))
+	   (set! top-level-control-point control-point)
+	   (set! rep-level 0)
+	   (rep-loop top-level-environment)
+	   #f))
+	(loop))))
+
+(define (the-top-level)
+  (top-level)
+  (newline)
+  (exit))
+
+(the-top-level)