;;;;
;;;; repl-readline.stk  -- REPL with GNU-Readline support
;;;;
;;;; Copyright © 2010-2024 Erick Gallesio <eg@stklos.net>
;;;;
;;;;
;;;; This program 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 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program 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, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date: 15-May-2010 22:00 (eg)
;;;;


(define-module REPL-READLINE
  (import SCHEME REPL READLINE)
  (export try-initialize-repl-with-readline)

;;;; In module REPL-READLINE

(define (repl-readline-integration)
  (let ((old-make-prompt (repl-make-prompt))
        (history-file    (%stklos-conf-file "history"))
        (rl-support      (key-get *%system-state-plist* :readline #f)))

    ;;
    ;; Change the prompt mechanic:
    ;;  - the prompt is built with escape sequences between special delimiters
    ;;    which are specially treated by read line (\001 and \002)
    ;;  - the prompt is no more displayed (readline will display it)
    ;;  - For now, don't use colorfull prompts if readline support is offered
    ;;    by libedit readline compatibility
    ;;
    (if (eq? rl-support 'libedit)
        ;;  Don't use color prompt (and use normal prompt function)
        (repl-prompt-use-color? #f)
        ;; We use the readl GNU readline. Good
        (repl-make-prompt (lambda (module)
                            (ansi-color-protect "\001" "\002")
                            (old-make-prompt module)
                            (ansi-color-protect "" ""))))

    (repl-display-prompt (lambda (port) 'nothing))

    ;;
    ;; History management
    ;;
    (read-history history-file)
    (register-exit-function! (lambda (_)
                               (write-history history-file)))

    ;;
    ;; Build a virtual port for the input port of the REPL
    ;;
    (let* ((buff       #())
           (buff-index -1)
           (fill-buff  (lambda ()
                         ;; No more char. to read. Fill the buffer with readline
                         (let ((line (read-with-history (repl-prompt))))
                           (set! buff (if (eof-object? line)
                                          line
                                          (%string->bytes line)))
                           (set! buff-index 0)
                           (set! (repl-prompt) ""))))
           (port       (open-input-virtual
                        :read-char
                        (lambda (port)
                          (let Loop ()
                            (cond
                             ((eof-object? buff)
                              (set! buff       #())
                              (set! buff-index -1)
                              #eof)
                             ((= buff-index (vector-length buff))
                              ;; last character read. return a newline char
                              (set! buff-index (+ buff-index 1))
                              #\newline)
                             ((or (negative? buff-index)
                                  (> buff-index (vector-length buff)))
                              (fill-buff)
                              (Loop))
                             (else
                              (let ((c (vector-ref buff buff-index)))
                                (set! buff-index (+ buff-index 1))
                                (integer->char c))))))
                        :eof?
                        (lambda (port)
                          (if (eof-object? buff)
                              (begin (fill-buff) #eof)
                              #f)))))
      (unless (%port-case-sensitive (current-input-port))
        ;; current-input-port in insensitive. Make the virtual port too.
        (%port-case-sensitive-set! port #f))

      (current-input-port port)
      (repl-change-default-ports :in port))))

(define (try-initialize-repl-with-readline)
  (let ((use-editor (key-get *%system-state-plist* :line-editor #t)))
    (when (and use-editor (try-initialize-readline))
      (main-repl-hook repl-readline-integration))))

;; End of module REPL-READLINE
)
