1 /* readline.c --- line editing support for Guile */
3 /* Copyright (C) 1997,1999,2000,2001, 2002, 2003, 2006, 2007, 2008, 2009, 2010 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 3, 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
28 #ifdef HAVE_RL_GETC_FUNCTION
30 #include "libguile/iselect.h"
36 #include <readline/readline.h>
37 #include <readline/history.h>
45 #include "libguile/validate.h"
46 #include "guile-readline/readline.h"
48 scm_t_option scm_readline_opts
[] = {
49 { SCM_OPTION_BOOLEAN
, "history-file", 1,
50 "Use history file." },
51 { SCM_OPTION_INTEGER
, "history-length", 200,
53 { SCM_OPTION_INTEGER
, "bounce-parens", 500,
54 "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
,
68 stifle_history (SCM_HISTORY_LENGTH
);
77 size_t len
= strlen (s
);
78 char *new = malloc (len
+ 1);
82 #endif /* HAVE_STRDUP */
84 #ifndef HAVE_RL_CLEANUP_AFTER_SIGNAL
86 /* These are readline functions added in release 2.3. They will work
87 * together with readline-2.1 and 2.2. (The readline interface is
88 * disabled for earlier releases.)
89 * They are declared static; if we want to use them elsewhere, then
90 * we need external declarations for them, but at the moment, I don't
91 * think anything else in Guile ought to use these.
94 extern void _rl_clean_up_for_exit ();
95 extern void _rl_kill_kbd_macro ();
96 extern int _rl_init_argument ();
99 rl_cleanup_after_signal ()
101 #ifdef HAVE_RL_CLEAR_SIGNALS
102 _rl_clean_up_for_exit ();
104 (*rl_deprep_term_function
) ();
105 #ifdef HAVE_RL_CLEAR_SIGNALS
108 rl_pending_input
= 0;
112 rl_free_line_state ()
114 register HIST_ENTRY
*entry
;
118 entry
= current_history ();
120 entry
->data
= (char *)NULL
;
122 _rl_kill_kbd_macro ();
124 _rl_init_argument ();
127 #endif /* !HAVE_RL_CLEANUP_AFTER_SIGNAL */
130 static SCM input_port
;
131 static SCM output_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_get_byte_or_eof (input_port
);
145 static int in_readline
= 0;
146 static SCM reentry_barrier_mutex
;
148 static SCM
internal_readline (SCM text
);
149 static void unwind_readline (void *unused
);
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 scm_dynwind_begin (0);
204 scm_dynwind_unwind_handler (unwind_readline
, NULL
, 0);
206 ans
= internal_readline (text
);
211 fclose (rl_instream
);
212 fclose (rl_outstream
);
225 /* We should rather use scm_try_mutex when it becomes available */
226 scm_lock_mutex (reentry_barrier_mutex
);
231 scm_unlock_mutex (reentry_barrier_mutex
);
233 scm_misc_error (s_scm_readline
, "readline is not reentrant", SCM_EOL
);
236 /* This function is only called on nonlocal exit from readline(). */
238 unwind_readline (void *unused
)
240 rl_free_line_state ();
241 rl_cleanup_after_signal ();
242 fputc ('\n', rl_outstream
); /* We don't want next output on this line */
244 fclose (rl_instream
);
245 fclose (rl_outstream
);
251 internal_readline (SCM text
)
255 char *prompt
= SCM_UNBNDP (text
) ? "" : scm_to_locale_string (text
);
258 s
= readline (prompt
);
261 scm_t_port
*pt
= SCM_PTAB_ENTRY (output_port
);
263 ret
= scm_from_stringn (s
, strlen (s
), pt
->encoding
,
264 SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE
);
269 if (!SCM_UNBNDP (text
))
277 stream_from_fport (SCM port
, char *mode
, const char *subr
)
282 fd
= dup (((struct scm_t_fport
*) SCM_STREAM (port
))->fdes
);
289 f
= fdopen (fd
, mode
);
300 scm_readline_init_ports (SCM inp
, SCM outp
)
302 if (SCM_UNBNDP (inp
))
303 inp
= scm_current_input_port ();
305 if (SCM_UNBNDP (outp
))
306 outp
= scm_current_output_port ();
308 if (!SCM_OPINFPORTP (inp
)) {
310 "Input port is not open or not a file port",
314 if (!SCM_OPOUTFPORTP (outp
)) {
316 "Output port is not open or not a file port",
323 rl_instream
= stream_from_fport (inp
, "r", s_scm_readline
);
324 rl_outstream
= stream_from_fport (outp
, "w", s_scm_readline
);
330 SCM_DEFINE (scm_add_history
, "add-history", 1, 0, 0,
333 #define FUNC_NAME s_scm_add_history
337 s
= scm_to_locale_string (text
);
341 return SCM_UNSPECIFIED
;
346 SCM_DEFINE (scm_read_history
, "read-history", 1, 0, 0,
349 #define FUNC_NAME s_scm_read_history
354 filename
= scm_to_locale_string (file
);
355 ret
= scm_from_bool (!read_history (filename
));
362 SCM_DEFINE (scm_write_history
, "write-history", 1, 0, 0,
365 #define FUNC_NAME s_scm_write_history
370 filename
= scm_to_locale_string (file
);
371 ret
= scm_from_bool (!write_history (filename
));
377 SCM_DEFINE (scm_clear_history
, "clear-history", 0, 0, 0,
379 "Clear the history buffer of the readline machinery.")
380 #define FUNC_NAME s_scm_clear_history
383 return SCM_UNSPECIFIED
;
388 SCM_DEFINE (scm_filename_completion_function
, "filename-completion-function", 2, 0, 0,
389 (SCM text
, SCM continuep
),
391 #define FUNC_NAME s_scm_filename_completion_function
395 char *c_text
= scm_to_locale_string (text
);
396 #ifdef HAVE_RL_FILENAME_COMPLETION_FUNCTION
397 s
= rl_filename_completion_function (c_text
, scm_is_true (continuep
));
399 s
= filename_completion_function (c_text
, scm_is_true (continuep
));
401 ans
= scm_take_locale_string (s
);
408 * The following has been modified from code contributed by
409 * Andrew Archibald <aarchiba@undergrad.math.uwaterloo.ca>
412 SCM scm_readline_completion_function_var
;
415 completion_function (char *text
, int continuep
)
417 SCM compfunc
= SCM_VARIABLE_REF (scm_readline_completion_function_var
);
420 if (scm_is_false (compfunc
))
421 return NULL
; /* #f => completion disabled */
424 SCM t
= scm_from_locale_string (text
);
425 SCM c
= scm_from_bool (continuep
);
426 res
= scm_apply (compfunc
, scm_list_2 (t
, c
), SCM_EOL
);
428 if (scm_is_false (res
))
431 return scm_to_locale_string (res
);
435 #if HAVE_RL_GET_KEYMAP
436 /*Bouncing parenthesis (reimplemented by GH, 11/23/98, since readline is strict gpl)*/
438 static int match_paren (int x
, int k
);
439 static int find_matching_paren (int k
);
440 static void init_bouncing_parens ();
443 init_bouncing_parens ()
445 if (strncmp (rl_get_keymap_name (rl_get_keymap ()), "vi", 2))
447 rl_bind_key (')', match_paren
);
448 rl_bind_key (']', match_paren
);
449 rl_bind_key ('}', match_paren
);
454 find_matching_paren(int k
)
458 int end_parens_found
= 0;
460 /* Choose the corresponding opening bracket. */
461 if (k
== ')') c
= '(';
462 else if (k
== ']') c
= '[';
463 else if (k
== '}') c
= '{';
465 for (i
=rl_point
-2; i
>=0; i
--)
467 /* Is the current character part of a character literal? */
469 && rl_line_buffer
[i
- 1] == '\\'
470 && rl_line_buffer
[i
- 2] == '#')
472 else if (rl_line_buffer
[i
] == k
)
474 else if (rl_line_buffer
[i
] == '"')
476 /* Skip over a string literal. */
477 for (i
--; i
>= 0; i
--)
478 if (rl_line_buffer
[i
] == '"'
480 && rl_line_buffer
[i
- 1] == '\\'))
483 else if (rl_line_buffer
[i
] == c
)
485 if (end_parens_found
==0)
487 else --end_parens_found
;
494 match_paren (int x
, int k
)
500 struct timeval timeout
;
504 if (!SCM_READLINE_BOUNCE_PARENS
)
507 /* Did we just insert a quoted paren? If so, then don't bounce. */
508 if (rl_point
- 1 >= 1
509 && rl_line_buffer
[rl_point
- 2] == '\\')
513 tmp
= 1000 * SCM_READLINE_BOUNCE_PARENS
;
514 timeout
.tv_sec
= tmp
/ 1000000;
515 timeout
.tv_usec
= tmp
% 1000000;
517 fno
= fileno (rl_instream
);
518 FD_SET (fno
, &readset
);
524 rl_point
= find_matching_paren (k
);
529 scm_std_select (fno
+ 1, &readset
, NULL
, NULL
, &timeout
);
531 WaitForSingleObject (GetStdHandle(STD_INPUT_HANDLE
),
532 SCM_READLINE_BOUNCE_PARENS
);
539 #endif /* HAVE_RL_GET_KEYMAP */
541 #endif /* HAVE_RL_GETC_FUNCTION */
546 #ifdef HAVE_RL_GETC_FUNCTION
547 #include "guile-readline/readline.x"
548 scm_readline_completion_function_var
549 = scm_c_define ("*readline-completion-function*", SCM_BOOL_F
);
551 rl_getc_function
= current_input_getc
;
553 #if defined (_RL_FUNCTION_TYPEDEF)
554 rl_completion_entry_function
= (rl_compentry_func_t
*) completion_function
;
556 rl_completion_entry_function
= (Function
*) completion_function
;
558 rl_basic_word_break_characters
= " \t\n\"'`;()";
559 rl_readline_name
= "Guile";
561 /* Let Guile handle signals. */
562 #if defined (HAVE_DECL_RL_CATCH_SIGNALS) && HAVE_DECL_RL_CATCH_SIGNALS
563 rl_catch_signals
= 0;
566 /* But let readline handle SIGWINCH. */
567 #if defined (HAVE_DECL_RL_CATCH_SIGWINCH) && HAVE_DECL_RL_CATCH_SIGWINCH
568 rl_catch_sigwinch
= 1;
571 reentry_barrier_mutex
= scm_make_mutex ();
572 scm_init_opts (scm_readline_options
,
574 #if HAVE_RL_GET_KEYMAP
575 init_bouncing_parens();
577 scm_add_feature ("readline");
578 #endif /* HAVE_RL_GETC_FUNCTION */