X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/2e3d59875a9087b6daa70e914395bb07bfa2c28c..1b09b607dd1096ab572afe0667e8602560622624:/guile-readline/readline.c diff --git a/guile-readline/readline.c b/guile-readline/readline.c index b41a1b6d5..37eab2433 100644 --- a/guile-readline/readline.c +++ b/guile-readline/readline.c @@ -1,6 +1,6 @@ /* readline.c --- line editing support for Guile */ -/* Copyright (C) 1997,1999 Free Software Foundation, Inc. +/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006 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 @@ -14,25 +14,41 @@ * * 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 * */ + + +#if HAVE_CONFIG_H +# include +#endif + #include "libguile/_scm.h" -#if defined (HAVE_RL_GETC_FUNCTION) -#include "libguile/libguile.h" +#ifdef HAVE_RL_GETC_FUNCTION +#include "libguile.h" #include "libguile/gh.h" #include "libguile/iselect.h" +#include +#ifdef HAVE_UNISTD_H +#include +#endif #include #include +#ifndef __MINGW32__ #include +#else +#include +#endif +#include -#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, @@ -43,25 +59,25 @@ scm_option scm_readline_opts[] = { 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; @@ -118,49 +134,103 @@ static SCM input_port; 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; + + 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); + } -SCM_PROC (s_readline, "readline", 0, 4, 0, scm_readline); + 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; + } -static int in_readline = 0; -#ifdef USE_THREADS -static scm_mutex_t reentry_barrier_mutex; + 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 @@ -169,8 +239,10 @@ handle_error (void *data, SCM tag, SCM args) 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 */ @@ -181,15 +253,17 @@ internal_readline (SCM text) { 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; @@ -201,7 +275,7 @@ stream_from_fport (SCM port, char *mode, const char *subr) 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; @@ -222,145 +296,107 @@ 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_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); 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 @@ -372,43 +408,39 @@ SCM scm_readline_completion_function_var; 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); } } /*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 @@ -443,65 +475,115 @@ find_matching_paren(int k) } 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; +} + +#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, NULL); + 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); init_bouncing_parens(); scm_add_feature ("readline"); +#endif /* HAVE_RL_GETC_FUNCTION */ } -#endif +/* + Local Variables: + c-file-style: "gnu" + End: +*/