;;; 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)))