readline.c 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574
  1. /* readline.c --- line editing support for Guile */
  2. /* Copyright 1997,1999,2000-2003,2006-2010,2013,2018
  3. Free Software Foundation, Inc.
  4. This file is part of Guile-Readline.
  5. Guile-Readline is free software: you can redistribute it and/or
  6. modify it under the terms of the GNU General Public License as
  7. published by the Free Software Foundation, either version 3 of the
  8. License, or (at your option) any later version.
  9. Guile-Readline is distributed in the hope that it will be useful, but
  10. WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  12. General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with Guile-Readline. If not, see
  15. <https://www.gnu.org/licenses/>. */
  16. #ifdef HAVE_CONFIG_H
  17. # include <config.h>
  18. #endif
  19. #ifdef HAVE_RL_GETC_FUNCTION
  20. #include <stdio.h>
  21. #include <string.h>
  22. #include <unistd.h>
  23. #include <sys/time.h>
  24. #include <sys/select.h>
  25. #include <signal.h>
  26. #include <readline/readline.h>
  27. #include <readline/history.h>
  28. #include <libguile.h>
  29. #include "readline.h"
  30. scm_t_option scm_readline_opts[] = {
  31. { SCM_OPTION_BOOLEAN, "history-file", 1,
  32. "Use history file." },
  33. { SCM_OPTION_INTEGER, "history-length", 200,
  34. "History length." },
  35. { SCM_OPTION_INTEGER, "bounce-parens", 500,
  36. "Time (ms) to show matching opening parenthesis (0 = off)."},
  37. { SCM_OPTION_BOOLEAN, "bracketed-paste", 1,
  38. "Disable interpretation of control characters in pastes." },
  39. { 0 }
  40. };
  41. extern void stifle_history (int max);
  42. SCM_DEFINE (scm_readline_options, "readline-options-interface", 0, 1, 0,
  43. (SCM setting),
  44. "")
  45. #define FUNC_NAME s_scm_readline_options
  46. {
  47. SCM ans = scm_options (setting,
  48. scm_readline_opts,
  49. FUNC_NAME);
  50. if (!SCM_UNBNDP (setting)) {
  51. stifle_history (SCM_HISTORY_LENGTH);
  52. }
  53. return ans;
  54. }
  55. #undef FUNC_NAME
  56. #ifndef HAVE_STRDUP
  57. static char *
  58. strdup (char *s)
  59. {
  60. size_t len = strlen (s);
  61. char *new = malloc (len + 1);
  62. strcpy (new, s);
  63. return new;
  64. }
  65. #endif /* HAVE_STRDUP */
  66. #ifndef HAVE_RL_CLEANUP_AFTER_SIGNAL
  67. /* These are readline functions added in release 2.3. They will work
  68. * together with readline-2.1 and 2.2. (The readline interface is
  69. * disabled for earlier releases.)
  70. * They are declared static; if we want to use them elsewhere, then
  71. * we need external declarations for them, but at the moment, I don't
  72. * think anything else in Guile ought to use these.
  73. */
  74. extern void _rl_clean_up_for_exit ();
  75. extern void _rl_kill_kbd_macro ();
  76. extern int _rl_init_argument ();
  77. void
  78. rl_cleanup_after_signal ()
  79. {
  80. #ifdef HAVE_RL_CLEAR_SIGNALS
  81. _rl_clean_up_for_exit ();
  82. #endif
  83. (*rl_deprep_term_function) ();
  84. #ifdef HAVE_RL_CLEAR_SIGNALS
  85. rl_clear_signals ();
  86. #endif
  87. rl_pending_input = 0;
  88. }
  89. void
  90. rl_free_line_state ()
  91. {
  92. register HIST_ENTRY *entry;
  93. free_undo_list ();
  94. entry = current_history ();
  95. if (entry)
  96. entry->data = (char *)NULL;
  97. _rl_kill_kbd_macro ();
  98. rl_clear_message ();
  99. _rl_init_argument ();
  100. }
  101. #endif /* !HAVE_RL_CLEANUP_AFTER_SIGNAL */
  102. static int promptp;
  103. static SCM input_port;
  104. static SCM output_port;
  105. static SCM before_read;
  106. static int
  107. current_input_getc (FILE *in SCM_UNUSED)
  108. {
  109. if (promptp && scm_is_true (before_read))
  110. {
  111. scm_apply (before_read, SCM_EOL, SCM_EOL);
  112. promptp = 0;
  113. }
  114. return scm_get_byte_or_eof (input_port);
  115. }
  116. static int in_readline = 0;
  117. static SCM reentry_barrier_mutex;
  118. static SCM internal_readline (SCM text);
  119. static void unwind_readline (void *unused);
  120. static void reentry_barrier (void);
  121. SCM_DEFINE (scm_readline, "%readline", 0, 4, 0,
  122. (SCM text, SCM inp, SCM outp, SCM read_hook),
  123. "")
  124. #define FUNC_NAME s_scm_readline
  125. {
  126. SCM ans;
  127. reentry_barrier ();
  128. before_read = SCM_BOOL_F;
  129. if (!SCM_UNBNDP (text))
  130. {
  131. if (!scm_is_string (text))
  132. {
  133. --in_readline;
  134. scm_wrong_type_arg (s_scm_readline, SCM_ARG1, text);
  135. }
  136. }
  137. if (!((SCM_UNBNDP (inp) && SCM_OPINFPORTP (scm_current_input_port ()))
  138. || SCM_OPINFPORTP (inp)))
  139. {
  140. --in_readline;
  141. scm_misc_error (s_scm_readline,
  142. "Input port is not open or not a file port",
  143. SCM_EOL);
  144. }
  145. if (!((SCM_UNBNDP (outp) && SCM_OPOUTFPORTP (scm_current_output_port ()))
  146. || SCM_OPOUTFPORTP (outp)))
  147. {
  148. --in_readline;
  149. scm_misc_error (s_scm_readline,
  150. "Output port is not open or not a file port",
  151. SCM_EOL);
  152. }
  153. if (!(SCM_UNBNDP (read_hook) || scm_is_false (read_hook)))
  154. {
  155. if (scm_is_false (scm_thunk_p (read_hook)))
  156. {
  157. --in_readline;
  158. scm_wrong_type_arg (s_scm_readline, SCM_ARG4, read_hook);
  159. }
  160. before_read = read_hook;
  161. }
  162. scm_readline_init_ports (inp, outp);
  163. scm_dynwind_begin (0);
  164. scm_dynwind_unwind_handler (unwind_readline, NULL, 0);
  165. ans = internal_readline (text);
  166. scm_dynwind_end ();
  167. fclose (rl_instream);
  168. fclose (rl_outstream);
  169. --in_readline;
  170. return ans;
  171. }
  172. #undef FUNC_NAME
  173. static void
  174. reentry_barrier ()
  175. {
  176. int reentryp = 0;
  177. /* We should rather use scm_try_mutex when it becomes available */
  178. scm_lock_mutex (reentry_barrier_mutex);
  179. if (in_readline)
  180. reentryp = 1;
  181. else
  182. ++in_readline;
  183. scm_unlock_mutex (reentry_barrier_mutex);
  184. if (reentryp)
  185. scm_misc_error (s_scm_readline, "readline is not reentrant", SCM_EOL);
  186. }
  187. /* This function is only called on nonlocal exit from readline(). */
  188. static void
  189. unwind_readline (void *unused)
  190. {
  191. rl_free_line_state ();
  192. rl_cleanup_after_signal ();
  193. fputc ('\n', rl_outstream); /* We don't want next output on this line */
  194. fclose (rl_instream);
  195. fclose (rl_outstream);
  196. --in_readline;
  197. }
  198. static SCM
  199. internal_readline (SCM text)
  200. {
  201. SCM ret;
  202. char *s;
  203. char *prompt = SCM_UNBNDP (text) ? "" : scm_to_locale_string (text);
  204. promptp = 1;
  205. s = readline (prompt);
  206. if (s)
  207. ret = scm_from_port_string (s, output_port);
  208. else
  209. ret = SCM_EOF_VAL;
  210. if (!SCM_UNBNDP (text))
  211. free (prompt);
  212. free (s);
  213. return ret;
  214. }
  215. static FILE *
  216. stream_from_fport (SCM port, char *mode, const char *subr)
  217. {
  218. int fd;
  219. FILE *f;
  220. fd = dup (((struct scm_t_fport *) SCM_STREAM (port))->fdes);
  221. if (fd == -1)
  222. {
  223. --in_readline;
  224. scm_syserror (subr);
  225. }
  226. f = fdopen (fd, mode);
  227. if (f == NULL)
  228. {
  229. --in_readline;
  230. scm_syserror (subr);
  231. }
  232. return f;
  233. }
  234. void
  235. scm_readline_init_ports (SCM inp, SCM outp)
  236. {
  237. if (SCM_UNBNDP (inp))
  238. inp = scm_current_input_port ();
  239. if (SCM_UNBNDP (outp))
  240. outp = scm_current_output_port ();
  241. if (!SCM_OPINFPORTP (inp)) {
  242. scm_misc_error (0,
  243. "Input port is not open or not a file port",
  244. SCM_EOL);
  245. }
  246. if (!SCM_OPOUTFPORTP (outp)) {
  247. scm_misc_error (0,
  248. "Output port is not open or not a file port",
  249. SCM_EOL);
  250. }
  251. input_port = inp;
  252. output_port = outp;
  253. rl_instream = stream_from_fport (inp, "r", s_scm_readline);
  254. rl_outstream = stream_from_fport (outp, "w", s_scm_readline);
  255. }
  256. SCM_DEFINE (scm_add_history, "add-history", 1, 0, 0,
  257. (SCM text),
  258. "")
  259. #define FUNC_NAME s_scm_add_history
  260. {
  261. char* s;
  262. s = scm_to_locale_string (text);
  263. add_history (s);
  264. free (s);
  265. return SCM_UNSPECIFIED;
  266. }
  267. #undef FUNC_NAME
  268. SCM_DEFINE (scm_read_history, "read-history", 1, 0, 0,
  269. (SCM file),
  270. "")
  271. #define FUNC_NAME s_scm_read_history
  272. {
  273. char *filename;
  274. SCM ret;
  275. filename = scm_to_locale_string (file);
  276. ret = scm_from_bool (!read_history (filename));
  277. free (filename);
  278. return ret;
  279. }
  280. #undef FUNC_NAME
  281. SCM_DEFINE (scm_write_history, "write-history", 1, 0, 0,
  282. (SCM file),
  283. "")
  284. #define FUNC_NAME s_scm_write_history
  285. {
  286. char *filename;
  287. SCM ret;
  288. filename = scm_to_locale_string (file);
  289. ret = scm_from_bool (!write_history (filename));
  290. free (filename);
  291. return ret;
  292. }
  293. #undef FUNC_NAME
  294. SCM_DEFINE (scm_clear_history, "clear-history", 0, 0, 0,
  295. (),
  296. "Clear the history buffer of the readline machinery.")
  297. #define FUNC_NAME s_scm_clear_history
  298. {
  299. clear_history();
  300. return SCM_UNSPECIFIED;
  301. }
  302. #undef FUNC_NAME
  303. SCM_DEFINE (scm_filename_completion_function, "filename-completion-function", 2, 0, 0,
  304. (SCM text, SCM continuep),
  305. "")
  306. #define FUNC_NAME s_scm_filename_completion_function
  307. {
  308. char *s;
  309. char *c_text = scm_to_locale_string (text);
  310. #ifdef HAVE_RL_FILENAME_COMPLETION_FUNCTION
  311. s = rl_filename_completion_function (c_text, scm_is_true (continuep));
  312. #else
  313. s = filename_completion_function (c_text, scm_is_true (continuep));
  314. #endif
  315. free (c_text);
  316. if (!s)
  317. return SCM_BOOL_F;
  318. return scm_take_locale_string (s);
  319. }
  320. #undef FUNC_NAME
  321. /*
  322. * The following has been modified from code contributed by
  323. * Andrew Archibald <aarchiba@undergrad.math.uwaterloo.ca>
  324. */
  325. SCM scm_readline_completion_function_var;
  326. static char *
  327. completion_function (char *text, int continuep)
  328. {
  329. SCM compfunc = SCM_VARIABLE_REF (scm_readline_completion_function_var);
  330. SCM res;
  331. if (scm_is_false (compfunc))
  332. return NULL; /* #f => completion disabled */
  333. else
  334. {
  335. SCM t = scm_from_locale_string (text);
  336. SCM c = scm_from_bool (continuep);
  337. res = scm_apply (compfunc, scm_list_2 (t, c), SCM_EOL);
  338. if (scm_is_false (res))
  339. return NULL;
  340. return scm_to_locale_string (res);
  341. }
  342. }
  343. #if HAVE_RL_GET_KEYMAP_NAME
  344. /*Bouncing parenthesis (reimplemented by GH, 11/23/98, since readline is strict gpl)*/
  345. static int match_paren (int x, int k);
  346. static int find_matching_paren (int k);
  347. static void init_bouncing_parens ();
  348. static void
  349. init_bouncing_parens ()
  350. {
  351. Keymap km = rl_get_keymap ();
  352. if (km)
  353. {
  354. if (strncmp (rl_get_keymap_name (km), "vi", 2))
  355. {
  356. rl_bind_key (')', match_paren);
  357. rl_bind_key (']', match_paren);
  358. rl_bind_key ('}', match_paren);
  359. }
  360. }
  361. else
  362. scm_error (scm_misc_error_key, "", "readline has not been properly initialized",
  363. SCM_EOL, SCM_EOL);
  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_NAME */
  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. rl_variable_bind ("enable-bracketed-paste",
  464. SCM_READLINE_BRACKETED_PASTE ? "on" : "off");
  465. #if HAVE_RL_GET_KEYMAP_NAME
  466. init_bouncing_parens();
  467. #endif
  468. scm_add_feature ("readline");
  469. #endif /* HAVE_RL_GETC_FUNCTION */
  470. }
  471. /*
  472. Local Variables:
  473. c-file-style: "gnu"
  474. End:
  475. */