blob: ff370e82f487582f84526ae9be9220c4fab31b2e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
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)))
|
