1 /* readline.c --- line editing support for Guile */
3 /* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008 Free Software Foundation, Inc.
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2, or (at your option)
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
15 * You should have received a copy of the GNU General Public License
16 * along with this software; see the file COPYING. If not, write to
17 * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18 * Boston, MA 02110-1301 USA
25 /* Include private, configure generated header (i.e. config.h). */
26 #include "guile-readline-config.h"
28 #ifdef HAVE_RL_GETC_FUNCTION
30 #include "libguile/gh.h"
31 #include "libguile/iselect.h"
37 #include <readline/readline.h>
38 #include <readline/history.h>
46 #include "libguile/validate.h"
47 #include "guile-readline/readline.h"
49 scm_t_option scm_readline_opts[] = {
50 { SCM_OPTION_BOOLEAN, "history-file", 1,
51 "Use history file." },
52 { SCM_OPTION_INTEGER, "history-length", 200,
54 { SCM_OPTION_INTEGER, "bounce-parens", 500,
55 "Time (ms) to show matching opening parenthesis (0 = off)."}
58 extern void stifle_history (int max);
60 SCM_DEFINE (scm_readline_options, "readline-options-interface", 0, 1, 0,
63 #define FUNC_NAME s_scm_readline_options
65 SCM ans = scm_options (setting,
67 SCM_N_READLINE_OPTIONS,
69 stifle_history (SCM_HISTORY_LENGTH);
78 size_t len = strlen (s);
79 char *new = malloc (len + 1);
83 #endif /* HAVE_STRDUP */
85 #ifndef HAVE_RL_CLEANUP_AFTER_SIGNAL
87 /* These are readline functions added in release 2.3. They will work
88 * together with readline-2.1 and 2.2. (The readline interface is
89 * disabled for earlier releases.)
90 * They are declared static; if we want to use them elsewhere, then
91 * we need external declarations for them, but at the moment, I don't
92 * think anything else in Guile ought to use these.
95 extern void _rl_clean_up_for_exit ();
96 extern void _rl_kill_kbd_macro ();
97 extern int _rl_init_argument ();
100 rl_cleanup_after_signal ()
102 #ifdef HAVE_RL_CLEAR_SIGNALS
103 _rl_clean_up_for_exit ();
105 (*rl_deprep_term_function) ();
106 #ifdef HAVE_RL_CLEAR_SIGNALS
109 rl_pending_input = 0;
113 rl_free_line_state ()
115 register HIST_ENTRY *entry;
119 entry = current_history ();
121 entry->data = (char *)NULL;
123 _rl_kill_kbd_macro ();
125 _rl_init_argument ();
128 #endif /* !HAVE_RL_CLEANUP_AFTER_SIGNAL */
131 static SCM input_port;
132 static SCM before_read;
135 current_input_getc (FILE *in SCM_UNUSED)
137 if (promptp && scm_is_true (before_read))
139 scm_apply (before_read, SCM_EOL, SCM_EOL);
142 return scm_getc (input_port);
145 static int in_readline = 0;
146 static SCM reentry_barrier_mutex;
148 static SCM internal_readline (SCM text);
149 static SCM handle_error (void *data, SCM tag, SCM args);
150 static void reentry_barrier (void);
153 SCM_DEFINE (scm_readline, "%readline", 0, 4, 0,
154 (SCM text, SCM inp, SCM outp, SCM read_hook),
156 #define FUNC_NAME s_scm_readline
162 before_read = SCM_BOOL_F;
164 if (!SCM_UNBNDP (text))
166 if (!scm_is_string (text))
169 scm_wrong_type_arg (s_scm_readline, SCM_ARG1, text);
173 if (!((SCM_UNBNDP (inp) && SCM_OPINFPORTP (scm_current_input_port ()))
174 || SCM_OPINFPORTP (inp)))
177 scm_misc_error (s_scm_readline,
178 "Input port is not open or not a file port",
182 if (!((SCM_UNBNDP (outp) && SCM_OPOUTFPORTP (scm_current_output_port ()))
183 || SCM_OPOUTFPORTP (outp)))
186 scm_misc_error (s_scm_readline,
187 "Output port is not open or not a file port",
191 if (!(SCM_UNBNDP (read_hook) || scm_is_false (read_hook)))
193 if (scm_is_false (scm_thunk_p (read_hook)))
196 scm_wrong_type_arg (s_scm_readline, SCM_ARG4, read_hook);
198 before_read = read_hook;
201 scm_readline_init_ports (inp, outp);
203 ans = scm_internal_catch (SCM_BOOL_T,
204 (scm_t_catch_body) internal_readline,
205 (void *) SCM_UNPACK (text),
209 fclose (rl_instream);
210 fclose (rl_outstream);
223 /* We should rather use scm_try_mutex when it becomes available */
224 scm_lock_mutex (reentry_barrier_mutex);
229 scm_unlock_mutex (reentry_barrier_mutex);
231 scm_misc_error (s_scm_readline, "readline is not reentrant", SCM_EOL);
235 handle_error (void *data, SCM tag, SCM args)
237 rl_free_line_state ();
238 rl_cleanup_after_signal ();
239 fputc ('\n', rl_outstream); /* We don't want next output on this line */
241 fclose (rl_instream);
242 fclose (rl_outstream);
245 scm_handle_by_throw (data, tag, args);
246 return SCM_UNSPECIFIED; /* never reached */
250 internal_readline (SCM text)
254 char *prompt = SCM_UNBNDP (text) ? "" : scm_to_locale_string (text);
257 s = readline (prompt);
259 ret = scm_from_locale_string (s);
263 if (!SCM_UNBNDP (text))
271 stream_from_fport (SCM port, char *mode, const char *subr)
276 fd = dup (((struct scm_t_fport *) SCM_STREAM (port))->fdes);
283 f = fdopen (fd, mode);
294 scm_readline_init_ports (SCM inp, SCM outp)
296 if (SCM_UNBNDP (inp))
297 inp = scm_current_input_port ();
299 if (SCM_UNBNDP (outp))
300 outp = scm_current_output_port ();
302 if (!SCM_OPINFPORTP (inp)) {
304 "Input port is not open or not a file port",
308 if (!SCM_OPOUTFPORTP (outp)) {
310 "Output port is not open or not a file port",
316 rl_instream = stream_from_fport (inp, "r", s_scm_readline);
317 rl_outstream = stream_from_fport (outp, "w", s_scm_readline);
323 SCM_DEFINE (scm_add_history, "add-history", 1, 0, 0,
326 #define FUNC_NAME s_scm_add_history
330 s = scm_to_locale_string (text);
334 return SCM_UNSPECIFIED;
339 SCM_DEFINE (scm_read_history, "read-history", 1, 0, 0,
342 #define FUNC_NAME s_scm_read_history
347 filename = scm_to_locale_string (file);
348 ret = scm_from_bool (!read_history (filename));
355 SCM_DEFINE (scm_write_history, "write-history", 1, 0, 0,
358 #define FUNC_NAME s_scm_write_history
363 filename = scm_to_locale_string (file);
364 ret = scm_from_bool (!write_history (filename));
370 SCM_DEFINE (scm_clear_history, "clear-history", 0, 0, 0,
372 "Clear the history buffer of the readline machinery.")
373 #define FUNC_NAME s_scm_clear_history
376 return SCM_UNSPECIFIED;
381 SCM_DEFINE (scm_filename_completion_function, "filename-completion-function", 2, 0, 0,
382 (SCM text, SCM continuep),
384 #define FUNC_NAME s_scm_filename_completion_function
388 char *c_text = scm_to_locale_string (text);
389 #ifdef HAVE_RL_FILENAME_COMPLETION_FUNCTION
390 s = rl_filename_completion_function (c_text, scm_is_true (continuep));
392 s = filename_completion_function (c_text, scm_is_true (continuep));
394 ans = scm_take_locale_string (s);
401 * The following has been modified from code contributed by
402 * Andrew Archibald <aarchiba@undergrad.math.uwaterloo.ca>
405 SCM scm_readline_completion_function_var;
408 completion_function (char *text, int continuep)
410 SCM compfunc = SCM_VARIABLE_REF (scm_readline_completion_function_var);
413 if (scm_is_false (compfunc))
414 return NULL; /* #f => completion disabled */
417 SCM t = scm_from_locale_string (text);
418 SCM c = scm_from_bool (continuep);
419 res = scm_apply (compfunc, scm_list_2 (t, c), SCM_EOL);
421 if (scm_is_false (res))
424 return scm_to_locale_string (res);
428 #if HAVE_RL_GET_KEYMAP
429 /*Bouncing parenthesis (reimplemented by GH, 11/23/98, since readline is strict gpl)*/
431 static int match_paren (int x, int k);
432 static int find_matching_paren (int k);
433 static void init_bouncing_parens ();
436 init_bouncing_parens ()
438 if (strncmp (rl_get_keymap_name (rl_get_keymap ()), "vi", 2))
440 rl_bind_key (')', match_paren);
441 rl_bind_key (']', match_paren);
442 rl_bind_key ('}', match_paren);
447 find_matching_paren(int k)
451 int end_parens_found = 0;
453 /* Choose the corresponding opening bracket. */
454 if (k == ')') c = '(';
455 else if (k == ']') c = '[';
456 else if (k == '}') c = '{';
458 for (i=rl_point-2; i>=0; i--)
460 /* Is the current character part of a character literal? */
462 && rl_line_buffer[i - 1] == '\\'
463 && rl_line_buffer[i - 2] == '#')
465 else if (rl_line_buffer[i] == k)
467 else if (rl_line_buffer[i] == '"')
469 /* Skip over a string literal. */
470 for (i--; i >= 0; i--)
471 if (rl_line_buffer[i] == '"'
473 && rl_line_buffer[i - 1] == '\\'))
476 else if (rl_line_buffer[i] == c)
478 if (end_parens_found==0)
480 else --end_parens_found;
487 match_paren (int x, int k)
493 struct timeval timeout;
497 if (!SCM_READLINE_BOUNCE_PARENS)
500 /* Did we just insert a quoted paren? If so, then don't bounce. */
501 if (rl_point - 1 >= 1
502 && rl_line_buffer[rl_point - 2] == '\\')
506 tmp = 1000 * SCM_READLINE_BOUNCE_PARENS;
507 timeout.tv_sec = tmp / 1000000;
508 timeout.tv_usec = tmp % 1000000;
510 fno = fileno (rl_instream);
511 FD_SET (fno, &readset);
517 rl_point = find_matching_paren (k);
522 scm_std_select (fno + 1, &readset, NULL, NULL, &timeout);
524 WaitForSingleObject (GetStdHandle(STD_INPUT_HANDLE),
525 SCM_READLINE_BOUNCE_PARENS);
532 #endif /* HAVE_RL_GET_KEYMAP */
534 #endif /* HAVE_RL_GETC_FUNCTION */
539 #ifdef HAVE_RL_GETC_FUNCTION
540 #include "guile-readline/readline.x"
541 scm_readline_completion_function_var
542 = scm_c_define ("*readline-completion-function*", SCM_BOOL_F);
544 rl_getc_function = current_input_getc;
546 #if defined (_RL_FUNCTION_TYPEDEF)
547 rl_completion_entry_function = (rl_compentry_func_t*) completion_function;
549 rl_completion_entry_function = (Function*) completion_function;
551 rl_basic_word_break_characters = "\t\n\"'`;()";
552 rl_readline_name = "Guile";
554 reentry_barrier_mutex = scm_permanent_object (scm_make_mutex ());
555 scm_init_opts (scm_readline_options,
557 SCM_N_READLINE_OPTIONS);
558 #if HAVE_RL_GET_KEYMAP
559 init_bouncing_parens();
561 scm_add_feature ("readline");
562 #endif /* HAVE_RL_GETC_FUNCTION */