X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/08b5e6c31617be5dfc139891e177c482654730ef..ec7ea550f2acd6e7bbaf10f8e4a1e9915dc80cf8:/guile-readline/readline.c diff --git a/guile-readline/readline.c b/guile-readline/readline.c index 228b42705..0e4ad2902 100644 --- a/guile-readline/readline.c +++ b/guile-readline/readline.c @@ -1,10 +1,10 @@ /* readline.c --- line editing support for Guile */ -/* Copyright (C) 1997,1999, 2000 Free Software Foundation, Inc. +/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010 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, @@ -14,40 +14,45 @@ * * 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 */ +#ifdef HAVE_CONFIG_H +# include +#endif -#include "libguile/_scm.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 "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); @@ -59,7 +64,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; @@ -70,7 +74,7 @@ SCM_DEFINE (scm_readline_options, "readline-options-interface", 0, 1, 0, static char * strdup (char *s) { - int len = strlen (s); + size_t len = strlen (s); char *new = malloc (len + 1); strcpy (new, s); return new; @@ -124,33 +128,25 @@ rl_free_line_state () static int promptp; static SCM input_port; +static SCM output_port; static SCM before_read; static int -current_input_getc (FILE *in) +current_input_getc (FILE *in SCM_UNUSED) { - if (promptp && SCM_NIMP (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_mutex_t 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); @@ -167,16 +163,15 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0, if (!SCM_UNBNDP (text)) { - if (!(SCM_NIMP (text) && 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_NIMP (scm_cur_inp) && SCM_OPINFPORTP (inp)) - || (SCM_NIMP (inp) && SCM_OPINFPORTP (inp)))) + if (!((SCM_UNBNDP (inp) && SCM_OPINFPORTP (scm_current_input_port ())) + || SCM_OPINFPORTP (inp))) { --in_readline; scm_misc_error (s_scm_readline, @@ -184,8 +179,8 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0, SCM_EOL); } - if (!((SCM_UNBNDP (outp) && SCM_NIMP (scm_cur_outp) && SCM_OPINFPORTP (outp)) - || (SCM_NIMP (outp) && SCM_OPOUTFPORTP (outp)))) + if (!((SCM_UNBNDP (outp) && SCM_OPOUTFPORTP (scm_current_output_port ())) + || SCM_OPOUTFPORTP (outp))) { --in_readline; scm_misc_error (s_scm_readline, @@ -193,9 +188,9 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0, 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); @@ -205,13 +200,17 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0, scm_readline_init_ports (inp, outp); - ans = scm_internal_catch (SCM_BOOL_T, - (scm_catch_body_t) 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; @@ -223,32 +222,29 @@ 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_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 @@ -256,15 +252,22 @@ internal_readline (SCM text) { 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; @@ -276,7 +279,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; @@ -297,26 +300,29 @@ 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; + output_port = outp; +#ifndef __MINGW32__ rl_instream = stream_from_fport (inp, "r", s_scm_readline); rl_outstream = stream_from_fport (outp, "w", s_scm_readline); +#endif } @@ -327,11 +333,10 @@ SCM_DEFINE (scm_add_history, "add-history", 1, 0, 0, #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; } @@ -343,8 +348,13 @@ SCM_DEFINE (scm_read_history, "read-history", 1, 0, 0, "") #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 @@ -354,8 +364,23 @@ SCM_DEFINE (scm_write_history, "write-history", 1, 0, 0, "") #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 + +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 @@ -367,11 +392,14 @@ SCM_DEFINE (scm_filename_completion_function, "filename-completion-function", 2, { char *s; SCM ans; - SCM_VALIDATE_STRING (1,text); - SCM_STRING_COERCE_0TERMINATION_X (text); - s = filename_completion_function (SCM_STRING_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 @@ -386,29 +414,25 @@ 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_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); @@ -469,10 +493,13 @@ find_matching_paren(int k) static int match_paren (int x, int k) { - int tmp, fno; + int tmp; +#ifndef __MINGW32__ + int fno; SELECT_TYPE readset; struct timeval timeout; - +#endif + rl_insert (x, k); if (!SCM_READLINE_BOUNCE_PARENS) return 0; @@ -482,13 +509,15 @@ 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) { tmp = rl_point; @@ -496,32 +525,18 @@ match_paren (int x, int k) if (rl_point > -1) { rl_redisplay (); - scm_internal_select (fno + 1, &readset, NULL, NULL, &timeout); +#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; } 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 */ @@ -531,23 +546,34 @@ scm_init_readline () #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; - 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 + rl_basic_word_break_characters = " \t\n\"'`;()"; + rl_readline_name = "Guile"; -#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 */ }