/* readline.c --- line editing support for Guile */
-/* Copyright (C) 1997,1999,2000,2001 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
*
*/
-/* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
- gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
\f
+#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>
#include <sys/time.h>
+#include <sys/select.h>
#include <signal.h>
#include "libguile/validate.h"
{ 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);
{
SCM ans = scm_options (setting,
scm_readline_opts,
- SCM_N_READLINE_OPTIONS,
FUNC_NAME);
stifle_history (SCM_HISTORY_LENGTH);
return ans;
static int promptp;
static SCM input_port;
+static SCM output_port;
static SCM before_read;
static int
current_input_getc (FILE *in SCM_UNUSED)
{
- if (promptp && !SCM_FALSEP (before_read))
+ if (promptp && scm_is_true (before_read))
{
scm_apply (before_read, SCM_EOL, SCM_EOL);
promptp = 0;
}
- return scm_getc (input_port);
-}
-
-static void
-redisplay ()
-{
- rl_redisplay ();
- /* promptp = 1; */
+ return scm_get_byte_or_eof (input_port);
}
static int in_readline = 0;
-#ifdef USE_THREADS
-static scm_t_mutex reentry_barrier_mutex;
-#endif
+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);
if (!SCM_UNBNDP (text))
{
- if (!SCM_STRINGP (text))
+ if (!scm_is_string (text))
{
--in_readline;
scm_wrong_type_arg (s_scm_readline, SCM_ARG1, text);
}
- SCM_STRING_COERCE_0TERMINATION_X (text);
}
- if (!((SCM_UNBNDP (inp) && SCM_OPINFPORTP (scm_cur_inp))
+ if (!((SCM_UNBNDP (inp) && SCM_OPINFPORTP (scm_current_input_port ()))
|| SCM_OPINFPORTP (inp)))
{
--in_readline;
SCM_EOL);
}
- if (!((SCM_UNBNDP (outp) && SCM_OPINFPORTP (scm_cur_outp))
+ if (!((SCM_UNBNDP (outp) && SCM_OPOUTFPORTP (scm_current_output_port ()))
|| SCM_OPOUTFPORTP (outp)))
{
--in_readline;
SCM_EOL);
}
- if (!(SCM_UNBNDP (read_hook) || SCM_FALSEP (read_hook)))
+ if (!(SCM_UNBNDP (read_hook) || scm_is_false (read_hook)))
{
- if (!(SCM_NFALSEP (scm_thunk_p (read_hook))))
+ if (scm_is_false (scm_thunk_p (read_hook)))
{
--in_readline;
scm_wrong_type_arg (s_scm_readline, SCM_ARG4, read_hook);
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 ();
fclose (rl_instream);
fclose (rl_outstream);
reentry_barrier ()
{
int reentryp = 0;
-#ifdef USE_THREADS
- /* We should rather use scm_t_mutexry_lock when it becomes available */
- scm_mutex_lock (&reentry_barrier_mutex);
-#endif
+ /* We should rather use scm_try_mutex when it becomes available */
+ scm_lock_mutex (reentry_barrier_mutex);
if (in_readline)
reentryp = 1;
else
++in_readline;
-#ifdef USE_THREADS
- scm_mutex_unlock (&reentry_barrier_mutex);
-#endif
+ scm_unlock_mutex (reentry_barrier_mutex);
if (reentryp)
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 ();
fclose (rl_instream);
fclose (rl_outstream);
--in_readline;
- scm_handle_by_throw (data, tag, args);
- return SCM_UNSPECIFIED; /* never reached */
}
static SCM
{
SCM ret;
char *s;
- char *prompt = SCM_UNBNDP (text) ? "" : SCM_STRING_CHARS (text);
+ char *prompt = SCM_UNBNDP (text) ? "" : scm_to_locale_string (text);
promptp = 1;
s = readline (prompt);
if (s)
- ret = scm_makfrom0str (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;
+ if (!SCM_UNBNDP (text))
+ free (prompt);
free (s);
return ret;
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,
}
input_port = inp;
+ output_port = outp;
rl_instream = stream_from_fport (inp, "r", s_scm_readline);
rl_outstream = stream_from_fport (outp, "w", s_scm_readline);
}
#define FUNC_NAME s_scm_add_history
{
char* s;
- SCM_VALIDATE_STRING (1,text);
- SCM_STRING_COERCE_0TERMINATION_X (text);
- s = SCM_STRING_CHARS (text);
- add_history (strdup (s));
+ s = scm_to_locale_string (text);
+ add_history (s);
+ free (s);
return SCM_UNSPECIFIED;
}
"")
#define FUNC_NAME s_scm_read_history
{
- SCM_VALIDATE_STRING (1,file);
- return SCM_NEGATE_BOOL (read_history (SCM_STRING_CHARS (file)));
+ char *filename;
+ SCM ret;
+
+ filename = scm_to_locale_string (file);
+ ret = scm_from_bool (!read_history (filename));
+ free (filename);
+ return ret;
}
#undef FUNC_NAME
"")
#define FUNC_NAME s_scm_write_history
{
- SCM_VALIDATE_STRING (1,file);
- return SCM_NEGATE_BOOL (write_history (SCM_STRING_CHARS (file)));
+ char *filename;
+ SCM ret;
+
+ filename = scm_to_locale_string (file);
+ ret = scm_from_bool (!write_history (filename));
+ free (filename);
+ return ret;
}
#undef FUNC_NAME
{
char *s;
SCM ans;
- SCM_VALIDATE_STRING (1,text);
- SCM_STRING_COERCE_0TERMINATION_X (text);
+ char *c_text = scm_to_locale_string (text);
#ifdef HAVE_RL_FILENAME_COMPLETION_FUNCTION
- s = rl_filename_completion_function (SCM_STRING_CHARS (text), SCM_NFALSEP (continuep));
+ s = rl_filename_completion_function (c_text, scm_is_true (continuep));
#else
- s = filename_completion_function (SCM_STRING_CHARS (text), SCM_NFALSEP (continuep));
+ s = filename_completion_function (c_text, scm_is_true (continuep));
#endif
- ans = scm_makfrom0str (s);
- free (s);
+ ans = scm_take_locale_string (s);
+ free (c_text);
return ans;
}
#undef FUNC_NAME
SCM compfunc = SCM_VARIABLE_REF (scm_readline_completion_function_var);
SCM res;
- if (SCM_FALSEP (compfunc))
+ if (scm_is_false (compfunc))
return NULL; /* #f => completion disabled */
else
{
- SCM t = scm_makfrom0str (text);
- SCM c = continuep ? SCM_BOOL_T : SCM_BOOL_F;
- res = scm_apply (compfunc, SCM_LIST2 (t, c), SCM_EOL);
+ SCM t = scm_from_locale_string (text);
+ SCM c = scm_from_bool (continuep);
+ res = scm_apply (compfunc, scm_list_2 (t, c), SCM_EOL);
- if (SCM_FALSEP (res))
+ if (scm_is_false (res))
return NULL;
- if (!SCM_STRINGP (res))
- scm_misc_error (s_scm_readline,
- "Completion function returned bogus value: %S",
- SCM_LIST1 (res));
- SCM_STRING_COERCE_0TERMINATION_X (res);
- return strdup (SCM_STRING_CHARS (res));
+ return scm_to_locale_string (res);
}
}
+#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);
static int
match_paren (int x, int k)
{
- int tmp, fno;
- SELECT_TYPE readset;
+ int tmp;
+ int fno;
+ fd_set readset;
struct timeval timeout;
-
+
rl_insert (x, k);
if (!SCM_READLINE_BOUNCE_PARENS)
return 0;
FD_ZERO (&readset);
fno = fileno (rl_instream);
FD_SET (fno, &readset);
-
+
if (rl_point > 1)
{
tmp = rl_point;
if (rl_point > -1)
{
rl_redisplay ();
- scm_internal_select (fno + 1, &readset, NULL, NULL, &timeout);
+ 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 */
scm_readline_completion_function_var
= scm_c_define ("*readline-completion-function*", SCM_BOOL_F);
rl_getc_function = current_input_getc;
- rl_redisplay_function = redisplay;
#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
-#ifdef USE_THREADS
- scm_mutex_init (&reentry_barrier_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 */
}