Primitive expand numerical comparisons with more than 2 arguments.
[bpt/guile.git] / guile-readline / readline.c
index c0fe8ec..68c8e60 100644 (file)
@@ -1,10 +1,10 @@
 /* readline.c --- line editing support for Guile */
 
-/* Copyright (C) 1997,1999,2000,2001, 2002, 2003 Free Software Foundation, Inc.
+/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010, 2013 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
- * the Free Software Foundation; either version 2, or (at your option)
+ * the Free Software Foundation; either version 3, or (at your option)
  * any later version.
  * 
  * This program is distributed in the hope that it will be useful,
  * 
  * You should have received a copy of the GNU General Public License
  * along with this software; see the file COPYING.  If not, write to
- * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
- * Boston, MA 02111-1307 USA
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301 USA
  *
  */
 
 
 \f
-
-#if HAVE_CONFIG_H
-#  include <config.h>
+#ifdef HAVE_CONFIG_H
+# include <config.h>
 #endif
 
-#include "libguile/_scm.h"
 #ifdef HAVE_RL_GETC_FUNCTION
 #include "libguile.h"
-#include "libguile/gh.h"
-#include "libguile/iselect.h"
 
 #include <stdio.h>
-#ifdef HAVE_UNISTD_H
 #include <unistd.h>
-#endif
 #include <readline/readline.h>
 #include <readline/history.h>
-#ifndef __MINGW32__
 #include <sys/time.h>
-#else
-#include <io.h>
-#endif
+#include <sys/select.h>
 #include <signal.h>
 
 #include "libguile/validate.h"
@@ -54,7 +45,8 @@ scm_t_option scm_readline_opts[] = {
   { SCM_OPTION_INTEGER, "history-length", 200,
     "History length." },
   { SCM_OPTION_INTEGER, "bounce-parens", 500,
-    "Time (ms) to show matching opening parenthesis (0 = off)."}
+    "Time (ms) to show matching opening parenthesis (0 = off)."},
+  { 0 }
 };
 
 extern void stifle_history (int max);
@@ -66,7 +58,6 @@ SCM_DEFINE (scm_readline_options, "readline-options-interface", 0, 1, 0,
 {
   SCM ans = scm_options (setting,
                         scm_readline_opts,
-                        SCM_N_READLINE_OPTIONS,
                         FUNC_NAME);
   stifle_history (SCM_HISTORY_LENGTH);
   return ans;
@@ -131,6 +122,7 @@ rl_free_line_state ()
 
 static int promptp;
 static SCM input_port;
+static SCM output_port;
 static SCM before_read;
 
 static int
@@ -141,14 +133,14 @@ current_input_getc (FILE *in SCM_UNUSED)
       scm_apply (before_read, SCM_EOL, SCM_EOL);
       promptp = 0;
     }
-  return scm_getc (input_port);
+  return scm_get_byte_or_eof (input_port);
 }
 
 static int in_readline = 0;
 static SCM reentry_barrier_mutex;
 
 static SCM internal_readline (SCM text);
-static SCM handle_error (void *data, SCM tag, SCM args);
+static void unwind_readline (void *unused);
 static void reentry_barrier (void);
 
 
@@ -172,7 +164,7 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0,
        }
     }
   
