;;; Add-in module to support using GNU readline from Chicken.
;
; (Readline is GPLed, so that makes this file GPLed too, because this
; file will only run if it's linked against readline.)
;
; Copyright (c) 2002 Tony Garnock-Jones
;
; 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

;---------------------------------------------------------------------------
; csc -s readline.scm -L -lreadline -L -ltermcap
;
; To get csi to support line editing, install this library and put the
; following lines in your ~/.csirc:
;
;   (require 'readline)
;   (current-input-port (make-gnu-readline-port "csi> "))
;
; If you also want to make the command history span sessions, add the
; following:
;
;   (gnu-history-install-file-manager (string-append (or (getenv "HOME") ".") "/.csi.history"))
;
; By default this will save 1000 lines of history between sessions (it
; will prune the history file to 1000 lines at startup). For a
; different history size, pass the desired number of lines as the
; (optional) second argument to gnu-history-install-file-manager. If
; #f is passed in, no history-file-pruning will take place.
;
; Completion will have to wait until we get protocol for iterating
; over the symbol table, or similar.

(declare
 (usual-integrations)

 (export

  gnu-readline
  make-gnu-readline-port

  gnu-readline-clear-history
  gnu-readline-read-history
  gnu-readline-write-history
  gnu-readline-truncate-history
  gnu-history-install-file-manager
 )

 (foreign-declare #<<EOF

#include <stdio.h>
#include <readline/readline.h>
#include <readline/history.h>

static char *readline_buf = NULL;

EOF
))

; Initialise the history library.
((foreign-lambda void "using_history"))

(define gnu-readline
  (foreign-lambda* c-string ((c-string prompt))
		   "if (readline_buf != NULL) {"
		   "  free(readline_buf);"
		   "  readline_buf = NULL;"
		   "}"
		   "readline_buf = readline(prompt);"
		   "if (readline_buf != NULL) {"
		   "  add_history(readline_buf);"
		   "}"
		   "return(readline_buf);"))

(define gnu-readline-clear-history
  (foreign-lambda void "clear_history"))

;;; (gnu-readline-read-history <filename-or-false>) -> 0 for success, errno for failure
(define gnu-readline-read-history
  (foreign-lambda int "read_history" c-string))

;;; (gnu-readline-write-history <filename-or-false>) -> 0 for success, errno for failure
(define gnu-readline-write-history
  (foreign-lambda int "write_history" c-string))

;;; (gnu-readline-truncate-history <filename-or-false> <numlines>) -> 0 succ, errno fail
(define gnu-readline-truncate-history
  (foreign-lambda int "history_truncate_file" c-string int))

(define (gnu-history-install-file-manager filename . nlines)
  (define (hook param)
    (param (let ((next (param)))
	     (lambda args
	       (gnu-readline-write-history filename)
	       (apply next args)))))
  (if (pair? nlines)
      (set! nlines (car nlines))
      (set! nlines 1000))
  (if nlines
      (gnu-readline-truncate-history filename nlines))
  (gnu-readline-read-history filename)
  (hook exit-handler)
  (hook implicit-exit-handler))

(define (make-gnu-readline-port prompt)
  (let ((buffer "")
	(pos 0))
    (letrec ((char-ready? (lambda ()
			    (< pos (string-length buffer))))
	     (get-next-char! (lambda ()
			       (cond
				((not buffer) (end-of-file))
				((char-ready?)
				 (let ((ch (string-ref buffer pos)))
				   (set! pos (+ pos 1))
				   ch))
				(else
				 (set! pos 0)
				 (set! buffer (gnu-readline prompt))
				 (if (string? buffer)
				     (set! buffer (string-append buffer "\n")))
				 (get-next-char!))))))
      (let ((p (make-input-port get-next-char!
				char-ready?
				(lambda () 'closed-gnu-readline-port))))
	(set-port-name! p "(gnu-readline)")
	p))))