X-Git-Url: http://git.hcoop.net/bpt/guile.git/blobdiff_plain/dcb17187c3d2a9a680bed9aed44883562f3baacf..027e0e2c6927d74e9f30b4ab99b023b6ccfe5c10:/guile-readline/readline.c diff --git a/guile-readline/readline.c b/guile-readline/readline.c index f5f330bca..aa14e3967 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,2000,2001 Free Software Foundation, Inc. +/* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007 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,17 +14,17 @@ * * 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 */ -#include "libguile/_scm.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" @@ -36,19 +36,24 @@ #endif #include #include +#ifndef __MINGW32__ #include +#else +#include +#endif #include #include "libguile/validate.h" #include "guile-readline/readline.h" -scm_option_t 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); @@ -60,7 +65,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; @@ -130,7 +134,7 @@ 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; @@ -138,17 +142,8 @@ current_input_getc (FILE *in SCM_UNUSED) return scm_getc (input_port); } -static void -redisplay () -{ - rl_redisplay (); - /* promptp = 1; */ -} - 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); @@ -168,15 +163,14 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0, 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; @@ -185,7 +179,7 @@ SCM_DEFINE (scm_readline, "%readline", 0, 4, 0, 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; @@ -194,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); @@ -207,12 +201,14 @@ 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, + (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; @@ -224,17 +220,13 @@ 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); } @@ -245,8 +237,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 */ @@ -257,15 +251,17 @@ 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); + ret = scm_from_locale_string (s); else ret = SCM_EOF_VAL; + if (!SCM_UNBNDP (text)) + free (prompt); free (s); return ret; @@ -277,7 +273,7 @@ stream_from_fport (SCM port, char *mode, const char *subr) int fd; FILE *f; - fd = dup (((struct scm_fport_t *) SCM_STREAM (port))->fdes); + fd = dup (((struct scm_t_fport *) SCM_STREAM (port))->fdes); if (fd == -1) { --in_readline; @@ -298,10 +294,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, @@ -316,8 +312,10 @@ scm_readline_init_ports (SCM inp, SCM outp) } input_port = inp; +#ifndef __MINGW32__ rl_instream = stream_from_fport (inp, "r", s_scm_readline); rl_outstream = stream_from_fport (outp, "w", s_scm_readline); +#endif } @@ -328,11 +326,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; } @@ -344,8 +341,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 @@ -355,8 +357,13 @@ 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 @@ -378,15 +385,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); + 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 @@ -404,26 +410,22 @@ completion_function (char *text, int continuep) 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); @@ -484,10 +486,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; @@ -497,13 +502,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; @@ -511,12 +518,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; } +#endif /* HAVE_RL_GET_KEYMAP */ #if defined (HAVE_RL_PRE_INPUT_HOOK) && defined (GUILE_SIGWINCH_SA_RESTART_CLEARED) /* Readline disables SA_RESTART on SIGWINCH. @@ -547,8 +560,9 @@ 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; - rl_redisplay_function = redisplay; +#endif #if defined (_RL_FUNCTION_TYPEDEF) rl_completion_entry_function = (rl_compentry_func_t*) completion_function; #else @@ -560,13 +574,12 @@ scm_init_readline () rl_pre_input_hook = sigwinch_enable_restart; #endif -#ifdef USE_THREADS - scm_mutex_init (&reentry_barrier_mutex); -#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 */ }