Merge pull request #190 from KeenS/editline

Readline binding

contrib/10.readline/CMakeLists.txt

@@ -0,0 +1,18 @@
+# readline
+
+set(CMAKE_MODULE_PATH ${CMAKE_MODULE_PATH} "${PROJECT_SOURCE_DIR}/contrib/10.readline/cmake/")
+
+find_package(Libedit)
+if (Libedit_FOUND)
+  add_definitions(${Libedit_DEFINITIONS} -DPIC_READLINE_FOUND=1)
+  add_definitions(${Libedit_DEFINITIONS} -DPIC_READLINE_INCLUDE_DIR_SUFFIX=${Libedit_INCLUDE_DIR_SUFFIX})
+  include_directories(${Libedit_INCLUDE_DIR})
+
+  file(GLOB PICRIN_READLINE_SOURCES ${PROJECT_SOURCE_DIR}/contrib/10.readline/src/*.c)
+
+  list(APPEND PICRIN_CONTRIB_INITS readline)
+  list(APPEND PICRIN_CONTRIB_LIBRARIES ${Libedit_LIBRARIES})
+  list(APPEND PICRIN_CONTRIB_SOURCES ${PICRIN_READLINE_SOURCES})
+  add_custom_target(test-readline for test in ${PROJECT_SOURCE_DIR}/contrib/10.readline/t/*.scm \; do bin/picrin "$$test" \; done DEPENDS repl)
+  set(CONTRIB_TESTS ${CONTRIB_TESTS} test-readline)
+endif()

contrib/10.readline/cmake/FindLibedit.cmake

@@ -30,9 +30,10 @@ else (Libedit_LIBRARIES AND Libedit_INCLUDE_DIRS)
       pkg_check_modules(_LIBEDIT libedit)
     endif (PKG_CONFIG_FOUND)
   endif (${CMAKE_MAJOR_VERSION} EQUAL 2 AND ${CMAKE_MINOR_VERSION} EQUAL 4)
-  find_path(Libedit_INCLUDE_DIR
+  find_path(Libedit_EDITLINE_INCLUDE_DIR
     NAMES
-      histedit.h
+      readline.h
+      history.h
     PATHS
       ${_Libedit_INCLUDEDIR}
       /usr/include
@@ -42,7 +43,28 @@ else (Libedit_LIBRARIES AND Libedit_INCLUDE_DIRS)
     PATH_SUFFIXES
       editline
   )
-  
+  if (Libedit_EDITLINE_INCLUDE_DIR)
+    set(Libedit_INCLUDE_DIR_SUFFIX editline)
+    set(Libedit_INCLUDE_DIR ${Libedit_EDITLINE_INCLUDE_DIR})
+  else (Libedit_EDITLINE_INCLUDE_DIR)
+    find_path(Libedit_READLINE_INCLUDE_DIR
+      NAMES
+        readline.h
+        history.h
+      PATHS
+        /usr/include/edit
+        /usr/local/include/edit
+        /opt/local/include/edit
+        /sw/include/edit
+      PATH_SUFFIXES
+        readline
+        )
+    if (Libedit_READLINE_INCLUDE_DIR)
+      set(Libedit_INCLUDE_DIR_SUFFIX readline)
+      set(Libedit_INCLUDE_DIR ${Libedit_READLINE_INCLUDE_DIR})
+    endif (Libedit_READLINE_INCLUDE_DIR)
+  endif (Libedit_EDITLINE_INCLUDE_DIR)
+
   find_library(Libedit_LIBRARY
     NAMES
       edit

contrib/10.readline/example/simple-repl.scm

@@ -0,0 +1,15 @@
+(import (scheme base)
+        (scheme read)
+        (scheme eval)
+        (scheme write)
+        (picrin readline)
+        (picrin readline history))
+(let loop ((n 1))
+  (let ((input (readline "> ")))
+    (if (eof-object? input)
+        (newline)
+        (begin
+          (add-history input)
+          (write (eval (read (open-input-string input)) '(picrin user)))
+          (newline)
+          (loop 1)))))

contrib/10.readline/src/readline.c

@@ -0,0 +1,283 @@
+/*
+  cc -g test.c -o test -ledit -ltermcap
+*/
+
+/* This will include all our libedit functions.  If you use C++ don't
+forget to use the C++ extern "C" to get it to compile.
+*/
+#include "picrin.h"
+#include "picrin/pair.h"
+#include "picrin/string.h"
+#include "picrin/port.h"
+
+#if PIC_READLINE_INCLUDE_DIR_SUFFIX == readline
+#include <readline/readline.h>
+#include <readline/history.h>
+#else
+#include <editline/readline.h>
+#include <editline/history.h>
+#endif
+
+static pic_value
+pic_rl_readline(pic_state *pic)
+{
+  char *prompt, *result;
+  
+  pic_get_args(pic, "z", &prompt);
+
+  result = readline(prompt);
+
+  if(result)
+    return pic_obj_value(pic_str_new_cstr(pic, result));
+  else
+    return pic_eof_object();
+}
+
+static pic_value
+pic_rl_history_length(pic_state *pic)
+{
+  pic_get_args(pic, "");
+
+  return pic_int_value(history_get_history_state()->length);
+}
+
+static pic_value
+pic_rl_add_history(pic_state *pic)
+{
+  char *line;
+
+  pic_get_args(pic, "z", &line);
+
+  add_history(line);
+
+  return pic_undef_value();
+}
+
+static pic_value
+pic_rl_stifle_history(pic_state *pic)
+{
+  int  i;
+  
+  pic_get_args(pic, "i", &i);
+
+  stifle_history(i);
+
+  return pic_undef_value();
+}
+
+static pic_value
+pic_rl_unstifle_history(pic_state *pic)
+{
+  pic_get_args(pic, "");
+
+  unstifle_history();
+  
+  return pic_undef_value();
+}
+
+static pic_value
+pic_rl_history_is_stifled(pic_state *pic)
+{
+  pic_get_args(pic, "");
+
+  return pic_bool_value(history_is_stifled());
+}
+
+static pic_value
+pic_rl_where_history(pic_state *pic)
+{
+  pic_get_args(pic, "");
+
+  return pic_int_value(where_history());
+}
+
+static pic_value
+pic_rl_current_history(pic_state *pic)
+{
+  pic_get_args(pic, "");
+
+  return pic_obj_value(pic_str_new_cstr(pic, current_history()->line));
+}
+
+static pic_value
+pic_rl_history_get(pic_state *pic)
+{
+  int i;
+  HIST_ENTRY *e;
+
+  pic_get_args(pic, "i", &i);
+  
+  e = history_get(i);
+
+  return e ? pic_obj_value(pic_str_new_cstr(pic, e->line))
+    : pic_false_value();
+}
+
+static pic_value
+pic_rl_remove_history(pic_state *pic)
+{
+  int i;
+  HIST_ENTRY *e;
+
+  pic_get_args(pic, "i", &i);
+  
+  e = remove_history(i);
+
+  return e ? pic_obj_value(pic_str_new_cstr(pic, e->line))
+    : pic_false_value();
+}
+
+static pic_value
+pic_rl_clear_history(pic_state *pic)
+{
+  pic_get_args(pic, "");
+
+  clear_history();
+
+  return pic_undef_value();
+}
+
+static pic_value
+pic_rl_history_set_pos(pic_state *pic)
+{
+  int i;
+
+  pic_get_args(pic, "i", &i);
+
+
+  return pic_int_value(history_set_pos(i));
+}
+
+static pic_value
+pic_rl_previous_history(pic_state *pic)
+{
+  HIST_ENTRY *e;
+
+  pic_get_args(pic, "");
+
+  e = previous_history();
+
+  return e ? pic_obj_value(pic_str_new_cstr(pic, e->line))
+    : pic_false_value();
+}
+
+static pic_value
+pic_rl_next_history(pic_state *pic)
+{
+  HIST_ENTRY *e;
+
+  pic_get_args(pic, "");
+
+  e = next_history();
+
+  return e ? pic_obj_value(pic_str_new_cstr(pic, e->line))
+    : pic_false_value();
+}
+
+static pic_value
+pic_rl_history_search(pic_state *pic)
+{
+  char *key;
+  int direction, pos, argc;
+
+  argc = pic_get_args(pic, "zi|i", &key, &direction, &pos);
+  if(argc == 2)
+    return pic_int_value(history_search(key, direction));
+  else
+    return pic_int_value(history_search_pos(key, direction, pos));
+}
+
+static pic_value
+pic_rl_history_search_prefix(pic_state *pic)
+{
+  char *key;
+  int direction;
+
+  pic_get_args(pic, "zi", &key, &direction);
+
+  return pic_int_value(history_search_prefix(key, direction));
+}
+
+static pic_value
+pic_rl_read_history(pic_state *pic)
+{
+  char *filename;
+
+  pic_get_args(pic, "z", &filename);
+
+  if(read_history(filename))
+    pic_errorf(pic, "cannot read history file : %s", filename);
+  
+  return pic_undef_value();
+}
+
+static pic_value
+pic_rl_write_history(pic_state *pic)
+{
+  char *filename;
+
+  pic_get_args(pic, "z", &filename);
+
+  if(write_history(filename))
+    pic_errorf(pic, "cannot write history file: %s", filename);
+  
+  return pic_undef_value();
+}
+
+static pic_value
+pic_rl_truncate_file(pic_state *pic)
+{
+  char *filename;
+  int i;
+
+  pic_get_args(pic, "zi", &filename, &i);
+
+  history_truncate_file(filename, i);
+  
+  return pic_undef_value();
+}
+
+static pic_value
+pic_rl_history_expand(pic_state *pic)
+{
+  char *input, *result;
+  int status;
+
+  pic_get_args(pic, "z", &input);
+  
+  status = history_expand(input,  &result);
+  if(status == -1 || status == 2)
+    pic_errorf(pic, "%s\n", result);
+
+  return pic_obj_value(pic_str_new_cstr(pic, result));
+}
+
+void
+pic_init_readline(pic_state *pic){
+  using_history();
+  pic_deflibrary (pic, "(picrin readline)") {
+    pic_defun(pic, "readline", pic_rl_readline);
+  }
+  pic_deflibrary (pic, "(picrin readline history)") {
+    /* pic_defun(pic, "history-offset", pic_rl_history_offset); */
+    pic_defun(pic, "history-length", pic_rl_history_length);
+    pic_defun(pic, "add-history", pic_rl_add_history);
+    pic_defun(pic, "stifle-history", pic_rl_stifle_history);
+    pic_defun(pic, "unstifle-history", pic_rl_unstifle_history);
+    pic_defun(pic, "history-stifled?", pic_rl_history_is_stifled);
+    pic_defun(pic, "where-history", pic_rl_where_history);
+    pic_defun(pic, "current-history", pic_rl_current_history);
+    pic_defun(pic, "history-get", pic_rl_history_get);
+    pic_defun(pic, "clear-history", pic_rl_clear_history);
+    pic_defun(pic, "remove-history", pic_rl_remove_history);
+    pic_defun(pic, "history-set-pos", pic_rl_history_set_pos);
+    pic_defun(pic, "previous-history", pic_rl_previous_history);
+    pic_defun(pic, "next-history", pic_rl_next_history);
+    pic_defun(pic, "history-search", pic_rl_history_search);
+    pic_defun(pic, "history-search-prefix", pic_rl_history_search_prefix);
+    pic_defun(pic, "read-history", pic_rl_read_history);
+    pic_defun(pic, "write-history", pic_rl_write_history);
+    pic_defun(pic, "truncate-file", pic_rl_truncate_file);
+    pic_defun(pic, "history-expand", pic_rl_history_expand);
+  }
+}

contrib/10.readline/t/test.scm

@@ -0,0 +1,322 @@
+(import (scheme base)
+        (picrin readline history)
+        (picrin test))
+  
+(define testfile "picrin_readline_test_file")
+(test-begin)
+
+(test 0 (history-length))
+(test 0 (where-history))
+(add-history "1")
+(test 1 (history-length))
+(test 1 (where-history))
+(let loop ((n 2))
+  (if (>= 10 n)
+      (begin
+        (add-history (number->string n))
+        (loop (+ n 1)))))
+#|
+index     0   1   2   3   4   5   6   7   8   9
+history  "1" "2" "3" "4" "5" "6" "7" "8" "9" "10"
+offset    1   2   3   4   5   6   7   8   9   10
+pos       10  9   8   7   6   5   4   3   2   1
+                                              p
+|#
+(test 10 (history-length))
+(test 1 (where-history))
+(stifle-history 7)
+#|
+index     0   1   2   3   4   5   6   7   8   9
+history  "1" "2" "3"|"4" "5" "6" "7" "8" "9" "10"
+offset    1   2   3   4   5   6   7   8   9   10
+pos       10  9   8   7   6   5   4   3   2   1
+                                              p
+|#
+(test 10 (history-length))
+(test 1 (where-history))
+(test 0 (history-set-pos 0))
+#|
+index     0   1   2   3   4   5   6   7   8   9
+history  "1" "2" "3"|"4" "5" "6" "7" "8" "9" "10"
+offset    1   2   3   4   5   6   7   8   9   10
+pos       10  9   8   7   6   5   4   3   2   1
+          p
+|#
+(test 10 (where-history))
+(add-history "11")
+#|
+index     0   1   2   3   4   5    6
+history  "5" "6" "7" "8" "9" "10" "11"
+offset    5   6   7   8   9   10   11
+pos       7   6   5   4   3   2    1
+                                   p
+|#
+(test 7 (history-length))
+(test 1 (where-history))
+(test #t (history-stifled?))
+(unstifle-history)
+(test #f (history-stifled?))
+(test 7 (history-length))
+(test 1 (where-history))
+(add-history "12")
+#|
+index     0   1   2   3   4   5    6    7
+history  "5" "6" "7" "8" "9" "10" "11" "12"
+offset    5   6   7   8   9   10   11   12
+pos       8   7   6   5   4   3    2    1
+                                        p
+|#
+(test 8 (history-length))
+(test 1 (where-history))
+(test "12" (current-history))
+(test 1 (where-history))
+(test #f (previous-history))
+#|
+index     0   1   2   3   4   5    6    7
+history  "5" "6" "7" "8" "9" "10" "11" "12"
+index     5   6   7   8   9   10   11   12
+pos       8   7   6   5   4   3    2    1
+                                        p
+|#
+(test 1 (where-history))
+(test "11" (next-history))
+#|
+index     0   1   2   3   4   5    6    7
+history  "5" "6" "7" "8" "9" "10" "11" "12"
+offset    5   6   7   8   9   10   11   12
+pos       8   7   6   5   4   3    2    1
+                                   p
+|#
+(test 2 (where-history))
+(test 0 (history-set-pos 5))
+#|
+index     0   1   2   3   4   5    6    7
+history  "5" "6" "7" "8" "9" "10" "11" "12"
+offset    5   6   7   8   9   10   11   12
+pos       8   7   6   5   4   3    2    1
+                              p
+|#
+(test 3 (where-history))
+(test -1 (history-set-pos (history-length)))
+(test 3 (where-history))
+(test -1 (history-set-pos -1))
+(test 3 (where-history))
+(test 0 (history-set-pos 0))
+#|
+index     0   1   2   3   4   5    6    7
+history  "5" "6" "7" "8" "9" "10" "11" "12"
+offset    5   6   7   8   9   10   11   12
+pos       8   7   6   5   4   3    2    1
+          p
+|#
+(test (history-length) (where-history))
+(test 0 (history-set-pos (- (history-length) 2)))
+#|
+index     0   1   2   3   4   5    6    7
+history  "5" "6" "7" "8" "9" "10" "11" "12"
+offset    5   6   7   8   9   10   11   12
+pos       8   7   6   5   4   3    2    1
+                                   p
+|#
+(test 2 (where-history))
+(test "11" (current-history))
+(test 2 (where-history))
+(test "12" (previous-history))
+#|
+index     0   1   2   3   4   5    6    7
+history  "5" "6" "7" "8" "9" "10" "11" "12"
+offset    5   6   7   8   9   10   11   12
+pos       8   7   6   5   4   3    2    1
+                                        p
+|#
+(test 1 (where-history))
+(test "11" (next-history))
+#|
+index     0   1   2   3   4   5    6    7
+history  "5" "6" "7" "8" "9" "10" "11" "12"
+offset    5   6   7   8   9   10   11   12
+pos       8   7   6   5   4   3    2    1
+                                        p
+|#
+(test 2 (where-history))
+(test "11" (history-get 11))
+(test "6" (remove-history 1))
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+              p
+|#
+(test 6 (where-history))
+(test "7" (current-history))
+(test "5" (next-history))
+(test #f (history-get 6))
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+          p
+|#
+(test 7 (history-length))
+(history-set-pos 6)
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+                                    p
+|#
+(test 0 (history-search "7" -1))
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+              p
+|#
+(test 6 (where-history))
+(history-set-pos 6)
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+                                    p
+|#
+(test -1 (history-search "7" 0))
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+                                    p
+|#
+(history-set-pos 0)
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+          p
+|#
+(test -1 (history-search "7" -1))
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+          p
+|#
+(test 7 (where-history))
+(history-set-pos 0)
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+          p
+|#
+(test 0 (history-search "7" 0))
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+              p
+|#
+(test 6 (where-history))
+(test 0 (history-search-prefix "1" 0))
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+                          p
+|#
+(test 3 (where-history))
+(history-set-pos 5)
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+                               p
+|#
+(test 0 (history-search-prefix "1" -1))
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+                               p
+|#
+(test 2 (where-history))
+(test 0 (history-search-prefix "1" 0))
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+                               p
+|#
+(test 2 (where-history))
+(test 0 (history-search-prefix "9" -1))
+#|
+index     0   1   2   3   4    5    6 
+history  "5" "7" "8" "9" "10" "11" "12"
+offset    5   7   8   9   10   11   12
+pos       7   6   5   4   3    2    1
+                      p
+|#
+(test 4 (where-history))
+(write-history testfile)
+(test 7 (history-length))
+(clear-history)
+#|
+index     
+history  
+offset   
+pos       
+             p
+|#
+(test 0 (history-length))
+(test 0 (where-history))
+(add-history "f")
+#|
+index      1
+history   "f"
+offset     1
+pos        1
+           p
+|#
+(test 1 (history-length))
+(test 1 (where-history))
+(test "f" (history-get 1))
+;(read-history testfile)
+;#|
+;index     0   1   2   3   4    5    6    7
+;history  "f" "5" "7" "8" "9" "10" "11" "12"
+;offset    1   2   3   4   5    6    7   8
+;pos       8   7   6   5   4    3    2   1
+;                                        p
+;|#
+(test 8 (history-length))
+(clear-history)
+(truncate-file testfile 5)
+;(read-history testfile)
+(test 5 (history-length))
+(clear-history)
+(add-history "foo")
+(add-history "bar")
+(add-history "baz")
+(test "baz" (history-expand "!b"))
+(test "baz" (history-expand "!!"))
+(test "bar" (history-expand "!?r?"))
+(add-history "com arg")
+(test "arg" (history-expand "!!:$"))
+(test "arg" (history-expand "!$"))
+(test "command arg" (history-expand "!!:s/com/command/"))
+
+(test-end)

tools/CMakeLists.txt

@@ -1,12 +1,5 @@
 list(APPEND REPL_LIBRARIES picrin)
 
-find_package(Libedit)
-if (Libedit_FOUND)
-  include_directories(${Libedit_INCLUDE_DIRS})
-  add_definitions(${Libedit_DEFINITIONS} -DPIC_READLINE_FOUND=1)
-  list(APPEND REPL_LIBRARIES ${Libedit_LIBRARIES})
-endif()
-
 # build
 add_executable(repl tools/main.c)
 set_target_properties(repl PROPERTIES OUTPUT_NAME picrin)