-  if (!((SCM_UNBNDP (inp) && SCM_OPINFPORTP (scm_cur_inp))
+  if (!((SCM_UNBNDP (inp) && SCM_OPINFPORTP (scm_current_input_port ()))
        || SCM_OPINFPORTP (inp)))
     {
       --in_readline;
@@ -181,7 +173,7 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0,
                      SCM_EOL);
     }
   
-  if (!((SCM_UNBNDP (outp) && SCM_OPOUTFPORTP (scm_cur_outp))
+  if (!((SCM_UNBNDP (outp) && SCM_OPOUTFPORTP (scm_current_output_port ()))
        || SCM_OPOUTFPORTP (outp)))
     {
       --in_readline;
@@ -202,15 +194,15 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0,
 
   scm_readline_init_ports (inp, outp);
 
-  ans = scm_internal_catch (SCM_BOOL_T,
-                           (scm_t_catch_body) internal_readline,
-                           (void *) SCM_UNPACK (text),
-                           handle_error, 0);
+  scm_dynwind_begin (0);
+  scm_dynwind_unwind_handler (unwind_readline, NULL, 0);
+  
+  ans = internal_readline (text);
+
+  scm_dynwind_end ();
 
-#ifndef __MINGW32__
   fclose (rl_instream);
   fclose (rl_outstream);
-#endif
 
   --in_readline;
   return ans;
@@ -233,19 +225,16 @@ reentry_barrier ()
     scm_misc_error (s_scm_readline, "readline is not reentrant", SCM_EOL);
 }
 
-static SCM
-handle_error (void *data, SCM tag, SCM args)
+/* This function is only called on nonlocal exit from readline(). */
+static void
+unwind_readline (void *unused)
 {
   rl_free_line_state ();
   rl_cleanup_after_signal ();
   fputc ('\n', rl_outstream); /* We don't want next output on this line */
-#ifndef __MINGW32__
   fclose (rl_instream);
   fclose (rl_outstream);
-#endif
   --in_readline;
-  scm_handle_by_throw (data, tag, args);
-  return SCM_UNSPECIFIED; /* never reached */
 }
 
 static SCM
@@ -258,7 +247,12 @@ internal_readline (SCM text)
   promptp = 1;
   s = readline (prompt);
   if (s)
-    ret = scm_from_locale_string (s);
+    {
+      scm_t_port *pt = SCM_PTAB_ENTRY (output_port);
+      
+      ret = scm_from_stringn (s, strlen (s), pt->encoding, 
+                              SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
+    }
   else 
     ret = SCM_EOF_VAL;
 
@@ -296,10 +290,10 @@ void
 scm_readline_init_ports (SCM inp, SCM outp)
 {
   if (SCM_UNBNDP (inp))
-    inp = scm_cur_inp;
+    inp = scm_current_input_port ();
   
   if (SCM_UNBNDP (outp))
-    outp = scm_cur_outp;
+    outp = scm_current_output_port ();
   
   if (!SCM_OPINFPORTP (inp)) {
     scm_misc_error (0,
@@ -314,10 +308,9 @@ scm_readline_init_ports (SCM inp, SCM outp)
   }
 
   input_port = inp;
-#ifndef __MINGW32__
+  output_port = outp;
   rl_instream = stream_from_fport (inp, "r", s_scm_readline);
   rl_outstream = stream_from_fport (outp, "w", s_scm_readline);
-#endif
 }
 
 
@@ -331,6 +324,7 @@ SCM_DEFINE (scm_add_history, "add-history", 1, 0, 0,
 
   s = scm_to_locale_string (text);
   add_history (s);
+  free (s);
 
   return SCM_UNSPECIFIED;
 }
@@ -426,6 +420,7 @@ completion_function (char *text, int continuep)
     }
 }
 
+#if HAVE_RL_GET_KEYMAP
 /*Bouncing parenthesis (reimplemented by GH, 11/23/98, since readline is strict gpl)*/
 
 static int match_paren (int x, int k);
@@ -487,11 +482,9 @@ static int
 match_paren (int x, int k)
 {
   int tmp;
-#ifndef __MINGW32__
   int fno;
-  SELECT_TYPE readset;
+  fd_set readset;
   struct timeval timeout;
-#endif
 
   rl_insert (x, k);
   if (!SCM_READLINE_BOUNCE_PARENS)
@@ -502,14 +495,12 @@ match_paren (int x, int k)
       && rl_line_buffer[rl_point - 2] == '\\')
     return 0;
 
-#ifndef __MINGW32__
   tmp = 1000 * SCM_READLINE_BOUNCE_PARENS;
   timeout.tv_sec = tmp / 1000000;
   timeout.tv_usec = tmp % 1000000;
   FD_ZERO (&readset);
   fno = fileno (rl_instream);
   FD_SET (fno, &readset);
-#endif
 
   if (rl_point > 1)
     {
@@ -518,37 +509,13 @@ match_paren (int x, int k)
       if (rl_point > -1)
        {
          rl_redisplay ();
-#ifndef __MINGW32__
-         scm_internal_select (fno + 1, &readset, NULL, NULL, &timeout);
-#else
-         WaitForSingleObject (GetStdHandle(STD_INPUT_HANDLE),
-                              SCM_READLINE_BOUNCE_PARENS); 
-#endif
+         select (fno + 1, &readset, NULL, NULL, &timeout);
        }
       rl_point = tmp;
     }
   return 0;
 }
-
-#if defined (HAVE_RL_PRE_INPUT_HOOK) && defined (GUILE_SIGWINCH_SA_RESTART_CLEARED)
-/* Readline disables SA_RESTART on SIGWINCH.
- * This code turns it back on.
- */
-static int
-sigwinch_enable_restart (void)
-{
-#ifdef HAVE_SIGINTERRUPT
-  siginterrupt (SIGWINCH, 0);
-#else
-  struct sigaction action;
-  
-  sigaction (SIGWINCH, NULL, &action);
-  action.sa_flags |= SA_RESTART;
-  sigaction (SIGWINCH, &action, NULL);
-#endif
-  return 0;
-}
-#endif
+#endif /* HAVE_RL_GET_KEYMAP */
 
 #endif /* HAVE_RL_GETC_FUNCTION */
 
@@ -559,25 +526,31 @@ scm_init_readline ()
 #include "guile-readline/readline.x"
   scm_readline_completion_function_var
     = scm_c_define ("*readline-completion-function*", SCM_BOOL_F);
-#ifndef __MINGW32__
   rl_getc_function = current_input_getc;
-#endif
 #if defined (_RL_FUNCTION_TYPEDEF)
   rl_completion_entry_function = (rl_compentry_func_t*) completion_function;
 #else  
   rl_completion_entry_function = (Function*) completion_function;
 #endif
-  rl_basic_word_break_characters = "\t\n\"'`;()";
+  rl_basic_word_break_characters = " \t\n\"'`;()";
   rl_readline_name = "Guile";
-#if defined (HAVE_RL_PRE_INPUT_HOOK) && defined (GUILE_SIGWINCH_SA_RESTART_CLEARED)
-  rl_pre_input_hook = sigwinch_enable_restart;
-#endif
 
-  reentry_barrier_mutex = scm_permanent_object (scm_make_mutex ());
+  /* Let Guile handle signals. */
+#if defined (HAVE_DECL_RL_CATCH_SIGNALS) && HAVE_DECL_RL_CATCH_SIGNALS
+  rl_catch_signals = 0;
+#endif
+  
+  /* But let readline handle SIGWINCH. */
+#if defined (HAVE_DECL_RL_CATCH_SIGWINCH) && HAVE_DECL_RL_CATCH_SIGWINCH
+  rl_catch_sigwinch = 1;
+#endif
+  
+  reentry_barrier_mutex = scm_make_mutex ();
   scm_init_opts (scm_readline_options,
-                scm_readline_opts,
-                SCM_N_READLINE_OPTIONS);
+                scm_readline_opts);
+#if HAVE_RL_GET_KEYMAP
   init_bouncing_parens();
+#endif
   scm_add_feature ("readline");
 #endif /* HAVE_RL_GETC_FUNCTION */
 }