diff options
author | David Thompson <dthompson2@worcester.edu> | 2021-09-13 08:18:57 -0400 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2021-09-13 08:18:57 -0400 |
commit | f35eb7269743a0433a2bcf21acac6f6b956d34fe (patch) | |
tree | 7611a3d5098521462650674d5ecc4da5ab4ccb11 /chickadee | |
parent | 16df94c12ab85ed588c0f04a1655a87fa0e2d94f (diff) |
Add readline bindings.
Diffstat (limited to 'chickadee')
-rw-r--r-- | chickadee/config.scm.in | 2 | ||||
-rw-r--r-- | chickadee/readline.scm | 91 |
2 files changed, 93 insertions, 0 deletions
diff --git a/chickadee/config.scm.in b/chickadee/config.scm.in index d540231..81b0f3e 100644 --- a/chickadee/config.scm.in +++ b/chickadee/config.scm.in @@ -31,6 +31,7 @@ %libvorbisfile %libmpg123 %libfreetype + %libreadline scope-datadir)) ;; Try to link against multiple library possibilities, such as the @@ -55,6 +56,7 @@ (define %libvorbisfile '("@VORBIS_LIBDIR@/libvorbisfile" "libvorbisfile")) (define %libmpg123 '("@MPG123_LIBDIR@/libmpg123" "libmpg123")) (define %libfreetype '("@FREETYPE_LIBDIR@/libfreetype" "libfreetype")) +(define %libreadline '("@READLINE_LIBDIR@/libreadline" "libreadline")) (define (scope-datadir file) "Append the Chickadee data directory to FILE." diff --git a/chickadee/readline.scm b/chickadee/readline.scm new file mode 100644 index 0000000..ff370e8 --- /dev/null +++ b/chickadee/readline.scm @@ -0,0 +1,91 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2021 David Thompson <dthompson2@worcester.edu> +;;; +;;; Chickadee is free software: you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published +;;; by the Free Software Foundation, either version 3 of the License, +;;; or (at your option) any later version. +;;; +;;; Chickadee is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program. If not, see +;;; <http://www.gnu.org/licenses/>. + +;;; Commentary +;; +;; GNU readline bindings for use with the Chickadee REPL. The +;; guile-readline C extension is not compatible with the alternative, +;; callback-based readline interface so here comes the FFI to the +;; rescue. +;; +;;; Code: + +(define-module (chickadee readline) + #:use-module (chickadee config) + #:use-module (system foreign) + #:export (bind-readline-variable + install-readline-handler + remove-readline-handler + readline-read-char + add-readline-history)) + +;;; +;;; Setup +;;; + +(define libreadline (dynamic-link* %libreadline)) + +(define (readline-func return-type function-name arg-types) + (pointer->procedure return-type + (dynamic-func function-name libreadline) + arg-types)) + +(define-syntax-rule (define-foreign name return-type func-name arg-types) + (define name + (readline-func return-type func-name arg-types))) + +;;; +;;; Variables +;;; + +(define-foreign rl-variable-bind void "rl_variable_bind" '(* *)) + +(define (bind-readline-variable name value) + (rl-variable-bind (string->pointer name) (string->pointer value))) + +;;; +;;; Callbacks +;;; + +(define-foreign rl-callback-handler-install void "rl_callback_handler_install" '(* *)) +(define-foreign rl-callback-handler-remove void "rl_callback_handler_remove" '()) +(define-foreign rl-callback-read-char void "rl_callback_read_char" '()) +(define-foreign rl-callback-sigcleanup void "rl_callback_sigcleanup" '()) + +(define (install-readline-handler prompt proc) + (let ((proc-ptr (procedure->pointer void + (lambda (ptr) + (proc (if (null-pointer? ptr) + "" + (pointer->string ptr)))) + '(*)))) + (rl-callback-handler-install (string->pointer prompt) proc-ptr))) + +(define (remove-readline-handler) + (rl-callback-handler-remove)) + +(define (readline-read-char) + (rl-callback-read-char)) + +;;; +;;; History +;;; + +(define-foreign add-history void "add_history" '(*)) + +(define (add-readline-history line) + (add-history (string->pointer line))) |