blob: 317642ef4eca9a1932a4538b7243d1442cf5e46f (
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
|
;;; Chickadee Game Toolkit
;;; Copyright © 2021 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;; http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.
;;; 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)))
|
