1;;; readline & history interface
2;;; http://tiswww.case.edu/php/chet/readline/readline.html
3;;; http://tiswww.case.edu/php/chet/readline/history.html
4;;;
5;;; Copyright (C) 2005-2011 by Sam Steingold
6;;; Copyright (C) 2017 Bruno Haible
7;;; This is Free Software, distributed under the GNU GPL v2+
8;;; See http://www.gnu.org/copyleft/gpl.html
9;;;
10;;; based on readline 6.3
11;;; to upgrade: download readline source distributions and diff headers
12
13(defpackage "READLINE"
14  (:use "CL" "EXT" "FFI")
15  (:shadowing-import-from "EXPORTING"
16    #:defconstant #:defun #:defmacro #:defvar #:def-c-type #:def-c-enum
17    #:def-c-struct #:def-c-var #:def-c-const #:def-call-out)
18  (:documentation "
19Interface to the GNU readline and history library. It allows you to
20- use readline functionality for user input in your programs
21  (see functions readline, add-history, and stream *readline-input-stream*)
22- expand readline functionality with new functions that can be bound to keys
23  (see add-defun, add-funmap-entry)
24- run things on background while waiting for user input (see event-hook)
25- more stuff (read readline info pages)"))
26
27(in-package "READLINE")
28
29(setf (documentation (find-package "READLINE") 'sys::impnotes) "readline-mod")
30
31;;; foreign function definitions
32(default-foreign-language :stdc)
33(eval-when (compile) (setq *foreign-guard* t))
34
35(c-lines "#include \"config.h\"~%") ; local readline config
36(c-lines "#include <stdio.h>~%")
37
38;;; ------ readline ------
39
40(c-lines "#include <readline/readline.h>~%")
41
42(def-c-const readline-version-number (:name "RL_READLINE_VERSION")
43  (:documentation "Readline numeric version, see also `readline-version'."))
44(def-c-const readline-version-major (:name "RL_VERSION_MAJOR")
45  (:documentation "Readline major version."))
46(def-c-const readline-version-minor (:name "RL_VERSION_MINOR")
47  (:documentation "Readline minor version."))
48
49(def-c-type command-func-t
50    (c-function (:arguments (rep int) (char int))
51                (:return-type int)))
52(def-c-type compentry-func-t
53    (c-function (:arguments (rep c-string) (char int))
54                (:return-type c-string)))
55(def-c-type completion-func-t
56    (c-function (:arguments (rep c-string) (char int) (rep int))
57                (:return-type (c-ptr c-string))))
58(def-c-type readline-hook-function (c-function (:return-type int)))
59(def-c-type readline-vcpfunc (c-function (:arguments (text c-string))))
60(def-c-type keymap c-pointer)
61
62(c-lines "#if RL_VERSION_MAJOR >= 7
63typedef unsigned long rl_readline_state_t;
64#else
65typedef int rl_readline_state_t;
66#endif~%")
67(c-lines "#define HAVE_RL_READLINE_STATE_T 1~%")
68(def-c-type rl_readline_state_t)
69
70;;; Basic behavior
71(def-call-out readline (:name "readline")
72  (:documentation
73    "Prompt and return string read from readline library or nil as eof.")
74  (:arguments (prompt c-string))
75  (:return-type c-string :malloc-free))
76
77(def-call-out set-prompt (:name "rl_set_prompt") ; untested
78  (:arguments (prompt c-string))
79  (:return-type int))
80
81(def-call-out initialize (:name "rl_initialize")
82  (:arguments) (:return-type int))
83
84(def-call-out read-init-file (:name "rl_read_init_file")
85  (:arguments (name c-string))
86  (:return-type int))
87
88;;; Function naming
89
90(def-call-out add-defun (:name "rl_add_defun")
91  (:arguments (name c-string :in :malloc-free)
92              (callback command-func-t) (key int))
93  (:return-type int)
94  (:documentation "Bind function to a name and key. You can use
95name in ~/.inputrc. This is preferred way of adding new functions."))
96
97;;; Keymaps
98(def-call-out make-bare-keymap (:name "rl_make_bare_keymap") ; untested
99  (:documentation "Make empty keymap.")
100  (:arguments) (:return-type keymap))
101
102(def-call-out copy-keymap (:name "rl_copy_keymap") ; untested
103  (:arguments (map keymap) (:return-type keymap)))
104
105(def-call-out make-keymap (:name "rl_make_keymap") ; untested
106  (:documentation "Make simple keymap - chars bound to self-insert etc.")
107  (:arguments) (:return-type keymap))
108
109(def-call-out discard-keymap (:name "rl_discard_keymap") ; untested
110  (:documentation "Free the storage associated with the data in a keymap.")
111  (:arguments (map keymap)) (:return-type nil))
112
113(def-call-out free-keymap (:name "rl_free_keymap") ; untested
114  (:documentation "Free all storage associated with a keymap.")
115  (:arguments (map keymap)) (:return-type nil))
116
117(def-call-out get-keymap (:name "rl_get_keymap") ; untested
118  (:documentation "Return current keymap")
119  (:arguments) (:return-type keymap))
120
121(def-call-out set-keymap (:name "rl_set_keymap") ; untested
122  (:documentation "Set keymap as current")
123  (:arguments (map keymap)) (:return-type nil))
124
125(def-call-out get-keymap-by-name (:name "rl_get_keymap_by_name") ; untested
126  (:documentation "Get keymap with given name (e.g., emacs, vi)")
127  (:arguments (name c-string)) (:return-type keymap))
128
129(def-call-out get-keymap-name (:name "rl_get_keymap_by_name") ; untested
130  (:arguments (keymap keymap)) (:return-type c-string))
131
132;;; Binding Keys
133
134(def-call-out bind-key (:name "rl_bind_key")
135  (:arguments (key int) (callback command-func-t))
136  (:return-type int))
137
138(def-call-out bind-key-in-map (:name "rl_bind_key_in_map") ; untested
139  (:arguments (key int) (callback command-func-t) (map keymap))
140  (:return-type int))
141
142(def-call-out bind-key-if-unbound (:name "rl_bind_key_if_unbound") ; untested
143  (:arguments (key int) (callback command-func-t))
144  (:return-type int))
145
146(def-call-out bind-key-if-unbound-in-map (:name "rl_bind_key_if_unbound_in_map") ; untested
147  (:arguments (key int) (callback command-func-t) (map keymap))
148  (:return-type int))
149
150(def-call-out unbind-key (:name "rl_unbind_key")
151  (:arguments (key int))
152  (:return-type int))
153
154(def-call-out unbind-key-in-map (:name "rl_unbind_key_in_map") ; untested
155  (:arguments (key int) (map keymap))
156  (:return-type int))
157
158(def-call-out unbind-function-in-map (:name "rl_unbind_function_in_map") ; untested
159  (:arguments (fn command-func-t) (map keymap))
160  (:return-type int))
161
162(def-call-out unbind-command-in-map (:name "rl_unbind_command_in_map") ; untested
163  (:arguments (command c-string) (map keymap))
164  (:return-type int))
165
166(def-call-out bind-keyseq (:name "rl_bind_keyseq")
167  (:arguments (keyseq c-string)
168              (callback command-func-t))
169  (:return-type int))
170
171(def-call-out bind-keyseq-in-map (:name "rl_bind_keyseq_in_map")
172  (:arguments (keyseq c-string) (callback command-func-t) (map keymap))
173  (:return-type int))
174
175; set-key is equivalent to bind-keyseq-in-map
176
177(def-call-out bind-keyseq-if-unbound (:name "rl_bind_keyseq_if_unbound"); untested
178  (:arguments (keyseq c-string)
179              (callback command-func-t))
180  (:return-type int))
181
182(def-call-out bind-keyseq-if-unbound-in-map (:name "rl_bind_keyseq_if_unbound_in_map"); untested
183  (:arguments (keyseq c-string) (callback command-func-t) (map keymap))
184  (:return-type int))
185
186(def-call-out generic-bind (:name "rl_generic_bind") ; untested
187  (:arguments (type int) (keyseq c-string) (data c-pointer) (map keymap))
188  (:return-type int))
189
190(def-call-out parse-and-bind (:name "rl_parse_and_bind")
191  (:arguments (line c-string))
192  (:return-type int))
193
194;;; Associating Function Names and Bindings
195
196(def-call-out named-function (:name "rl_named_function")
197  (:arguments (name c-string))
198  (:return-type command-func-t))
199
200(def-call-out function-of-keyseq (:name "rl_function_of_keyseq")
201  (:arguments (keyseq c-string) (map keymap) (type (c-ptr int) :out))
202  (:return-type command-func-t))
203
204(def-call-out invoking-keyseqs (:name "rl_invoking_keyseqs")
205  (:arguments (function command-func-t))
206  (:return-type (c-array-ptr c-string)))
207
208(def-call-out invoking-keyseqs-in-map (:name "rl_invoking_keyseqs_in_map") ; untested
209  (:arguments (function command-func-t) (map keymap))
210  (:return-type (c-array-ptr c-string)))
211
212(def-call-out function-dumper (:name "rl_function_dumper")
213  (:arguments (readable int))
214  (:return-type nil))
215
216(def-call-out list-funmap-names (:name "rl_list_funmap_names")
217  (:arguments) (:return-type nil))
218
219;;; !!! Returned array should be freed, but if I :malloc-free it, clisp
220;;; tries to free the c-string too. Bad.
221(def-call-out funmap-names (:name "rl_funmap_names") ; FIXME: leaks
222  (:arguments) (:return-type (c-array-ptr c-string)))
223
224(def-call-out add-funmap-entry  (:name "rl_add_funmap_entry") ; untested
225  (:arguments (name c-string :in :malloc-free) (callback command-func-t))
226  (:return-type int)
227  (:documentation "Bind function to a name known to readline."))
228
229
230;;; Allowing undoing
231
232;;; constants used by add-undo.
233(def-c-enum undo_code UNDO_DELETE UNDO_INSERT UNDO_BEGIN UNDO_END)
234
235(def-call-out begin-undo-group  (:name "rl_begin_undo_group") ; untested
236  (:arguments) (:return-type int))
237
238(def-call-out end-undo-group (:name "rl_end_undo_group") ; untested
239  (:arguments) (:return-type int))
240
241(def-call-out add-undo (:name "rl_add_undo") ; untested
242  (:arguments (what int) (start int) (end int) (text c-string))
243  (:return-type nil))
244
245(def-call-out free-undo-list (:name "rl_free_undo_list") ; untested
246  (:arguments) (:return-type nil))
247
248(def-call-out do-undo  (:name "rl_do_undo") ; untested
249  (:arguments) (:return-type int))
250
251(def-call-out modifying (:name "rl_modifying") ; untested
252  (:arguments (start int) (end int))
253  (:return-type int))
254
255;;; Redisplay
256
257(def-call-out redisplay (:name "rl_redisplay")
258  (:arguments) (:return-type int))
259
260(def-call-out forced-update-display (:name "rl_forced_update_display")
261  (:arguments) (:return-type int))
262
263(def-call-out on-new-line (:name "rl_on_new_line")
264  (:arguments) (:return-type int))
265
266(def-call-out on-new-line-with-prompt (:name "rl_on_new_line_with_prompt") ; untested
267  (:arguments) (:return-type int))
268
269(def-call-out clear-visible-line (:name "rl_clear_visible_line") ; untested
270  (:arguments) (:return-type int))
271
272(def-call-out reset-line-state (:name "rl_reset_line_state") ; untested
273  (:arguments) (:return-type int))
274
275(def-call-out crlf (:name "rl_crlf") ; untested
276  (:arguments) (:return-type int))
277
278(def-call-out show-char (:name "rl_show_char") ; untested
279  (:arguments (char int)) (:return-type int))
280
281(def-call-out message (:name "rl_message") ; untested
282  (:arguments (text c-string))
283  (:return-type int)
284  (:documentation
285    "Prints message (given as a format string - beware of %) in message area."))
286
287(def-call-out clear-message (:name "rl_clear_message") ; untested
288  (:arguments) (:return-type int))
289
290(def-call-out save-prompt (:name "rl_save_prompt") ; untested
291  (:arguments) (:return-type nil))
292
293(def-call-out restore-prompt (:name "rl_restore_prompt") ; untested
294  (:arguments) (:return-type nil))
295
296(def-call-out expand-prompt (:name "rl_expand_prompt") ; untested
297  (:arguments (prompt c-string)) (:return-type int))
298
299;;; Modifying text
300
301(def-call-out insert-text (:name "rl_insert_text")
302  (:arguments (text c-string))
303  (:return-type int))
304
305(def-call-out delete-text (:name "rl_delete_text") ; untested
306  (:arguments (start int) (end int))
307  (:return-type int))
308
309(def-call-out copy-text (:name "rl_copy_text") ; untested
310  (:arguments (start int) (end int))
311  (:return-type int))
312
313(def-call-out kill-text (:name "rl_kill_text") ; untested
314  (:arguments (start int) (end int))
315  (:return-type int))
316
317(def-call-out push-macro-input (:name "rl_push_macro_input")
318  (:arguments (macro c-string))
319  (:return-type int))
320
321;;; Character input
322
323(def-call-out read-key (:name "rl_read_key") ; untested
324  (:arguments) (:return-type int))
325
326(def-call-out getc (:name "rl_getc") ; untested
327  (:arguments (stream c-pointer)) (:return-type int))
328
329(def-call-out stuff-char (:name "rl_stuff_char") ; untested
330  (:arguments (char int)) (:return-type int))
331
332(def-call-out execute-next (:name "rl_execute_next") ; untested
333  (:arguments (char int)) (:return-type int))
334
335(def-call-out clear-pending-input (:name "rl_clear_pending_input") ; untested
336  (:arguments) (:return-type int))
337
338(def-call-out set-keyboard-input-timeout (:name "rl_set_keyboard_input_timeout")
339  (:arguments (microseconds int))
340  (:return-type int)) ; returns old value
341
342;;; Terminal management
343
344(def-call-out prep-terminal (:name "rl_prep_terminal") ; untested
345  (:arguments (meta-flag int)) (:return-type nil))
346
347(def-call-out deprep-terminal (:name "rl_deprep_terminal") ; untested
348  (:arguments) (:return-type nil))
349
350(def-call-out tty-set-default-bindings (:name "rl_tty_set_default_bindings") ; untested
351  (:arguments (map keymap)) (:return-type nil))
352
353(def-call-out reset-terminal (:name "rl_reset_terminal") ; untested
354  (:arguments (terminal-name c-string)) (:return-type int))
355
356
357;;; Utility
358
359(def-call-out replace-line (:name "rl_replace_line") ; untested
360  (:arguments (new-line c-string) (clear-undo int))
361  (:return-type nil))
362
363(def-call-out extend-line-buffer (:name "rl_extend_line_buffer") ; untested
364  (:arguments (len int))
365  (:return-type int))
366
367(def-call-out ding (:name "rl_ding")
368  (:arguments) (:return-type int))
369
370(def-call-out alphabetic (:name "rl_alphabetic")
371  (:arguments (c int)) (:return-type int))
372
373(def-call-out free (:name "rl_free")
374  (:arguments (arg c-pointer)) (:return-type nil))
375
376(def-call-out display-match-list (:name "rl_display_match_list")
377  (:arguments (matches (c-array-ptr c-string)) (len int) (max int))
378  (:return-type nil))
379
380;;; Miscellaneous functions
381
382(def-call-out variable-value (:name "rl_variable_value")
383  (:arguments (variable c-string))
384  (:return-type c-string))
385
386(def-call-out variable-bind (:name "rl_variable_bind")
387  (:arguments (variable c-string) (value c-string))
388  (:return-type int))
389
390(def-call-out macro-dumper (:name "rl_macro_dumper") ; untested
391  (:arguments (readable int))
392  (:return-type nil))
393
394(def-call-out variable-dumper (:name "rl_variable_dumper") ; untested
395  (:arguments (readable int))
396  (:return-type nil))
397
398(def-call-out echo-signal-char (:name "rl_echo_signal_char") ; untested
399  (:arguments (readable int))
400  (:return-type nil))
401
402(def-call-out set-paren-blink-timeout (:name "rl_set_paren_blink_timeout") ; untested
403  (:arguments (u int))
404  (:return-type int))
405
406(def-call-out clear-history (:name "rl_clear_history") ; untested
407  (:arguments) (:return-type int))
408
409(def-call-out get-termcap (:name "rl_get_termcap") ; untested
410  (:arguments (cap c-string))
411  (:return-type c-string))
412
413;;; Signal Handling
414(def-call-out resize-terminal (:name "rl_resize_terminal")
415  (:arguments) (:return-type nil))
416
417(def-call-out set-screen-size (:name "rl_set_screen_size")
418  (:arguments (rows int) (cols int)) (:return-type nil))
419
420(def-call-out get-screen-size (:name "rl_get_screen_size")
421  (:arguments (rows (c-ptr int) :out) (cols (c-ptr int) :out))
422  (:return-type nil))
423
424(def-call-out reset-screen-size (:name "rl_reset_screen_size")
425  (:arguments) (:return-type nil))
426
427;;; Alternate interface
428(def-call-out callback-handler-install (:name "rl_callback_handler_install")
429  (:arguments (prompt c-string) (lhandler readline-vcpfunc)))
430(def-call-out callback-read-char (:name "rl_callback_read_char"))
431(def-call-out callback-handler-remove (:name "rl_callback_handler_remove"))
432
433
434
435;;; variables
436(def-c-var library-version (:name "rl_library_version")
437  (:documentation
438   "The version of this incarnation of the readline library, e.g., \"4.2\".")
439  (:type c-string) (:read-only t))
440(def-c-var readline-version (:name "rl_readline_version")
441  (:type int) (:read-only t)
442  (:documentation
443   "The version of this incarnation of the readline library, e.g., 0x0402."))
444(def-c-var gnu-readline-p (:name "rl_gnu_readline_p") (:type int)
445  (:documentation "True if this is real GNU readline."))
446(def-c-var readline-state (:name "rl_readline_state") (:type rl_readline_state_t)
447  (:documentation "Flags word encapsulating the current readline state."))
448(def-c-var editing-mode (:name "rl_editing_mode") (:type int)
449  (:documentation "Says which editing mode readline is currently using.
4501 means emacs mode; 0 means vi mode."))
451(defconstant editing-mode-vi 0)
452(defconstant editing-mode-emacs 1)
453(def-c-var insert-mode (:name "rl_insert_mode") (:type int)
454  (:documentation "Insert or overwrite mode for emacs mode.
4551 means insert mode; 0 means overwrite mode.
456Reset to insert mode on each input line."))
457(defconstant insert-mode-overwrite 0)
458(defconstant insert-mode-insert 1)
459(def-c-var readline-name (:name "rl_readline_name")
460  (:type c-string) (:alloc :malloc-free)
461  (:documentation "The name of the calling program.
462You should initialize this to whatever was in argv[0].
463It is used when parsing conditionals."))
464(def-c-var prompt (:name "rl_prompt") (:type c-string) (:read-only t)
465  (:documentation "The prompt readline uses.
466This is set from the argument to readline (),
467and should not be assigned to directly."))
468(def-c-var display-prompt (:name "rl_display_prompt")
469  (:type c-string) (:read-only t)
470  (:documentation "The prompt string that is actually displayed by rl_redisplay.
471Public so applications can more easily supply their own redisplay functions."))
472(def-c-var line-buffer (:name "rl_line_buffer") (:type c-string)
473  (:documentation "The line gathered so far."))
474(def-c-var point (:name "rl_point") (:type int)
475  (:documentation "The offset of current position in line-buffer"))
476(def-c-var end (:name "rl_end") (:type int)
477  (:documentation "The offset of current position in line-buffer"))
478(def-c-var mark (:name "rl_mark") (:type int)
479  (:documentation "The MARK (saved position) in the current line."))
480(def-c-var done (:name "rl_done") (:type int)
481  (:documentation
482    "Non-zero value causes Readline to return the current line immediately."))
483(def-c-var pending-input (:name "rl_pending_input") (:type int)
484  (:documentation "Setting this to a value makes it next keystroke read."))
485(def-c-var dispatching (:name "rl_dispatching") (:type int) (:read-only t)
486  (:documentation "Non-zero if function is being called from a key binding."))
487(def-c-var explicit-arg (:name "rl_explicit_arg") (:type int)
488  (:documentation "Non-zero if the user typed a numeric argument before executing the current function."))
489(def-c-var numeric-arg (:name "rl_numeric_arg") (:type int)
490  (:documentation "The current value of the numeric argument specified by the user."))
491(def-c-var last-func (:name "rl_last_func") (:type command-func-t)
492  (:documentation
493   "The address of the last command function Readline executed."))
494(def-c-var terminal-name (:name "rl_terminal_name") (:type c-string)
495  (:documentation "The name of the terminal to use."))
496(def-c-var instream (:name "rl_instream") (:type c-pointer))
497(def-c-var outstream (:name "rl_outstream") (:type c-pointer))
498(def-c-var prefer-env-winsize (:name "rl_prefer_env_winsize") (:type int)
499  (:documentation "If non-zero, Readline gives values of LINES and COLUMNS
500from the environment greater precedence than values fetched from the kernel
501when computing the screen dimensions."))
502(def-c-var startup-hook (:name "rl_startup_hook") (:type readline-hook-function)
503  (:documentation "If non-zero, then this is the address of a function to call
504just before readline_internal() prints the first prompt."))
505(def-c-var pre-input-hook (:name "rl_pre_input_hook")
506  (:type readline-hook-function)
507  (:documentation "If non-zero, this is the address of a function to call
508just before readline_internal_setup() returns and readline_internal starts
509reading input characters."))
510(def-c-var event-hook (:name "rl_event_hook") (:type readline-hook-function)
511  (:documentation "The address of a function to call periodically while
512Readline is awaiting character input, or NULL, for no event handling."))
513(def-c-var getc-function (:name "rl_getc_function")
514  (:type (c-function (:arguments (instream c-pointer)) (:return-type int)))
515  (:documentation "The address of the function to call to fetch a character
516from the current Readline input stream."))
517(def-c-var input-available-hook (:name "rl_input_available_hook")
518  (:type (c-function (:arguments) (:return-type int)))
519  (:documentation "The address of a function to call if Readline needs to know
520whether or not there is data available from the current input source."))
521
522;; Display variables.
523(def-c-var erase-empty-line (:name "rl_erase_empty_line") (:type int)
524  (:documentation "If non-zero, readline will erase the entire line,
525including any prompt, if the only thing typed on an otherwise-blank
526line is something bound to rl_newline."))
527(def-c-var already-prompted (:name "rl_already_prompted") (:type int)
528  (:documentation "If non-zero, the application has already printed the
529prompt (rl_prompt) before calling readline, so readline should not output
530it the first time redisplay is done."))
531(def-c-var num-chars-to-read (:name "rl_num_chars_to_read") (:type int)
532  (:documentation "A non-zero value means to read only this many characters
533rather than up to a character bound to accept-line."))
534(def-c-var executing-macro (:name "rl_executing_macro") (:type c-string)
535  (:documentation "The text of a currently-executing keyboard macro."))
536
537(def-c-var filename-quoting-desired (:name "rl_filename_quoting_desired")
538  (:type int)
539  (:documentation "Non-zero means that the results of the matches are to be
540quoted using double quotes (or an application-specific quoting mechanism)
541if the filename contains any characters in rl_word_break_chars.
542This is ALWAYS non-zero on entry, and can only be changed within a completion
543entry finder function."))
544(def-c-var attempted-completion-over (:name "rl_attempted_completion_over")
545  (:type int)
546  (:documentation "Non-zero means to suppress normal filename completion after
547the user-specified completion function has been called."))
548(def-c-var completion-type (:name "rl_completion_type") (:type int)
549  (:documentation "Set to a character describing the type of completion being
550attempted by rl_complete_internal; available for use by application completion
551functions."))
552(def-c-var completion-invoking-key (:name "rl_completion_invoking_key")
553  (:type int)
554  (:documentation
555   "Set to the last key used to invoke one of the completion functions"))
556(def-c-var completion-query-items (:name "rl_completion_query_items")
557  (:type int)
558  (:documentation "Up to this many items will be displayed in response to a
559possible-completions call.  After that, we ask the user if she
560is sure she wants to see them all.  The default value is 100."))
561(def-c-var completion-append-character (:name "rl_completion_append_character")
562  (:type int)
563  (:documentation "Character appended to completed words when at the end of
564the line.  The default is a space.  Nothing is added if this is '\0'."))
565(def-c-var completion-suppress-append (:name "rl_completion_suppress_append")
566  (:type int)
567  (:documentation "If set to non-zero by an application completion function,
568rl_completion_append_character will not be appended."))
569(def-c-var completion-quote-character (:name "rl_completion_quote_character")
570  (:type int)
571  (:documentation "Set to any quote character readline thinks it finds before
572any application completion function is called."))
573(def-c-var completion-found-quote (:name "rl_completion_found_quote")
574  (:type int) (:documentation "Set to a non-zero value if readline found
575quoting anywhere in the word to be completed; set before any application
576completion function is called."))
577(def-c-var completion-suppress-quote (:name "rl_completion_suppress_quote")
578  (:type int) (:documentation "If non-zero, the completion functions don't
579append any closing quote. This is set to 0 by rl_complete_internal and may be
580changed by an application-specific completion function."))
581(def-c-var sort-completion-matches (:name "rl_sort_completion_matches")
582  (:type int) (:documentation "If non-zero, readline will sort the completion
583matches.  On by default."))
584(def-c-var completion-mark-symlink-dirs (:type int)
585  (:name "rl_completion_mark_symlink_dirs")
586  (:documentation "If non-zero, a slash will be appended to completed filenames
587that are symbolic links to directory names, subject to the value of the
588mark-directories variable (which is user-settable).
589This exists so that application completion functions can override the user's
590preference (set via the mark-symlinked-directories variable) if appropriate.
591It's set to the value of _rl_complete_mark_symlink_dirs in
592rl_complete_internal before any application-specific completion
593function is called, so without that function doing anything, the user's
594preferences are honored."))
595(def-c-var ignore-completion-duplicates (:type int)
596  (:name "rl_ignore_completion_duplicates")
597  (:documentation "If non-zero, then disallow duplicates in the matches."))
598(def-c-var inhibit-completion (:name "rl_inhibit_completion") (:type int)
599  (:documentation "If this is non-zero, completion is (temporarily) inhibited,
600and the completion character will be inserted as any other."))
601
602(def-c-const state-none (:name "RL_STATE_NONE") ; 0x000000
603  (:documentation "no state; before first call"))
604(def-c-const state-initializing (:name "RL_STATE_INITIALIZING") ; 0x000001
605  (:documentation "initializing"))
606(def-c-const state-initialized (:name "RL_STATE_INITIALIZED") ; 0x000002
607  (:documentation "initialization done"))
608(def-c-const state-termprepped (:name "RL_STATE_TERMPREPPED") ; 0x000004
609  (:documentation "terminal is prepped"))
610(def-c-const state-readcmd (:name "RL_STATE_READCMD") ; 0x000008
611  (:documentation "reading a command key"))
612(def-c-const state-metanext (:name "RL_STATE_METANEXT") ; 0x000010
613  (:documentation "reading input after ESC"))
614(def-c-const state-dispatching (:name "RL_STATE_DISPATCHING") ; 0x000020
615  (:documentation "dispatching to a command"))
616(def-c-const state-moreinput (:name "RL_STATE_MOREINPUT") ; 0x000040
617  (:documentation "reading more input in a command function"))
618(def-c-const state-isearch (:name "RL_STATE_ISEARCH") ; 0x000080
619  (:documentation "doing incremental search"))
620(def-c-const state-nsearch (:name "RL_STATE_NSEARCH") ; 0x000100
621  (:documentation "doing non-inc search"))
622(def-c-const state-search (:name "RL_STATE_SEARCH") ; 0x000200
623  (:documentation "doing a history search"))
624(def-c-const state-numericarg (:name "RL_STATE_NUMERICARG") ; 0x000400
625  (:documentation "reading numeric argument"))
626(def-c-const state-macroinput (:name "RL_STATE_MACROINPUT") ; 0x000800
627  (:documentation "getting input from a macro"))
628(def-c-const state-macrodef (:name "RL_STATE_MACRODEF") ; 0x001000
629  (:documentation "defining keyboard macro"))
630(def-c-const state-overwrite (:name "RL_STATE_OVERWRITE") ; 0x002000
631  (:documentation "overwrite mode"))
632(def-c-const state-completing (:name "RL_STATE_COMPLETING") ; 0x004000
633  (:documentation "doing completion"))
634(def-c-const state-sighandler (:name "RL_STATE_SIGHANDLER") ; 0x008000
635  (:documentation "in readline sighandler"))
636(def-c-const state-undoing (:name "RL_STATE_UNDOING") ; 0x010000
637  (:documentation "doing an undo"))
638(def-c-const state-inputpending (:name "RL_STATE_INPUTPENDING") ; 0x020000
639  (:documentation "rl_execute_next called"))
640(def-c-const state-ttycsaved (:name "RL_STATE_TTYCSAVED") ; 0x040000
641  (:documentation "tty special chars saved"))
642(def-c-const state-callback (:name "RL_STATE_CALLBACK") ; 0x080000
643  (:documentation "using the callback interface"))
644(def-c-const state-vimotion (:name "RL_STATE_VIMOTION") ; 0x100000
645  (:documentation "reading vi motion arg"))
646(def-c-const state-multikey (:name "RL_STATE_MULTIKEY") ; 0x200000
647  (:documentation "reading multiple-key command"))
648(def-c-const state-vicmdonce (:name "RL_STATE_VICMDONCE") ; 0x400000
649  (:documentation "entered vi command mode at least once"))
650(def-c-const state-redisplaying (:name "RL_STATE_REDISPLAYING") ; 0x800000
651  (:documentation "updating terminal display"))
652(def-c-const state-done (:name "RL_STATE_DONE") ; 0x1000000
653  (:documentation "done; accepted line"))
654
655(def-c-const readerr ; (-2)
656  (:documentation " Input error; can be returned by (*rl_getc_function)
657if readline is reading a top-level command (RL_ISSTATE (RL_STATE_READCMD))."))
658
659(c-lines "#include <readline/rlconf.h>~%")
660
661(def-c-const default-inputrc (:name "DEFAULT_INPUTRC")
662  (:type c-string)              ; "~/.inputrc"
663  (:documentation
664   "The next-to-last-ditch effort file name for a user-specific init file."))
665
666(def-c-const sys-inputrc (:name "SYS_INPUTRC")
667  (:type c-string) ; "/etc/inputrc"
668  (:documentation
669   "The ultimate last-ditch filenname for an init file -- system-wide."))
670
671;;; ------ history ------
672
673(c-lines "#include <readline/history.h>~%")
674
675;;; History List Management
676
677(def-call-out using-history (:name "using_history")
678  (:arguments) (:return-type nil))
679
680(def-call-out add-history (:name "add_history")
681  (:arguments (line c-string)) (:return-type nil))
682
683#| ;; Use rl_clear_history, declared above.
684(def-call-out clear-history (:name "clear_history")
685  (:arguments) (:return-type nil))
686|#
687
688(def-call-out stifle-history (:name "stifle_history")
689  (:arguments (count int)) (:return-type nil))
690
691(def-call-out unstifle-history (:name "unstifle_history")
692  (:arguments) (:return-type int))
693
694(def-call-out history-stifled-p (:name "history_is_stifled")
695  (:arguments) (:return-type int))
696
697;;; Information About the History List
698
699(def-call-out where-history (:name "where_history")
700  (:arguments) (:return-type int))
701
702(def-call-out history-total-bytes (:name "history_total_bytes")
703  (:arguments) (:return-type int))
704
705;;; Moving Around the History List
706
707(def-call-out history-set-pos (:name "history_set_pos")
708  (:arguments (pos int)) (:return-type int))
709
710;;; Searching the History List
711
712(def-call-out history-search (:name "history_search")
713  (:arguments (string c-string) (direction int)) (:return-type int))
714
715(def-call-out history-search-prefix (:name "history_search_prefix")
716  (:arguments (string c-string) (direction int)) (:return-type int))
717
718(def-call-out history-search-pos (:name "history_search_pos")
719  (:arguments (string c-string) (direction int) (pos int)) (:return-type int))
720
721;;; Managing the History File
722
723(def-call-out read-history (:name "read_history")
724  (:arguments (file c-string)) (:return-type int))
725
726(def-call-out read-history-range (:name "read_history_range")
727  (:arguments (file c-string) (start int) (end int)) (:return-type int))
728
729(def-call-out write-history (:name "write_history")
730  (:arguments (file c-string)) (:return-type int))
731
732(def-call-out append-history (:name "append_history")
733  (:arguments (count int) (file c-string)) (:return-type int))
734
735(def-call-out history-truncate-file (:name "history_truncate_file")
736  (:arguments (file c-string) (nlines int)) (:return-type int))
737
738(c-lines "#include <readline/tilde.h>~%")
739(def-call-out tilde-expand (:name "tilde_expand")
740  (:arguments (string c-string)) (:return-type c-string))
741
742;;; done with ffi
743
744;;; Define input stream that will read from readline-enabled input.
745;;; This is not strictly interface to readline capability, but it makes the
746;;; interface more usable - you can, e.g., (read *readline-input-stream*)
747
748(defun readline-reader ()
749  "Read a single line using GNU readline with the standard CLISP prompt."
750  (let ((string (readline (ext:string-concat (sys::prompt-start)
751                                             (sys::prompt-body)
752                                             (sys::prompt-finish)))))
753    (declare (type (or null string) string))
754    (when string                ; string=NIL ==> EOF
755      (cond ((zerop (length string)) #1=#.(string #\NewLine))
756            (t (add-history string)
757               (ext:string-concat string #1#))))))
758
759(defvar *readline-input-stream*
760  (make-buffered-input-stream #'readline-reader nil)
761  "Use this input stream to allow readline editing.")
762
763(pushnew :readline *features*)
764(provide "readline")
765(pushnew "READLINE" custom:*system-package-list* :test #'string=)
766