/* readline.c --- line editing support for Guile */
-/* Copyright (C) 1997,1999 Free Software Foundation, Inc.
+/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008 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
*
* 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
-#include "libguile/_scm.h"
-#if defined (HAVE_RL_GETC_FUNCTION)
-#include "libguile/libguile.h"
+/* Include private, configure generated header (i.e. config.h). */
+#include "guile-readline-config.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 <signal.h>
-#include "readline.h"
+#include "libguile/validate.h"
+#include "guile-readline/readline.h"
-scm_option scm_readline_opts[] = {
+scm_t_option scm_readline_opts[] = {
{ SCM_OPTION_BOOLEAN, "history-file", 1,
"Use history file." },
{ 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_PROC (s_readline_options, "readline-options-interface", 0, 1, 0, scm_readline_options);
-
-SCM
-scm_readline_options (setting)
- SCM setting;
+SCM_DEFINE (scm_readline_options, "readline-options-interface", 0, 1, 0,
+ (SCM setting),
+"")
+#define FUNC_NAME s_scm_readline_options
{
SCM ans = scm_options (setting,
scm_readline_opts,
- SCM_N_READLINE_OPTIONS,
- s_readline_options);
+ FUNC_NAME);
stifle_history (SCM_HISTORY_LENGTH);
return ans;
}
+#undef FUNC_NAME
#ifndef HAVE_STRDUP
static char *
strdup (char *s)
{
- int len = strlen (s);
+ size_t len = strlen (s);
char *new = malloc (len + 1);
strcpy (new, s);
return new;
static SCM before_read;
static int
-current_input_getc (FILE *in)
+current_input_getc (FILE *in SCM_UNUSED)
{
- SCM ans;
- if (promptp && SCM_NIMP (before_read))
+ if (promptp && scm_is_true (before_read))
{
scm_apply (before_read, SCM_EOL, SCM_EOL);
promptp = 0;
}
- ans = scm_getc (input_port);
- return ans;
+ return scm_getc (input_port);
}
-static void
-redisplay ()
+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 reentry_barrier (void);
+
+
+SCM_DEFINE (scm_readline, "%readline", 0, 4, 0,
+ (SCM text, SCM inp, SCM outp, SCM read_hook),
+"")
+#define FUNC_NAME s_scm_readline
{
- rl_redisplay ();
- /* promptp = 1; */
-}
+ SCM ans;
+
+ reentry_barrier ();
+
+ before_read = SCM_BOOL_F;
-SCM_PROC (s_readline, "%readline", 0, 4, 0, scm_readline);
+ if (!SCM_UNBNDP (text))
+ {
+ if (!scm_is_string (text))
+ {
+ --in_readline;
+ scm_wrong_type_arg (s_scm_readline, SCM_ARG1, text);
+ }
+ }
+
+ if (!((SCM_UNBNDP (inp) && SCM_OPINFPORTP (scm_current_input_port ()))
+ || SCM_OPINFPORTP (inp)))
+ {
+ --in_readline;
+ scm_misc_error (s_scm_readline,
+ "Input port is not open or not a file port",
+ SCM_EOL);
+ }
+
+ if (!((SCM_UNBNDP (outp) && SCM_OPOUTFPORTP (scm_current_output_port ()))
+ || SCM_OPOUTFPORTP (outp)))
+ {
+ --in_readline;
+ scm_misc_error (s_scm_readline,
+ "Output port is not open or not a file port",
+ SCM_EOL);
+ }
-static int in_readline = 0;
-#ifdef USE_THREADS
-static scm_mutex_t reentry_barrier_mutex;
+ if (!(SCM_UNBNDP (read_hook) || scm_is_false (read_hook)))
+ {
+ if (scm_is_false (scm_thunk_p (read_hook)))
+ {
+ --in_readline;
+ scm_wrong_type_arg (s_scm_readline, SCM_ARG4, read_hook);
+ }
+ before_read = 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);
+
+#ifndef __MINGW32__
+ fclose (rl_instream);
+ fclose (rl_outstream);
#endif
+ --in_readline;
+ return ans;
+}
+#undef FUNC_NAME
+
+
static void
reentry_barrier ()
{
int reentryp = 0;
-#ifdef USE_THREADS
- /* We should rather use scm_mutex_try_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_readline, "readline is not reentrant", SCM_EOL);
+ scm_misc_error (s_scm_readline, "readline is not reentrant", SCM_EOL);
}
static SCM
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 */
{
SCM ret;
char *s;
- char *prompt = SCM_UNBNDP (text) ? "" : SCM_CHARS (text);
+ char *prompt = SCM_UNBNDP (text) ? "" : scm_to_locale_string (text);
promptp = 1;
s = readline (prompt);
if (s)
- ret = scm_makfrom0str (s);
+ ret = scm_from_locale_string (s);
else
ret = SCM_EOF_VAL;
+ if (!SCM_UNBNDP (text))
+ free (prompt);
free (s);
return ret;
int fd;
FILE *f;
- fd = dup (((struct scm_fport *) SCM_STREAM (port))->fdes);
+ fd = dup (((struct scm_t_fport *) SCM_STREAM (port))->fdes);
if (fd == -1)
{
--in_readline;
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_NIMP (inp) && SCM_OPINFPORTP (inp))) {
+ if (!SCM_OPINFPORTP (inp)) {
scm_misc_error (0,
"Input port is not open or not a file port",
SCM_EOL);
}
- if (!(SCM_NIMP (outp) && SCM_OPOUTFPORTP (outp))) {
+ if (!SCM_OPOUTFPORTP (outp)) {
scm_misc_error (0,
"Output port is not open or not a file port",
SCM_EOL);
}
input_port = inp;
- rl_instream = stream_from_fport (inp, "r", s_readline);
- rl_outstream = stream_from_fport (outp, "w", s_readline);
+#ifndef __MINGW32__
+ rl_instream = stream_from_fport (inp, "r", s_scm_readline);
+ rl_outstream = stream_from_fport (outp, "w", s_scm_readline);
+#endif
}
-SCM
-scm_readline (SCM text, SCM inp, SCM outp, SCM read_hook)
-{
- SCM ans;
-
- reentry_barrier ();
-
- before_read = SCM_BOOL_F;
- if (!SCM_UNBNDP (text))
- {
- if (!(SCM_NIMP (text) && SCM_STRINGP (text)))
- {
- --in_readline;
- scm_wrong_type_arg (s_readline, SCM_ARG1, text);
- }
- SCM_COERCE_SUBSTR (text);
- }
-
- if (!((SCM_UNBNDP (inp) && SCM_NIMP (scm_cur_inp) && SCM_OPINFPORTP (inp))
- || SCM_NIMP (inp) && SCM_OPINFPORTP (inp)))
- {
- --in_readline;
- scm_misc_error (s_readline,
- "Input port is not open or not a file port",
- SCM_EOL);
- }
-
- if (!((SCM_UNBNDP (outp) && SCM_NIMP (scm_cur_outp) && SCM_OPINFPORTP (outp))
- || (SCM_NIMP (outp) && SCM_OPOUTFPORTP (outp))))
- {
- --in_readline;
- scm_misc_error (s_readline,
- "Output port is not open or not a file port",
- SCM_EOL);
- }
- if (!(SCM_UNBNDP (read_hook) || SCM_FALSEP (read_hook)))
- {
- if (!(SCM_NFALSEP (scm_thunk_p (read_hook))))
- {
- --in_readline;
- scm_wrong_type_arg (s_readline, SCM_ARG4, read_hook);
- }
- before_read = read_hook;
- }
-
- scm_readline_init_ports (inp, outp);
-
- ans = scm_internal_catch (SCM_BOOL_T,
- (scm_catch_body_t) internal_readline,
- (void *) text,
- handle_error, 0);
-
- fclose (rl_instream);
- fclose (rl_outstream);
-
- --in_readline;
- return ans;
-}
-
-SCM_PROC (s_add_history, "add-history", 1, 0, 0, scm_add_history);
-
-SCM
-scm_add_history (SCM text)
+SCM_DEFINE (scm_add_history, "add-history", 1, 0, 0,
+ (SCM text),
+"")
+#define FUNC_NAME s_scm_add_history
{
char* s;
- SCM_ASSERT ((SCM_NIMP(text) && SCM_STRINGP(text)), text, SCM_ARG1,
- s_add_history);
- SCM_COERCE_SUBSTR (text);
- s = SCM_CHARS (text);
- add_history (strdup (s));
+ s = scm_to_locale_string (text);
+ add_history (s);
+ free (s);
return SCM_UNSPECIFIED;
}
+#undef FUNC_NAME
-SCM_PROC (s_read_history, "read-history", 1, 0, 0, scm_read_history);
-
-SCM
-scm_read_history (SCM file)
+SCM_DEFINE (scm_read_history, "read-history", 1, 0, 0,
+ (SCM file),
+"")
+#define FUNC_NAME s_scm_read_history
{
- 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;
-}
+ char *filename;
+ SCM ret;
+ filename = scm_to_locale_string (file);
+ ret = scm_from_bool (!read_history (filename));
+ free (filename);
+ return ret;
+}
+#undef FUNC_NAME
-SCM_PROC (s_write_history, "write-history", 1, 0, 0, scm_write_history);
-SCM
-scm_write_history (SCM file)
+SCM_DEFINE (scm_write_history, "write-history", 1, 0, 0,
+ (SCM file),
+"")
+#define FUNC_NAME s_scm_write_history
{
- 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;
+ char *filename;
+ SCM ret;
+
+ filename = scm_to_locale_string (file);
+ ret = scm_from_bool (!write_history (filename));
+ free (filename);
+ return ret;
}
+#undef FUNC_NAME
+SCM_DEFINE (scm_clear_history, "clear-history", 0, 0, 0,
+ (),
+ "Clear the history buffer of the readline machinery.")
+#define FUNC_NAME s_scm_clear_history
+{
+ clear_history();
+ return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
-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)
+SCM_DEFINE (scm_filename_completion_function, "filename-completion-function", 2, 0, 0,
+ (SCM text, SCM continuep),
+"")
+#define FUNC_NAME s_scm_filename_completion_function
{
char *s;
SCM ans;
- SCM_ASSERT (SCM_NIMP (text) && SCM_STRINGP (text),
- text,
- SCM_ARG1,
- s_filename_completion_function);
- SCM_COERCE_SUBSTR (text);
- s = filename_completion_function (SCM_CHARS (text), SCM_NFALSEP (continuep));
- ans = scm_makfrom0str (s);
- free (s);
+ char *c_text = scm_to_locale_string (text);
+#ifdef HAVE_RL_FILENAME_COMPLETION_FUNCTION
+ s = rl_filename_completion_function (c_text, scm_is_true (continuep));
+#else
+ s = filename_completion_function (c_text, scm_is_true (continuep));
+#endif
+ ans = scm_take_locale_string (s);
+ free (c_text);
return ans;
}
+#undef FUNC_NAME
/*
* The following has been modified from code contributed by
static char *
completion_function (char *text, int continuep)
{
- SCM compfunc = SCM_CDR (scm_readline_completion_function_var);
+ 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_NIMP (res) && SCM_STRINGP (res)))
- scm_misc_error (s_readline,
- "Completion function returned bogus value: %S",
- SCM_LIST1 (res));
- SCM_COERCE_SUBSTR (res);
- return strdup (SCM_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 void match_paren(int x, int k);
-static int find_matching_paren(int k);
-static void init_bouncing_parens();
+static int match_paren (int x, int k);
+static int find_matching_paren (int k);
+static void init_bouncing_parens ();
static void
-init_bouncing_parens()
+init_bouncing_parens ()
{
- if(strncmp(rl_get_keymap_name(rl_get_keymap()), "vi", 2)) {
- rl_bind_key(')', match_paren);
- rl_bind_key(']', match_paren);
- rl_bind_key('}', match_paren);
- }
+ if (strncmp (rl_get_keymap_name (rl_get_keymap ()), "vi", 2))
+ {
+ rl_bind_key (')', match_paren);
+ rl_bind_key (']', match_paren);
+ rl_bind_key ('}', match_paren);
+ }
}
static int
}
else if (rl_line_buffer[i] == c)
{
- if (end_parens_found==0) return i;
+ if (end_parens_found==0)
+ return i;
else --end_parens_found;
}
}
return -1;
}
-static void
-match_paren(int x, int k)
+static int
+match_paren (int x, int k)
{
int tmp;
- fd_set readset;
+#ifndef __MINGW32__
+ int fno;
+ SELECT_TYPE readset;
struct timeval timeout;
-
- rl_insert(x, k);
+#endif
+
+ rl_insert (x, k);
if (!SCM_READLINE_BOUNCE_PARENS)
- return;
+ return 0;
/* Did we just insert a quoted paren? If so, then don't bounce. */
if (rl_point - 1 >= 1
&& rl_line_buffer[rl_point - 2] == '\\')
- return;
+ return 0;
+#ifndef __MINGW32__
tmp = 1000 * SCM_READLINE_BOUNCE_PARENS;
timeout.tv_sec = tmp / 1000000;
timeout.tv_usec = tmp % 1000000;
- FD_ZERO(&readset);
- FD_SET(fileno(rl_instream), &readset);
-
- if(rl_point > 1) {
- tmp = rl_point;
- rl_point = find_matching_paren(k);
- if(rl_point > -1) {
- rl_redisplay();
- scm_internal_select(1, &readset, NULL, NULL, &timeout);
+ FD_ZERO (&readset);
+ fno = fileno (rl_instream);
+ FD_SET (fno, &readset);
+#endif
+
+ if (rl_point > 1)
+ {
+ tmp = rl_point;
+ rl_point = find_matching_paren (k);
+ if (rl_point > -1)
+ {
+ rl_redisplay ();
+#ifndef __MINGW32__
+ scm_std_select (fno + 1, &readset, NULL, NULL, &timeout);
+#else
+ WaitForSingleObject (GetStdHandle(STD_INPUT_HANDLE),
+ SCM_READLINE_BOUNCE_PARENS);
+#endif
+ }
+ rl_point = tmp;
}
- rl_point = tmp;
- }
+ return 0;
+}
+#endif /* HAVE_RL_GET_KEYMAP */
+
+#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_GETC_FUNCTION */
void
scm_init_readline ()
{
-#include "readline.x"
+#ifdef HAVE_RL_GETC_FUNCTION
+#include "guile-readline/readline.x"
scm_readline_completion_function_var
- = scm_sysintern ("*readline-completion-function*", SCM_BOOL_F);
+ = scm_c_define ("*readline-completion-function*", SCM_BOOL_F);
+#ifndef __MINGW32__
rl_getc_function = current_input_getc;
- rl_redisplay_function = redisplay;
+#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\"'`;()";
-#ifdef USE_THREADS
- scm_mutex_init (&reentry_barrier_mutex);
+ 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 ());
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 */
}
-#endif
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/