readline.c 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566
  1. /* readline.c --- line editing support for Guile */
  2. /* Copyright (C) 1997, 1999-2003, 2006-2010, 2013, 2016
  3. * Free Software Foundation, Inc.
  4. *
  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)
  8. * any later version.
  9. *
  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.
  14. *
  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
  19. *
  20. */
  21. #ifdef HAVE_CONFIG_H
  22. # include <config.h>
  23. #endif
  24. #ifdef HAVE_RL_GETC_FUNCTION
  25. #include "libguile.h"
  26. #include <stdio.h>
  27. #include <unistd.h>
  28. #include <readline/readline.h>
  29. #include <readline/history.h>
  30. #include <sys/time.h>
  31. #include <sys/select.h>
  32. #include <signal.h>
  33. #include "libguile/validate.h"
  34. #include "guile-readline/readline.h"
  35. scm_t_option scm_readline_opts[] = {
  36. { SCM_OPTION_BOOLEAN, "history-file", 1,
  37. "Use history file." },
  38. { SCM_OPTION_INTEGER, "history-length", 200,
  39. "History length." },
  40. { SCM_OPTION_INTEGER, "bounce-parens", 500,
  41. "Time (ms) to show matching opening parenthesis (0 = off)."},
  42. { 0 }
  43. };
  44. extern void stifle_history (int max);
  45. SCM_DEFINE (scm_readline_options, "readline-options-interface", 0, 1, 0,
  46. (SCM setting),
  47. "")
  48. #define FUNC_NAME s_scm_readline_options
  49. {
  50. SCM ans = scm_options (setting,
  51. scm_readline_opts,
  52. FUNC_NAME);
  53. if (!SCM_UNBNDP (setting)) {
  54. stifle_history (SCM_HISTORY_LENGTH);
  55. }
  56. return ans;
  57. }
  58. #undef FUNC_NAME
  59. #ifndef HAVE_STRDUP
  60. static char *
  61. strdup (char *s)
  62. {
  63. size_t len = strlen (s);
  64. char *new = malloc (len + 1);
  65. strcpy (new, s);
  66. return new;
  67. }
  68. #endif /* HAVE_STRDUP */
  69. #ifndef HAVE_RL_CLEANUP_AFTER_SIGNAL
  70. /* These are readline functions added in release 2.3. They will work
  71. * together with readline-2.1 and 2.2. (The readline interface is
  72. * disabled for earlier releases.)
  73. * They are declared static; if we want to use them elsewhere, then
  74. * we need external declarations for them, but at the moment, I don't
  75. * think anything else in Guile ought to use these.
  76. */
  77. extern void _rl_clean_up_for_exit ();
  78. extern void _rl_kill_kbd_macro ();
  79. extern int _rl_init_argument ();
  80. void
  81. rl_cleanup_after_signal ()
  82. {
  83. #ifdef HAVE_RL_CLEAR_SIGNALS
  84. _rl_clean_up_for_exit ();
  85. #endif
  86. (*rl_deprep_term_function) ();
  87. #ifdef HAVE_RL_CLEAR_SIGNALS
  88. rl_clear_signals ();
  89. #endif
  90. rl_pending_input = 0;
  91. }
  92. void
  93. rl_free_line_state ()
  94. {
  95. register HIST_ENTRY *entry;
  96. free_undo_list ();
  97. entry = current_history ();
  98. if (entry)
  99. entry->data = (char *)NULL;
  100. _rl_kill_kbd_macro ();
  101. rl_clear_message ();
  102. _rl_init_argument ();
  103. }
  104. #endif /* !HAVE_RL_CLEANUP_AFTER_SIGNAL */
  105. static int promptp;
  106. static SCM input_port;
  107. static SCM output_port;
  108. static SCM before_read;
  109. static int
  110. current_input_getc (FILE *in SCM_UNUSED)
  111. {
  112. if (promptp && scm_is_true (before_read))
  113. {
  114. scm_apply (before_read, SCM_EOL, SCM_EOL);
  115. promptp = 0;
  116. }
  117. return scm_get_byte_or_eof (input_port);
  118. }
  119. static int in_readline = 0;
  120. static SCM reentry_barrier_mutex;
  121. static SCM internal_readline (SCM text);
  122. static void unwind_readline (void *unused);
  123. static void reentry_barrier (void);
  124. SCM_DEFINE (scm_readline, "%readline", 0, 4, 0,
  125. (SCM text, SCM inp, SCM outp, SCM read_hook),
  126. "")
  127. #define FUNC_NAME s_scm_readline
  128. {
  129. SCM ans;
  130. reentry_barrier ();
  131. before_read = SCM_BOOL_F;
  132. if (!SCM_UNBNDP (text))
  133. {
  134. if (!scm_is_string (text))
  135. {
  136. --in_readline;
  137. scm_wrong_type_arg (s_scm_readline, SCM_ARG1, text);
  138. }
  139. }
  140. if (!((SCM_UNBNDP (inp) && SCM_OPINFPORTP (scm_current_input_port ()))
  141. || SCM_OPINFPORTP (inp)))
  142. {
  143. --in_readline;
  144. scm_misc_error (s_scm_readline,
  145. "Input port is not open or not a file port",
  146. SCM_EOL);
  147. }
  148. if (!((SCM_UNBNDP (outp) && SCM_OPOUTFPORTP (scm_current_output_port ()))
  149. || SCM_OPOUTFPORTP (outp)))
  150. {
  151. --in_readline;
  152. scm_misc_error (s_scm_readline,
  153. "Output port is not open or not a file port",
  154. SCM_EOL);
  155. }
  156. if (!(SCM_UNBNDP (read_hook) || scm_is_false (read_hook)))
  157. {
  158. if (scm_is_false (scm_thunk_p (read_hook)))
  159. {
  160. --in_readline;
  161. scm_wrong_type_arg (s_scm_readline, SCM_ARG4, read_hook);
  162. }
  163. before_read = read_hook;
  164. }
  165. scm_readline_init_ports (inp, outp);
  166. scm_dynwind_begin (0);
  167. scm_dynwind_unwind_handler (unwind_readline, NULL, 0);
  168. ans = internal_readline (text);
  169. scm_dynwind_end ();
  170. fclose (rl_instream);
  171. fclose (rl_outstream);
  172. --in_readline;
  173. return ans;
  174. }
  175. #undef FUNC_NAME
  176. static void
  177. reentry_barrier ()
  178. {
  179. int reentryp = 0;
  180. /* We should rather use scm_try_mutex when it becomes available */
  181. scm_lock_mutex (reentry_barrier_mutex);
  182. if (in_readline)
  183. reentryp = 1;
  184. else
  185. ++in_readline;
  186. scm_unlock_mutex (reentry_barrier_mutex);
  187. if (reentryp)
  188. scm_misc_error (s_scm_readline, "readline is not reentrant", SCM_EOL);
  189. }
  190. /* This function is only called on nonlocal exit from readline(). */
  191. static void
  192. unwind_readline (void *unused)
  193. {
  194. rl_free_line_state ();
  195. rl_cleanup_after_signal ();
  196. fputc ('\n', rl_outstream); /* We don't want next output on this line */
  197. fclose (rl_instream);
  198. fclose (rl_outstream);
  199. --in_readline;
  200. }
  201. static SCM
  202. internal_readline (SCM text)
  203. {
  204. SCM ret;
  205. char *s;
  206. char *prompt = SCM_UNBNDP (text) ? "" : scm_to_locale_string (text);
  207. promptp = 1;
  208. s = readline (prompt);
  209. if (s)
  210. {
  211. scm_t_port *pt = SCM_PTAB_ENTRY (output_port);
  212. ret = scm_from_stringn (s, strlen (s), pt->encoding,
  213. SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE);
  214. }
  215. else
  216. ret = SCM_EOF_VAL;
  217. if (!SCM_UNBNDP (text))
  218. free (prompt);
  219. free (s);
  220. return ret;
  221. }
  222. static FILE *
  223. stream_from_fport (SCM port, char *mode, const char *subr)
  224. {
  225. int fd;
  226. FILE *f;
  227. fd = dup (((struct scm_t_fport *) SCM_STREAM (port))->fdes);
  228. if (fd == -1)
  229. {
  230. --in_readline;
  231. scm_syserror (subr);
  232. }
  233. f = fdopen (fd, mode);
  234. if (f == NULL)
  235. {
  236. --in_readline;
  237. scm_syserror (subr);
  238. }
  239. return f;
  240. }
  241. void
  242. scm_readline_init_ports (SCM inp, SCM outp)
  243. {
  244. if (SCM_UNBNDP (inp))
  245. inp = scm_current_input_port ();
  246. if (SCM_UNBNDP (outp))
  247. outp = scm_current_output_port ();
  248. if (!SCM_OPINFPORTP (inp)) {
  249. scm_misc_error (0,
  250. "Input port is not open or not a file port",
  251. SCM_EOL);
  252. }
  253. if (!SCM_OPOUTFPORTP (outp)) {
  254. scm_misc_error (0,
  255. "Output port is not open or not a file port",
  256. SCM_EOL);
  257. }
  258. input_port = inp;
  259. output_port = outp;
  260. rl_instream = stream_from_fport (inp, "r", s_scm_readline);
  261. rl_outstream = stream_from_fport (outp, "w", s_scm_readline);
  262. }
  263. SCM_DEFINE (scm_add_history, "add-history", 1, 0, 0,
  264. (SCM text),
  265. "")
  266. #define FUNC_NAME s_scm_add_history
  267. {
  268. char* s;
  269. s = scm_to_locale_string (text);
  270. add_history (s);
  271. free (s);
  272. return SCM_UNSPECIFIED;
  273. }
  274. #undef FUNC_NAME
  275. SCM_DEFINE (scm_read_history, "read-history", 1, 0, 0,
  276. (SCM file),
  277. "")
  278. #define FUNC_NAME s_scm_read_history
  279. {
  280. char *filename;
  281. SCM ret;
  282. filename = scm_to_locale_string (file);
  283. ret = scm_from_bool (!read_history (filename));
  284. free (filename);
  285. return ret;
  286. }
  287. #undef FUNC_NAME
  288. SCM_DEFINE (scm_write_history, "write-history", 1, 0, 0,
  289. (SCM file),
  290. "")
  291. #define FUNC_NAME s_scm_write_history
  292. {
  293. char *filename;
  294. SCM ret;
  295. filename = scm_to_locale_string (file);
  296. ret = scm_from_bool (!write_history (filename));
  297. free (filename);
  298. return ret;
  299. }
  300. #undef FUNC_NAME
  301. SCM_DEFINE (scm_clear_history, "clear-history", 0, 0, 0,
  302. (),
  303. "Clear the history buffer of the readline machinery.")
  304. #define FUNC_NAME s_scm_clear_history
  305. {
  306. clear_history();
  307. return SCM_UNSPECIFIED;
  308. }
  309. #undef FUNC_NAME
  310. SCM_DEFINE (scm_filename_completion_function, "filename-completion-function", 2, 0, 0,
  311. (SCM text, SCM continuep),
  312. "")
  313. #define FUNC_NAME s_scm_filename_completion_function
  314. {
  315. char *s;
  316. SCM ans;
  317. char *c_text = scm_to_locale_string (text);
  318. #ifdef HAVE_RL_FILENAME_COMPLETION_FUNCTION
  319. s = rl_filename_completion_function (c_text, scm_is_true (continuep));
  320. #else
  321. s = filename_completion_function (c_text, scm_is_true (continuep));
  322. #endif
  323. ans = scm_take_locale_string (s);
  324. free (c_text);
  325. return ans;
  326. }
  327. #undef FUNC_NAME
  328. /*
  329. * The following has been modified from code contributed by
  330. * Andrew Archibald <aarchiba@undergrad.math.uwaterloo.ca>
  331. */
  332. SCM scm_readline_completion_function_var;
  333. static char *
  334. completion_function (char *text, int continuep)
  335. {
  336. SCM compfunc = SCM_VARIABLE_REF (scm_readline_completion_function_var);
  337. SCM res;
  338. if (scm_is_false (compfunc))
  339. return NULL; /* #f => completion disabled */
  340. else
  341. {
  342. SCM t = scm_from_locale_string (text);
  343. SCM c = scm_from_bool (continuep);
  344. res = scm_apply (compfunc, scm_list_2 (t, c), SCM_EOL);
  345. if (scm_is_false (res))
  346. return NULL;
  347. return scm_to_locale_string (res);
  348. }
  349. }
  350. #if HAVE_RL_GET_KEYMAP
  351. /*Bouncing parenthesis (reimplemented by GH, 11/23/98, since readline is strict gpl)*/
  352. static int match_paren (int x, int k);
  353. static int find_matching_paren (int k);
  354. static void init_bouncing_parens ();
  355. static void
  356. init_bouncing_parens ()
  357. {
  358. if (strncmp (rl_get_keymap_name (rl_get_keymap ()), "vi", 2))
  359. {
  360. rl_bind_key (')', match_paren);
  361. rl_bind_key (']', match_paren);
  362. rl_bind_key ('}', match_paren);
  363. }
  364. }
  365. static int
  366. find_matching_paren(int k)
  367. {
  368. register int i;
  369. register char c = 0;
  370. int end_parens_found = 0;
  371. /* Choose the corresponding opening bracket. */
  372. if (k == ')') c = '(';
  373. else if (k == ']') c = '[';
  374. else if (k == '}') c = '{';
  375. for (i=rl_point-2; i>=0; i--)
  376. {
  377. /* Is the current character part of a character literal? */
  378. if (i - 2 >= 0
  379. && rl_line_buffer[i - 1] == '\\'
  380. && rl_line_buffer[i - 2] == '#')
  381. ;
  382. else if (rl_line_buffer[i] == k)
  383. end_parens_found++;
  384. else if (rl_line_buffer[i] == '"')
  385. {
  386. /* Skip over a string literal. */
  387. for (i--; i >= 0; i--)
  388. if (rl_line_buffer[i] == '"'
  389. && ! (i - 1 >= 0
  390. && rl_line_buffer[i - 1] == '\\'))
  391. break;
  392. }
  393. else if (rl_line_buffer[i] == c)
  394. {
  395. if (end_parens_found==0)
  396. return i;
  397. else --end_parens_found;
  398. }
  399. }
  400. return -1;
  401. }
  402. static int
  403. match_paren (int x, int k)
  404. {
  405. int tmp;
  406. int fno;
  407. fd_set readset;
  408. struct timeval timeout;
  409. rl_insert (x, k);
  410. if (!SCM_READLINE_BOUNCE_PARENS)
  411. return 0;
  412. /* Did we just insert a quoted paren? If so, then don't bounce. */
  413. if (rl_point - 1 >= 1
  414. && rl_line_buffer[rl_point - 2] == '\\')
  415. return 0;
  416. tmp = 1000 * SCM_READLINE_BOUNCE_PARENS;
  417. timeout.tv_sec = tmp / 1000000;
  418. timeout.tv_usec = tmp % 1000000;
  419. FD_ZERO (&readset);
  420. fno = fileno (rl_instream);
  421. FD_SET (fno, &readset);
  422. if (rl_point > 1)
  423. {
  424. tmp = rl_point;
  425. rl_point = find_matching_paren (k);
  426. if (rl_point > -1)
  427. {
  428. rl_redisplay ();
  429. select (fno + 1, &readset, NULL, NULL, &timeout);
  430. }
  431. rl_point = tmp;
  432. }
  433. return 0;
  434. }
  435. #endif /* HAVE_RL_GET_KEYMAP */
  436. #endif /* HAVE_RL_GETC_FUNCTION */
  437. void
  438. scm_init_readline ()
  439. {
  440. #ifdef HAVE_RL_GETC_FUNCTION
  441. #include "guile-readline/readline.x"
  442. scm_readline_completion_function_var
  443. = scm_c_define ("*readline-completion-function*", SCM_BOOL_F);
  444. rl_getc_function = current_input_getc;
  445. #if defined (_RL_FUNCTION_TYPEDEF)
  446. rl_completion_entry_function = (rl_compentry_func_t*) completion_function;
  447. #else
  448. rl_completion_entry_function = (Function*) completion_function;
  449. #endif
  450. rl_basic_word_break_characters = " \t\n\"'`;()";
  451. rl_readline_name = "Guile";
  452. /* Let Guile handle signals. */
  453. #if defined (HAVE_DECL_RL_CATCH_SIGNALS) && HAVE_DECL_RL_CATCH_SIGNALS
  454. rl_catch_signals = 0;
  455. #endif
  456. /* But let readline handle SIGWINCH. */
  457. #if defined (HAVE_DECL_RL_CATCH_SIGWINCH) && HAVE_DECL_RL_CATCH_SIGWINCH
  458. rl_catch_sigwinch = 1;
  459. #endif
  460. reentry_barrier_mutex = scm_make_mutex ();
  461. scm_init_opts (scm_readline_options,
  462. scm_readline_opts);
  463. #if HAVE_RL_GET_KEYMAP
  464. init_bouncing_parens();
  465. #endif
  466. scm_add_feature ("readline");
  467. #endif /* HAVE_RL_GETC_FUNCTION */
  468. }
  469. /*
  470. Local Variables:
  471. c-file-style: "gnu"
  472. End:
  473. */