Mercurial > core / lisp/ffi/readline/readline.lisp
changeset 661: |
39170f311b8c |
parent: |
da507f0274b3
|
author: |
Richard Westhaver <ellis@rwest.io> |
date: |
Sat, 21 Sep 2024 00:04:33 -0400 |
permissions: |
-rw-r--r-- |
description: |
add sk-def and sk-bind |
1 ;;; readline/readline.lisp --- Readline Alien Routines 3 ;; This implementation is based on Vindarel's cl-readline: https://github.com/vindarel/cl-readline 8 (define-alien-enum (rl-completion-type int :test eq) 10 :display-and-perform 33 13 :not-list-cmn-prefix 64) 15 (define-alien-type rl-hist-entry (struct rl-hist-entry 21 (define-alien-type rl-history-state 22 (struct rl-history-state 23 (hist-entries (array (* rl-hist-entry))) 29 (define-alien-enum (rl-undo-code int :test eq) 35 (define-alien-type rl-undo-list 37 (next (* (struct rl-undo-list))) 43 (define-alien-type rl-command-func 44 (function int int int)) 46 (define-alien-type rl-funmap 49 (function (* rl-command-func)))) 51 (define-alien-type rl-keymap-entry 52 (struct rl-keymap-entry 54 (function (* rl-command-func)))) 56 (define-alien-type rl-keymap (array rl-keymap-entry)) 58 (define-alien-type readline-state 59 (struct readline-state 70 (lastfunc (* rl-command-func)) 81 (entryfunc (* rl-command-func)) 82 (menuentryfunc (* rl-command-func)) 83 (ignorefunc (* rl-command-func)) 84 (attemptfunc (* rl-command-func)) 85 (wordbreakchars c-string) 86 (reserved (array char 64)))) 89 (macrolet ((def-rl-var (name var type) 90 `(define-alien-variable (,name ,var) ,type))) 91 (def-rl-var "rl_line_buffer" *line-buffer* c-string) 92 (def-rl-var "rl_point" *point* int) 93 (def-rl-var "rl_end" *end* int) 94 (def-rl-var "rl_mark" *mark* int) 95 (def-rl-var "rl_done" *point* boolean) 96 (def-rl-var "rl_num_chars_to_read" *num-chars-to-read* int) 97 (def-rl-var "rl_pending_input" *pending-input* int) 98 (def-rl-var "rl_dispatching" *point* boolean) 99 (def-rl-var "rl_erase_empty_line" *erase-empty-line* boolean) 100 (def-rl-var "rl_prompt" *prompt* c-string) 101 (def-rl-var "rl_display_prompt" *display-prompt* c-string) 102 (def-rl-var "rl_already_prompted" *already-prompted* boolean) 103 (def-rl-var "rl_library_version" *library-version* c-string) 104 (def-rl-var "rl_readline_version" *readline-version* int) 105 (def-rl-var "rl_gnu_readline_p" *gnu-readline-p* boolean) 106 (def-rl-var "rl_terminal_name" *terminal-name* c-string) 107 (def-rl-var "rl_readline_name" *readline-name* c-string) 108 (def-rl-var "rl_instream" *instream* (* t)) 109 (def-rl-var "rl_outstream" *outstream* (* t)) 110 (def-rl-var "rl_prefer_env_winsize" *prefer-env-winsize* boolean) 111 (def-rl-var "rl_last_func" *last-func* (* t)) 112 (def-rl-var "rl_startup_hook" *startup-hook* (* t)) 113 (def-rl-var "rl_pre_input_hook" *pre-input-hook* (* t)) 114 (def-rl-var "rl_event_hook" *event-hook* (* t)) 115 (def-rl-var "rl_getc_function" *getc-function* (* t)) 116 (def-rl-var "rl_signal_event_hook" *signal-event-hook* (* t)) 117 (def-rl-var "rl_input-available_hook" *input-available-hook* (* t)) 118 (def-rl-var "rl_redisplay_function" *redisplay-function* (* t)) 119 (def-rl-var "rl_prep_term_function" *prep-term-function* (* t)) 120 (def-rl-var "rl_deprep_term_function" *deprep-term-function* (* t)) 121 (def-rl-var "rl_executing_keymap" *executing-keymap* (* t)) 122 (def-rl-var "rl_binding_keymap" *binding-keymap* (* t)) 123 (def-rl-var "rl_executing_macro" *executing-macro* c-string) 124 (def-rl-var "rl_executing_key" *executing-key* char) 125 (def-rl-var "rl_executing_keyseq" *executing-keyseq* c-string) 126 (def-rl-var "rl_key_sequence_length" *key-sequence-length* int) 127 (def-rl-var "rl_readline_state" *readline-state* int) 128 (def-rl-var "rl_explicit_arg" *explicit-arg* boolean) 129 (def-rl-var "rl_numeric_arg" *numeric-arg* int) 130 (def-rl-var "rl_editing_mode" *editing-mode* int) 131 (def-rl-var "rl_catch_sigwinch" *catch-sigwinch* boolean) 132 (def-rl-var "rl_change_environment" *change-environment* boolean) 133 (def-rl-var "rl_attempted_completion_function" *attempted-completion-function* (* t)) 134 (def-rl-var "rl_completion_display_matches_hook" *completion-display-matches-hook* (* t)) 135 (def-rl-var "rl_basic_word_break_characters" *basic-word-break-characters* c-string) 136 (def-rl-var "rl_completer_word_break_character" *completer-word-break-characters* c-string) 137 (def-rl-var "rl_completion_query_items" *completer-query-items* int) 138 (def-rl-var "rl_completion_append_character" *completion-append-character* char) 139 (def-rl-var "rl_ignore_completion_duplicates" *ignore-completion-duplicates* boolean) 140 (def-rl-var "rl_attempted_completion_over" *attempted-completion-over* boolean) 141 (def-rl-var "rl_sort_completion_matches" *sort-completion-matches* boolean) 142 (def-rl-var "rl_completion_type" *completion-type* rl-completion-type) 143 (def-rl-var "rl_inhibit_completion" *inhibit-completion* boolean) 144 (def-rl-var "history_base" *history-base* int) 145 (def-rl-var "history_length" *history-length* int)) 148 (macrolet ((def-rl-int2 (&rest names) 150 ,@(loop for i in names 152 (std:with-gensyms (i1 i2) 153 `(define-alien-routine ,i int (,i1 int) (,i2 int))))))) 154 (def-rl-int2 "rl_digit_argument" "rl_universal_argument" "rl_forward_byte" 155 "rl_forward_char" "rl_forward" "rl_backward_byte" "rl_backward_char" "rl_backward" 156 "rl_beg_of_line" "rl_end_of_line" "rl_forward_word" "rl_backward_word" "rl_refresh_line" 157 "rl_clear_screen" "rl_clear_display" "rl_skip_csi_sequence" "rl_arrow_keys" 158 "rl_previous_screen_line" "rl_next_screen_line" 159 "rl_insert" "rl_quoted_insert" "rl_tab_insert" "rl_newline" "rl_do_lowercase_version" 160 "rl_rubout" "rl_delete" "rl_rubout_or_delete" "rl_delete_horizontal_space" "rl_delete_or_show_completions" 161 "rl_insert_comment" "rl_upcase_word" "rl_downcase_word" "rl_capitalize_word" "rl_transpose_words" 162 "rl_transpose_chars" "rl_char_search" "rl_backward_char_search" "rl_beginning_of_history" 163 "rl_end_of_history" "rl_get_next_history" "rl_get_previous_history" "rl_operate_and_get_next" 164 "rl_fetch_history" "rl_set_mark" "rl_exchange_point_and_mark" "rl_vi_editing_mode" 165 "rl_emacs_editing_mode" "rl_overwrite_mode" "rl_re_read_init_file" "rl_dump_functions" "rl_dump_macros" 166 "rl_dump_variables" "rl_complete" "rl_possible_completions" "rl_insert_completions" "rl_old_menu_complete" 167 "rl_backward_menu_complete" "rl_kill_word" "rl_backward_kill_word" "rl_kill_line" "rl_backward_kill_line" 168 "rl_kill_full_line" "rl_unix_word_rubout" "rl_unix_line_discard" "rl_copy_region_to_kill" "rl_kill_region" 169 "rl_copy_forward_word" "rl_copy_backward_word" "rl_yank" "rl_yank_pop" "rl_yank_nth_arg" "rl_yank_last_arg" 170 "rl_bracketed_paste_begin" 171 #+win32 "rl_paste_from_clipboard" 172 "rl_reverse_search_history" "rl_forward_search_history" "rl_start_kbd_macro" "rl_end_kbd_macro" 173 "rl_call_last_kbd_macro" "rl_print_last_kbd_macro" "rl_revert_line" "rl_undo_command" "rl_tilde_expand" 174 "rl_restart_output" "rl_stop_output" "rl_abort" "rl_tty_status" 175 "rl_history_search_forward" "rl_history_search_backward" "rl_history_substr_search_forward" 176 "rl_history_substr_search_backward" "rl_noninc_forward_search" "rl_noninc_reverse_search" 177 "rl_noninc_forward_search_again" "rl_noninc_reverse_search_again" 178 "rl_insert_close" "rl_vi_redo" "rl_vi_undo" "rl_vi_yank_arg" "rl_vi_fetch_history" "rl_vi_search_again" 179 "rl_vi_search" "rl_vi_complete" "rl_vi_tilde_expand" "rl_vi_prev_word" "rl_vi_next_word" "rl_vi_end_word" 180 "rl_vi_insert_beg" "rl_vi_append_mode" "rl_vi_append_eol" "rl_vi_eof_maybe" "rl_vi_insertion_mode" 181 "rl_vi_insert_mode" "rl_vi_movement_mode" "rl_vi_arg_digit" "rl_vi_change_case" "rl_vi_put" "rl_vi_column" 182 "rl_vi_delete_to" "rl_vi_change_to" "rl_vi_yank_to" "rl_vi_yank_pop" "rl_vi_rubout" "rl_vi_delete" 183 "rl_vi_back_to_indent" "rl_vi_unix_word_rubout" "rl_vi_first_print" "rl_vi_char_search" "rl_vi_match" 184 "rl_vi_change_char" "rl_vi_subst" "rl_vi_overstrike" "rl_vi_overstrike_delete" "rl_vi_replace" 185 "rl_vi_set_mark" "rl_vi_goto_mark" 186 ;; NOTE 2024-09-20: there are uppercase versions - fWord eWord 187 "rl_vi_fword" "rl_vi_bword" "rl_vi_eword")) 189 ;;; Well Published Functions 190 (define-alien-routine "readline" c-string (prompt c-string)) 191 (define-alien-routine "rl_set_prompt" int (prompt c-string)) 192 (define-alien-routine "rl_expand_prompt" int (prompt c-string)) 193 (define-alien-routine "rl_initialize" int) 194 ;; undocument; unused by readline 195 ;; (define-alien-routine "rl_discard_argument" int) 197 ;; [[file:/usr/include/readline/readline.h::/* Utility functions to bind keys to readline commands. */][last]] 198 (define-alien-routine "rl_add_defun" int (name c-string) (func (* rl-command-func))) 199 (define-alien-routine "rl_bind_key" int (key int) (function (* rl-command-func))) 200 (define-alien-routine "rl_bind_key_in_map" int (key int) (func (* rl-command-func)) (map rl-keymap)) 201 (define-alien-routine "rl_unbind_key" int (key int)) 202 (define-alien-routine "rl_unbind_key_in_map" int (key int) (map rl-keymap)) 203 (define-alien-routine "rl_bind_key_if_unbound" int (key int) (function (* rl-command-func))) 204 (define-alien-routine "rl_bind_key_if_unbound_in_map" int (key int) (function (* rl-command-func)) (map rl-keymap)) 205 (define-alien-routine "rl_generic_bind" int (key int) (str c-string) (name c-string) (map rl-keymap)) 206 (define-alien-routine "rl_variable_value" c-string (name c-string)) 207 (define-alien-routine "rl_variable_bind" int (name c-string) (val c-string)) 209 (define-alien-routine "rl_read_init_file" int (file c-string)) 210 (define-alien-routine "rl_parse_and_bind" int (binding c-string)) 213 (define-alien-routine "rl_make_bare_keymap" rl-keymap) 214 (define-alien-routine "rl_empty_keymap" int (map rl-keymap)) 215 (define-alien-routine "rl_copy_keymap" rl-keymap (map rl-keymap)) 216 (define-alien-routine "rl_make_keymap" rl-keymap) 217 (define-alien-routine "rl_discard_keymap" void (map rl-keymap)) 218 (define-alien-routine "rl_free_keymap" void (map rl-keymap)) 219 (define-alien-routine "rl_set_keymap" void (map rl-keymap)) 220 (define-alien-routine "rl_get_keymap" rl-keymap) 221 (define-alien-routine "rl_set_keymap_name" int (name c-string) (map rl-keymap)) 224 (define-alien-routine "rl_add_funmap_entry" int (name c-string) (function (* rl-command-func))) 225 (define-alien-routine "rl_funmap_names" (array c-string)) 228 (define-alien-routine "rl_push_macro_input" void (input c-string)) 231 (define-alien-routine "rl_add_undo" void (code rl-undo-code) (i1 int) (i2 int) (input c-string)) 232 (define-alien-routine "rl_free_undo_list" void) 233 (define-alien-routine "rl_do_undo" int) 234 (define-alien-routine "rl_begin_undo_group" int) 235 (define-alien-routine "rl_end_undo_group" int) 236 (define-alien-routine "rl_modifying" int (i1 int) (i2 int)) 239 (define-alien-routine "rl_redisplay" void) 240 (define-alien-routine "rl_on_new_line" int) 241 (define-alien-routine "rl_on_new_line_with_prompt" int) 242 (define-alien-routine "rl_forced_update_display" int) 243 (define-alien-routine "rl_clear_visible_line" int) 244 (define-alien-routine "rl_clear_message" int) 245 (define-alien-routine "rl_reset_line_state" int) 246 (define-alien-routine "rl_crlf" int) 249 (define-alien-routine "rl_keep_mark_active" void) 250 (define-alien-routine "rl_activate_mark" void) 251 (define-alien-routine "rl_deactivate_mark" void) 252 (define-alien-routine "rl_mark_active_p" int) 253 (define-alien-routine "rl_message" int) 254 (define-alien-routine "rl_show_char" int (char int)) 256 (define-alien-routine "rl_character_len" int (i1 int) (i2 int)) 257 (define-alien-routine "rl_redraw_prompt_last_line" void) 259 (define-alien-routine "rl_save_prompt" void) 260 (define-alien-routine "rl_restore_prompt" void) 263 (define-alien-routine "rl_replace_line" void (line c-string) (idx int)) 264 (define-alien-routine "rl_insert_text" int (text c-string)) 265 (define-alien-routine "rl_delete_text" int (i1 int) (i2 int)) 266 (define-alien-routine "rl_kill_text" int (i1 int) (i2 int)) 267 (define-alien-routine "rl_copy_text" c-string (i1 int) (i2 int)) 270 (define-alien-routine "rl_prep_terminal" void (i int)) 271 (define-alien-routine "rl_deprep_terminal" void) 272 (define-alien-routine "rl_tty_set_default_bindings" void (map rl-keymap)) 273 (define-alien-routine "rl_tty_unset_default_bindings" void (map rl-keymap)) 274 (define-alien-routine "rl_tty_set_echoing" int (val int)) 275 (define-alien-routine "rl_reset_terminal" int (val c-string)) 276 (define-alien-routine "rl_resize_terminal" void) 277 (define-alien-routine "rl_set_screen_size" void (x int) (y int)) 278 (define-alien-routine "rl_get_screen_size" void (i1 (* int)) (i2 (* int))) 279 (define-alien-routine "rl_reset_screen_size" void) 281 (define-alien-routine "rl_get_termcap" c-string (key c-string)) 284 (define-alien-routine "rl_stuff_char" int (c int)) 285 (define-alien-routine "rl_execute_next" int (i int)) 286 (define-alien-routine "rl_clear_pending_input" int) 287 (define-alien-routine "rl_read_key" int) 288 (define-alien-routine "rl_getc" int (c (* t))) ;; NOTE: (* FILE) 289 (define-alien-routine "rl_set_keyboard_input_timeout" int (val int)) 292 (define-alien-routine "rl_set_timeout" int (n1 unsigned-int) (n2 unsigned-int)) 293 (define-alien-routine "rl_timeout_remaining" int (n1 (* unsigned-int)) (n2 (* unsigned-int))) 296 (define-alien-routine "rl_extend_lind_buffer" void (i int)) 297 (define-alien-routine "rl_ding" int) 298 (define-alien-routine "rl_alphabetic" int (i int)) 299 (define-alien-routine "rl_free" void (o (* t))) 302 (define-alien-routine "rl_set_signals" int) 303 (define-alien-routine "rl_clear_signals" int) 304 (define-alien-routine "rl_cleanup_after_signal" void) 305 (define-alien-routine "rl_reset_after_signal" void) 306 (define-alien-routine "rl_free_line_state" void) 307 (define-alien-routine "rl_pending_signal" int) 308 (define-alien-routine "rl_check_signals" void) 309 (define-alien-routine "rl_echo_signal_char" void (c int)) 310 (define-alien-routine "rl_set_paren_blink_timeout" int (val int)) 313 (define-alien-routine "rl_clear_history" void) 314 (define-alien-routine "rl_maybe_save_line" int) 315 (define-alien-routine "rl_maybe_unsave_line" int) 316 (define-alien-routine "rl_maybe_replace_line" int) 319 (define-alien-routine "rl_complete_internal" int (i int)) 320 (define-alien-routine "rl_display_match_list" void (list (array c-string)) (i1 int) (i2 int)) 321 ;; (define-alien-routine "rl_completion_matches" (array c-string) (input c-string) (function (* rl-compentry-func))) 322 (define-alien-routine "rl_username_completion_function" c-string (name c-string) (i int)) 323 (define-alien-routine "rl_filename_completion_function" c-string (name c-string) (i int)) 324 (define-alien-routine "rl_completion_mode" int (function (* rl-command-func))) 327 (define-alien-routine "rl_save_state" int (state (* readline-state))) 328 (define-alien-routine "rl_restore_state" int (state (* readline-state))) 331 (define-alien-routine "using_history" void) 332 (define-alien-routine "add_history" void (line c-string)) 333 (define-alien-routine "clear_history" void) 334 (define-alien-routine "stifle_history" void (i int)) 335 (define-alien-routine "unstifle_history" int) 336 (define-alien-routine "history_is_stifled" int) 337 (define-alien-routine "history_list" (array (* rl-hist-entry))) 338 (define-alien-routine "previous_history" (* rl-hist-entry)) 339 (define-alien-routine "next_history" (* rl-hist-entry)) 341 (defvar +c-buffer-size+ 256 342 "How many bytes to allocate per Lisp string when converting list of 343 Lisp strings into array of C strings.") 345 (defmacro produce-callback (function return-type &optional func-arg-list) 346 "Return pointer to callback that calls FUNCTION. RETURN-TYPE specifies 347 return type of the function and FUNC-ARG-LIST is list of argument types (it 348 can be ommited if FUNCTION doesn't take any arguments)." 349 (let ((gensymed-list (mapcar (lambda (x) (list (gensym) x)) 351 (std:with-gensyms (temp) 354 (define-alien-callable ,temp ,return-type ,gensymed-list 355 (funcall ,function ,@(mapcar #'car gensymed-list))) 356 (alien-callable-function ',temp)))))) 358 (defun produce-callback* (function return-type &optional func-arg-list) 359 "Variant of PRODUCE-CALLBACK that should hopefully be more portable. 360 This avoids using a GENSYM as the name of a callback, and is also funcallable." 361 (let ((gensymed-list (mapcar (lambda (x) (list (gensym) x)) 363 (std:with-gensyms (temp) 366 (eval `(define-alien-callable ,temp ,return-type ,gensymed-list 367 (funcall ,function ,@(mapcar #'car gensymed-list)))) 368 (alien-callable-function temp)))))) 371 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 373 (defun recent-history-line-satisfies-p (predicate) 374 "Check if the most recent history line satisfies given predicate 375 PREDICATE. Return T if there is no history saved." 376 (if (zerop *history-length*) 378 (with-alien ((s rl-hist-entry)) 380 ;; TODO 2024-09-19: does SBCL know how to conver this to a lisp string automatically? 383 ;; (alien-funcall "history_get" 385 ;; (1- (+ *history-base* 386 ;; *history-length*))) 397 "Get a line from user with editing. PROMPT, if supplied, is printed before 398 reading of input. Non-NIL value of ALREADY-PROMPTED will tell Readline that 399 the application has printed prompt already. However, PROMPT must be supplied 400 in this case too, so redisplay functions can update the display properly. If 401 NUM-CHARS argument is a positive number, Readline will return after 402 accepting that many characters. If ERASE-EMPTY-LINE is not NIL, `readline' 403 will completely erase the current line, including any prompt, any time a 404 newline is typed as the only character on an otherwise-empty line. The 405 cursor is moved to the beginning of the newly-blank line. Supplying 406 ADD-HISTORY tells Readline that user's input should be added to 407 history. However, blank lines don't get into history anyway. NOVELTY-CHECK, 408 if given, must be a predicate that takes two strings: the actual line and 409 the most recent history line. Only when the predicate evaluates to non-NIL 410 value new line will be added to the history. Return value on success is the 411 actual string and NIL on failure." 412 (setf *already-prompted* already-prompted 413 *num-chars-to-read* (or num-chars 0) 414 *erase-empty-line* erase-empty-line) 415 (let* ((prompt (if prompt (string prompt) "")) 416 (ptr (readline prompt))) 420 (when (and add-history 421 (not (sequence:emptyp str)) 422 (or (not novelty-check) 423 (recent-history-line-satisfies-p 424 (std:curry novelty-check str)))) 429 ;; (defmacro with-possible-redirection (filename append &body body) 430 ;; "If FILENAME is not NIL, try to create C file named FILENAME, 431 ;; temporarily reassign `*outstream*' to pointer to this file, perform BODY, 432 ;; then close the file and assign `*outstream*' the old value. If APPEND is not 433 ;; NIL, output will be appended to the file. Returns NIL on success and T on 435 ;; (std:with-gensyms (temp-outstream file-pointer body-fnc) 436 ;; `(flet ((,body-fnc () 439 ;; (let ((,temp-outstream *outstream*) 440 ;; (,file-pointer (foreign-funcall "fopen" 442 ;; :string (if ,append "a" "w") 444 ;; (if (null-alien ,file-pointer) 448 ;; (setf *outstream* ,file-pointer) 450 ;; (foreign-funcall "fclose" 451 ;; :pointer ,file-pointer 453 ;; (setf *outstream* ,temp-outstream))))