*** empty log message ***

[bpt/guile.git] / libguile / readline.c

diff --git a/libguile/readline.c b/libguile/readline.c
index a2d51cf..7861e0d 100644 (file)
--- a/libguile/readline.c
+++ b/libguile/readline.c
@@ -43,13 +43,92 @@
 \f
 
 #include "_scm.h"
-#ifdef HAVE_RL_GETC_FUNCTION
+#if defined (HAVE_RL_GETC_FUNCTION)
 #include <libguile.h>
 #include <readline.h>
 #include <gh.h>
 #include <readline/readline.h>
 #include <readline/history.h>
 
+scm_option scm_readline_opts[] = {
+  { SCM_OPTION_BOOLEAN, "history-file", 1,
+    "Use history file." },
+  { SCM_OPTION_INTEGER, "history-length", 200,
+    "History length." }
+};
+
+extern void stifle_history (int max);
+
+SCM_PROC (s_readline_options, "readline-options-interface", 0, 1, 0, scm_readline_options);
+
+SCM
+scm_readline_options (setting)
+     SCM setting;
+{
+  SCM ans = scm_options (setting,
+                        scm_readline_opts,
+                        SCM_N_READLINE_OPTIONS,
+                        s_readline_options);
+  stifle_history (SCM_HISTORY_LENGTH);
+  return ans;
+}
+
+#ifndef HAVE_STRDUP
+static char *
+strdup (char *s)
+{
+  int len = strlen (s);
+  char *new = malloc (len + 1);
+  strcpy (new, s);
+  return new;
+}
+#endif /* HAVE_STRDUP */
+
+#ifndef HAVE_RL_CLEANUP_AFTER_SIGNAL
+
+/* These are readline functions added in release 2.3.  They will work
+ * together with readline-2.1 and 2.2.  (The readline interface is
+ * disabled for earlier releases.)
+ * They are declared static; if we want to use them elsewhere, then
+ * we need external declarations for them, but at the moment, I don't
+ * think anything else in Guile ought to use these.
+ */
+
+extern void _rl_clean_up_for_exit ();
+extern void _rl_kill_kbd_macro ();
+extern int _rl_init_argument ();
+
+static void
+rl_cleanup_after_signal ()
+{
+#ifdef HAVE_RL_CLEAR_SIGNALS
+  _rl_clean_up_for_exit ();
+#endif
+  (*rl_deprep_term_function) ();
+#ifdef HAVE_RL_CLEAR_SIGNALS
+  rl_clear_signals ();
+#endif
+  rl_pending_input = 0;
+}
+
+static void
+rl_free_line_state ()
+{
+  register HIST_ENTRY *entry;
+   
+  free_undo_list ();
+
+  entry = current_history ();
+  if (entry)
+    entry->data = (char *)NULL; 
+  
+  _rl_kill_kbd_macro ();
+  rl_clear_message ();
+  _rl_init_argument ();
+}
+
+#endif /* !HAVE_RL_CLEANUP_AFTER_SIGNAL */
+
 static int promptp;
 static SCM input_port;
 static SCM before_read;
@@ -103,10 +182,8 @@ reentry_barrier ()
 static SCM
 handle_error (void *data, SCM tag, SCM args)
 {
-  (*rl_deprep_term_function) ();
-#ifdef HAVE_RL_CLEAR_SIGNALS
-  rl_clear_signals ();
-#endif
+  rl_free_line_state ();
+  rl_cleanup_after_signal ();
   --in_readline;
   scm_handle_by_throw (data, tag, args);
   return SCM_UNSPECIFIED; /* never reached */
@@ -209,8 +286,30 @@ scm_add_history (SCM text)
   return SCM_UNSPECIFIED;
 }
 
-static SCM subr_filename_completion_function;
-static char s_filename_completion_function[] = "filename-completion-function";
+
+SCM_PROC (s_read_history, "read-history", 1, 0, 0, scm_read_history);
+
+SCM
+scm_read_history (SCM file)
+{
+  SCM_ASSERT (SCM_NIMP (file) && SCM_STRINGP (file),
+             file, SCM_ARG1, s_read_history);
+  return read_history (SCM_ROCHARS (file)) ? SCM_BOOL_F : SCM_BOOL_T;
+}
+
+
+SCM_PROC (s_write_history, "write-history", 1, 0, 0, scm_write_history);
+
+SCM
+scm_write_history (SCM file)
+{
+  SCM_ASSERT (SCM_NIMP (file) && SCM_STRINGP (file),
+             file, SCM_ARG1, s_write_history);
+  return write_history (SCM_ROCHARS (file)) ? SCM_BOOL_F : SCM_BOOL_T;
+}
+
+
+SCM_PROC (s_filename_completion_function, "filename-completion-function", 2, 0, 0, scm_filename_completion_function);
 
 SCM
 scm_filename_completion_function (SCM text, SCM continuep)
@@ -266,10 +365,6 @@ void
 scm_init_readline ()
 {
 #include "readline.x"
-  subr_filename_completion_function
-    = scm_make_subr (s_filename_completion_function,
-                    scm_tc7_subr_2,
-                    scm_filename_completion_function);
   scm_readline_completion_function_var
     = scm_sysintern ("*readline-completion-function*", SCM_BOOL_F);
   rl_getc_function = current_input_getc;
@@ -278,6 +373,9 @@ scm_init_readline ()
 #ifdef USE_THREADS
   scm_mutex_init (&reentry_barrier_mutex);
 #endif
+  scm_init_opts (scm_readline_options,
+                scm_readline_opts,
+                SCM_N_READLINE_OPTIONS);
   scm_add_feature ("readline");
 }