1 /* readline.c --- line editing support for Guile */
3 /* Copyright (C) 1997,1999, 2000 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., 59 Temple Place, Suite 330,
18 * Boston, MA 02111-1307 USA
22 /* Software engineering face-lift by Greg J. Badros, 11-Dec-1999,
23 gjb@cs.washington.edu, http://www.cs.washington.edu/homes/gjb */
27 #include "libguile/_scm.h"
28 #if defined (HAVE_RL_GETC_FUNCTION)
29 #include "libguile/libguile.h"
30 #include "libguile/gh.h"
31 #include "libguile/iselect.h"
33 #include <readline/readline.h>
34 #include <readline/history.h>
37 #include "libguile/validate.h"
40 scm_option scm_readline_opts
[] = {
41 { SCM_OPTION_BOOLEAN
, "history-file", 1,
42 "Use history file." },
43 { SCM_OPTION_INTEGER
, "history-length", 200,
45 { SCM_OPTION_INTEGER
, "bounce-parens", 500,
46 "Time (ms) to show matching opening parenthesis (0 = off)."}
49 extern void stifle_history (int max
);
51 SCM_DEFINE (scm_readline_options
, "readline-options-interface", 0, 1, 0,
54 #define FUNC_NAME s_scm_readline_options
56 SCM ans
= scm_options (setting
,
58 SCM_N_READLINE_OPTIONS
,
60 stifle_history (SCM_HISTORY_LENGTH
);
70 char *new = malloc (len
+ 1);
74 #endif /* HAVE_STRDUP */
76 #ifndef HAVE_RL_CLEANUP_AFTER_SIGNAL
78 /* These are readline functions added in release 2.3. They will work
79 * together with readline-2.1 and 2.2. (The readline interface is
80 * disabled for earlier releases.)
81 * They are declared static; if we want to use them elsewhere, then
82 * we need external declarations for them, but at the moment, I don't
83 * think anything else in Guile ought to use these.
86 extern void _rl_clean_up_for_exit ();
87 extern void _rl_kill_kbd_macro ();
88 extern int _rl_init_argument ();
91 rl_cleanup_after_signal ()
93 #ifdef HAVE_RL_CLEAR_SIGNALS
94 _rl_clean_up_for_exit ();
96 (*rl_deprep_term_function
) ();
97 #ifdef HAVE_RL_CLEAR_SIGNALS
100 rl_pending_input
= 0;
104 rl_free_line_state ()
106 register HIST_ENTRY
*entry
;
110 entry
= current_history ();
112 entry
->data
= (char *)NULL
;
114 _rl_kill_kbd_macro ();
116 _rl_init_argument ();
119 #endif /* !HAVE_RL_CLEANUP_AFTER_SIGNAL */
122 static SCM input_port
;
123 static SCM before_read
;
126 current_input_getc (FILE *in
)
129 if (promptp
&& SCM_NIMP (before_read
))
131 scm_apply (before_read
, SCM_EOL
, SCM_EOL
);
134 ans
= scm_getc (input_port
);
135 /* GJB:FIXME:: why not just
136 return scm_getc(input_port);
148 static int in_readline
= 0;
150 static scm_mutex_t reentry_barrier_mutex
;
153 static SCM
internal_readline (SCM text
);
154 static SCM
handle_error (void *data
, SCM tag
, SCM args
);
155 static void reentry_barrier ();
158 SCM_DEFINE (scm_readline
, "%readline", 0, 4, 0,
159 (SCM text
, SCM inp
, SCM outp
, SCM read_hook
),
161 #define FUNC_NAME s_scm_readline
167 before_read
= SCM_BOOL_F
;
169 if (!SCM_UNBNDP (text
))
171 if (!(SCM_NIMP (text
) && SCM_STRINGP (text
)))
174 scm_wrong_type_arg (s_scm_readline
, SCM_ARG1
, text
);
176 SCM_COERCE_SUBSTR (text
);
179 if (!((SCM_UNBNDP (inp
) && SCM_NIMP (scm_cur_inp
) && SCM_OPINFPORTP (inp
))
180 || SCM_NIMP (inp
) && SCM_OPINFPORTP (inp
)))
183 scm_misc_error (s_scm_readline
,
184 "Input port is not open or not a file port",
188 if (!((SCM_UNBNDP (outp
) && SCM_NIMP (scm_cur_outp
) && SCM_OPINFPORTP (outp
))
189 || (SCM_NIMP (outp
) && SCM_OPOUTFPORTP (outp
))))
192 scm_misc_error (s_scm_readline
,
193 "Output port is not open or not a file port",
197 if (!(SCM_UNBNDP (read_hook
) || SCM_FALSEP (read_hook
)))
199 if (!(SCM_NFALSEP (scm_thunk_p (read_hook
))))
202 scm_wrong_type_arg (s_scm_readline
, SCM_ARG4
, read_hook
);
204 before_read
= read_hook
;
207 scm_readline_init_ports (inp
, outp
);
209 ans
= scm_internal_catch (SCM_BOOL_T
,
210 (scm_catch_body_t
) internal_readline
,
214 fclose (rl_instream
);
215 fclose (rl_outstream
);
228 /* We should rather use scm_mutex_try_lock when it becomes available */
229 scm_mutex_lock (&reentry_barrier_mutex
);
236 scm_mutex_unlock (&reentry_barrier_mutex
);
239 scm_misc_error (s_scm_readline
, "readline is not reentrant", SCM_EOL
);
243 handle_error (void *data
, SCM tag
, SCM args
)
245 rl_free_line_state ();
246 rl_cleanup_after_signal ();
247 fputc ('\n', rl_outstream
); /* We don't want next output on this line */
248 fclose (rl_instream
);
249 fclose (rl_outstream
);
251 scm_handle_by_throw (data
, tag
, args
);
252 return SCM_UNSPECIFIED
; /* never reached */
256 internal_readline (SCM text
)
260 char *prompt
= SCM_UNBNDP (text
) ? "" : SCM_CHARS (text
);
263 s
= readline (prompt
);
265 ret
= scm_makfrom0str (s
);
275 stream_from_fport (SCM port
, char *mode
, const char *subr
)
280 fd
= dup (((struct scm_fport
*) SCM_STREAM (port
))->fdes
);
287 f
= fdopen (fd
, mode
);
298 scm_readline_init_ports (SCM inp
, SCM outp
)
300 if (SCM_UNBNDP (inp
))
303 if (SCM_UNBNDP (outp
))
306 if (!(SCM_NIMP (inp
) && SCM_OPINFPORTP (inp
))) {
308 "Input port is not open or not a file port",
312 if (!(SCM_NIMP (outp
) && SCM_OPOUTFPORTP (outp
))) {
314 "Output port is not open or not a file port",
319 rl_instream
= stream_from_fport (inp
, "r", s_scm_readline
);
320 rl_outstream
= stream_from_fport (outp
, "w", s_scm_readline
);
325 SCM_DEFINE (scm_add_history
, "add-history", 1, 0, 0,
328 #define FUNC_NAME s_scm_add_history
331 SCM_VALIDATE_STRING (1,text
);
332 SCM_COERCE_SUBSTR (text
);
334 s
= SCM_CHARS (text
);
335 add_history (strdup (s
));
337 return SCM_UNSPECIFIED
;
342 SCM_DEFINE (scm_read_history
, "read-history", 1, 0, 0,
345 #define FUNC_NAME s_scm_read_history
347 SCM_VALIDATE_STRING (1,file
);
348 return SCM_NEGATE_BOOL(read_history (SCM_ROCHARS (file
)));
353 SCM_DEFINE (scm_write_history
, "write-history", 1, 0, 0,
356 #define FUNC_NAME s_scm_write_history
358 SCM_VALIDATE_STRING (1,file
);
359 return SCM_NEGATE_BOOL(write_history (SCM_ROCHARS (file
)));
364 SCM_DEFINE (scm_filename_completion_function
, "filename-completion-function", 2, 0, 0,
365 (SCM text
, SCM continuep
),
367 #define FUNC_NAME s_scm_filename_completion_function
371 SCM_VALIDATE_STRING (1,text
);
372 SCM_COERCE_SUBSTR (text
);
373 s
= filename_completion_function (SCM_CHARS (text
), SCM_NFALSEP (continuep
));
374 ans
= scm_makfrom0str (s
);
381 * The following has been modified from code contributed by
382 * Andrew Archibald <aarchiba@undergrad.math.uwaterloo.ca>
385 SCM scm_readline_completion_function_var
;
388 completion_function (char *text
, int continuep
)
390 SCM compfunc
= SCM_CDR (scm_readline_completion_function_var
);
393 if (SCM_FALSEP (compfunc
))
394 return NULL
; /* #f => completion disabled */
397 SCM t
= scm_makfrom0str (text
);
398 SCM c
= continuep
? SCM_BOOL_T
: SCM_BOOL_F
;
399 res
= scm_apply (compfunc
, SCM_LIST2 (t
, c
), SCM_EOL
);
401 if (SCM_FALSEP (res
))
404 if (!(SCM_NIMP (res
) && SCM_STRINGP (res
)))
405 scm_misc_error (s_scm_readline
,
406 "Completion function returned bogus value: %S",
408 SCM_COERCE_SUBSTR (res
);
409 return strdup (SCM_CHARS (res
));
413 /*Bouncing parenthesis (reimplemented by GH, 11/23/98, since readline is strict gpl)*/
415 static int match_paren (int x
, int k
);
416 static int find_matching_paren (int k
);
417 static void init_bouncing_parens ();
420 init_bouncing_parens ()
422 if (strncmp (rl_get_keymap_name (rl_get_keymap ()), "vi", 2))
424 rl_bind_key (')', match_paren
);
425 rl_bind_key (']', match_paren
);
426 rl_bind_key ('}', match_paren
);
431 find_matching_paren(int k
)
435 int end_parens_found
= 0;
437 /* Choose the corresponding opening bracket. */
438 if (k
== ')') c
= '(';
439 else if (k
== ']') c
= '[';
440 else if (k
== '}') c
= '{';
442 for (i
=rl_point
-2; i
>=0; i
--)
444 /* Is the current character part of a character literal? */
446 && rl_line_buffer
[i
- 1] == '\\'
447 && rl_line_buffer
[i
- 2] == '#')
449 else if (rl_line_buffer
[i
] == k
)
451 else if (rl_line_buffer
[i
] == '"')
453 /* Skip over a string literal. */
454 for (i
--; i
>= 0; i
--)
455 if (rl_line_buffer
[i
] == '"'
457 && rl_line_buffer
[i
- 1] == '\\'))
460 else if (rl_line_buffer
[i
] == c
)
462 if (end_parens_found
==0)
464 else --end_parens_found
;
471 match_paren (int x
, int k
)
475 struct timeval timeout
;
478 if (!SCM_READLINE_BOUNCE_PARENS
)
481 /* Did we just insert a quoted paren? If so, then don't bounce. */
482 if (rl_point
- 1 >= 1
483 && rl_line_buffer
[rl_point
- 2] == '\\')
486 tmp
= 1000 * SCM_READLINE_BOUNCE_PARENS
;
487 timeout
.tv_sec
= tmp
/ 1000000;
488 timeout
.tv_usec
= tmp
% 1000000;
490 FD_SET (fileno (rl_instream
), &readset
);
495 rl_point
= find_matching_paren (k
);
499 scm_internal_select (1, &readset
, NULL
, NULL
, &timeout
);
510 #include "readline.x"
511 scm_readline_completion_function_var
512 = scm_sysintern ("*readline-completion-function*", SCM_BOOL_F
);
513 rl_getc_function
= current_input_getc
;
514 rl_redisplay_function
= redisplay
;
515 rl_completion_entry_function
= (Function
*) completion_function
;
516 rl_basic_word_break_characters
= "\t\n\"'`;()";
517 rl_readline_name
= "Guile";
520 scm_mutex_init (&reentry_barrier_mutex
);
522 scm_init_opts (scm_readline_options
,
524 SCM_N_READLINE_OPTIONS
);
525 init_bouncing_parens();
526 scm_add_feature ("readline");