;;;;
;;;; repl-readline.stk	-- REPL with GNU-Readline support
;;;;
;;;; Copyright © 2010-2011 Erick Gallesio - Polytech'Nice-Sophia <eg@unice.fr>
;;;;
;;;;
;;;; 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)
;;;; Last file update:  4-Sep-2011 21:01 (eg)
;;;;


(define-module REPL-READLINE
  (import 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)))))

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

(provide "repl-readline")