#!/bin/sh
# @(#) Call readline(3c) from Fortran using ISO_C_BINDING
# assumes you have the GNU readline library libreadline.a available
################################################################################
#
# The C routine
#
cat > FCreadline.c <<\EOF
#include <stdlib.h>
#include <unistd.h>
#include <stdio.h>
#include <string.h>
#include <readline/readline.h>
#include <readline/history.h>
#
/* -------------------------------------------------------------------------- */
void show_history_list() {
  HISTORY_STATE *state =  history_get_history_state();
  int i;
  printf("History list now:\n");
  for (i=0; i < state->length; i++) {
    printf("%d: '%s'%s\n", i, state->entries[i]->line, (i == state->offset? "*":""));
  }     
} 
/* -------------------------------------------------------------------------- */
FCreadline(int *len, char *myline, char prompt[]){
/*
@(#)FCreadline.sh  return line from readline(3c) to Fortran. John S. Urban, 20100323

   Simple procedure that uses readline in "normal" (i.e. non-callback) mode. 

   len    -- number of characters in argument "myline"
   myline -- Fortran CHARACTER variable to recieve the line read by readline(3c) 
   prompt -- prompt string to preceed read

*/
   char *line;                            /* readline(3c) will return the read line to this pointer */
   int i;                                 /* counter for padding returned line with spaces */

   using_history();  
   line=readline(prompt);                 /* use readline(3c) to read a line of input in edit mode */
   add_history(line);

   if(strcmp(line,"h")==0){   /* if the "h" command is on a line by itself show history */
      show_history_list();
   }

   strncpy(myline,line,(int)len);         /* copy line returned by readline(3c) to MYLINE up to length of MYLINE */

   for(i=strlen(line);i<(int)len;i++){    /* starting with null, pad with spaces to end */
     myline[i]=' ';
   }

   /* free memory used to return line from readline(3c) */
   free(line);       
}
EOF

    
################################################################################
#
# Fortran module
#
cat > jsu_readline.f90 <<\EOF
!-------------------------------------------------------------------------------
MODULE jsu_readline
   USE ISO_C_BINDING
   IMPLICIT NONE
   PRIVATE
   PUBLIC iso_readline
!-------------------------------------------------------------------------------
! define the call to the C routine
! extern char     *Freadline(int ilen, char *buf, char prompt[]);
  PUBLIC ::  Freadline
   INTERFACE
      SUBROUTINE Freadline(ilen,buf,prompt) BIND(C,NAME='FCreadline')
         USE ISO_C_BINDING
         IMPLICIT NONE
         INTEGER(KIND=C_INT),INTENT(IN),VALUE      ::  ilen
         CHARACTER(KIND=C_CHAR),intent(out)  ::  buf(*)
         CHARACTER(KIND=C_CHAR),intent(in)   ::  prompt(*)
      END SUBROUTINE Freadline
   END INTERFACE
!-------------------------------------------------------------------------------
contains
! the routine that calls the C routine
SUBROUTINE iso_readline(line,prompt)
   USE ISO_C_BINDING
   IMPLICIT NONE
   CHARACTER(KIND=C_CHAR,LEN=*),INTENT(OUT) :: line
   CHARACTER(KIND=C_CHAR,LEN=*),INTENT(IN)  :: prompt

   ! trim to last non-blank character and append null for C
   CALL Freadline(LEN(line),line,prompt(:LEN_TRIM(prompt))//ACHAR(0))

 END SUBROUTINE iso_readline
!-------------------------------------------------------------------------------
END MODULE jsu_readline
!-------------------------------------------------------------------------------
EOF
################################################################################
cat > rl.f90 <<\EOF
! the test program
PROGRAM testit
   USE jsu_readline
   IMPLICIT NONE
   CHARACTER(LEN=256):: line

   WRITE(*,*)' ____________________________________________________________'
   WRITE(*,*)'  Your input lines are now edittable using the GNU'
   WRITE(*,*)'  readline(3C) procedure.  By default, up-arrow and'
   WRITE(*,*)'  down-arrow go thru the history lines; left and right arrow'
   WRITE(*,*)'  keys and delete and just typing characters let you do'
   WRITE(*,*)'  simple editting. Far more input control is available.'
   WRITE(*,*)'  See the browser pages and man(1) pages for readline(3c).'
   WRITE(*,*)' ____________________________________________________________'
   WRITE(*,*)' Enter text and then edit it. "q" quits; "h" display history:'

   DO
      CALL iso_readline(line,'readline>') ! read editable input line
      IF(line.EQ.'q') STOP
      !CALL system(line(:LEN_TRIM(line))) ! common extension
      !CALL execute_command_line(line(:LEN_TRIM(line))) ! f08 equivalent
   ENDDO

END PROGRAM testit
!-------------------------------------------------------------------------------
EOF
################################################################################
#
# compile, load, and go
#
set -x
rm -f rl FCreadline.o

cc -c FCreadline.c 
gfortran -c jsu_readline.f90  
ar rv libfrl.a FCreadline.o jsu_readline.o 
rm FCreadline.o jsu_readline.o 

gfortran rl.f90 -L . -I . -l frl -l readline -o rl 
./rl

################################################################################
exit
################################################################################