Fortran input history editor

DESCRIPTION

the JUCMD(3f) routine lets you list, save, and modify your interactively entered program input.

The JUCMD(3f) input history editor is simple to use, portable, reusable and reliably (it has been used for decades). A line editor model is used; which means no special escape characters or control characters are required. In addition, there is built-in help.

Typically, only a few minutes are required to master usage; especially for those familiar with a line editor.

JUCMD(3f) is modeled on the MODIFY and CHANGE commands in the CDC NOS line editor XEDIT; and the related NOS command REDO.

Sample run of example program

In this example (using the sample program at the end of this document), we will execute the command

 echo This isss a Test

and use a few of the features to change it to

 echo This is a new TEST

and then execute the edited command.

sh-3.2$ ./redo
--------------------------------------------------
 TEST OF JUCMD(3f) COMMAND INPUT EDITOR

 Enter a few commands to be passed to the shell
 and then enter "r" or "r r_command" on the input
 line to go into history edit mode.
 once in history edit mode you may enter
 "?" to get some help.
 Enter the command "quit" to exit
--------------------------------------------------
>echo This isss a Test
This isss a Test
>date
Sun May 31 23:54:09 EDT 2009
>pwd
/cygdrive/c/urbanjs/MYCYGWIN/DISKA/public_html/public/CLONE/JUCMD
>r
00001 echo This isss a Test
00002 date
00003 pwd
!pwd
>1
!echo This isss a Test
             ##   t
!echo This is a test
                ^new #
!echo This is a new test
c/test/TEST/
!echo This is a new TEST

This is a new TEST
>quit

Compilation

Compilation of the test program and module varies depending on your programming environment, but here is an example that builds the test program using gfortran(1):

   gfortran -DTESTPRG90 -J. -static M_history.f90 redo.F90

Source and Related Files

A simple man(1)-page for jucmd(3f) should be added to your environment if you install the module.

!=================================================================================================================================== module M_history private ! SUBROUTINES: public :: jucmd ! copy a line into history file or edit history if command is "r" and return line private :: open_history ! open history file private :: redol ! edit history private :: notabs ! remove tabs and trailing carriage returns and line feeds from lines private :: modif ! process modify command to edit a history line private :: change ! process change command to edit a history line private :: pln ! write message to screen with optional integer or real value private :: juar ! convert numeric string to numeric value ! FUNCTIONS: private :: string_to_integer ! convert string representing an integer to an integer value ! should use unused file, not just unit 71 for history ! add option to read in and replace history file contains !=================================================================================================================================== subroutine jucmd(l) ! if line starts with r word call redol() ! uses unit 71 ! r ! r string ! character(len=*),intent(inout) :: l ! user string integer,save :: iobuf=71 ! unit number to use for redo history buffer integer,save :: iredo ! number of lines read from standard input into redo file logical,save :: lcalled=.false. ! flag whether first time this routine called or not integer,parameter :: READLEN=256 !----------------------------------------------------------------------------------------------------------------------------------- ! open history file and initialize if(.not.lcalled)then ! open the redo buffer file lcalled=.true. iredo=0 ! number of lines in redo buffer call open_history(iobuf,' ','scratch',READLEN,ioparc) ! redo buffer if(ioparc.ne.0)then call pln('error creating history file') return endif endif !----------------------------------------------------------------------------------------------------------------------------------- ilast=len_trim(l) if(ilast.eq.1.and.l(1:1).eq.'r')then ! redo command call redol(l,iobuf,iredo,READLEN,' ') ilast=len_trim(l) elseif(l(1:2).eq.'r ')then ! redo command with a string following call redol(l,iobuf,iredo,READLEN,l(3:max(3,ilast))) ilast=len_trim(l) endif if(ilast.ne.0)then ! put command into redo buffer iredo=iredo+1 write(iobuf,rec=iredo)l endif end subroutine jucmd !=================================================================================================================================== subroutine open_history(iunit,fname,sname,irecl,ierr) !@(#) open binary direct access file character(len=*),intent(in) :: fname character(len=*),intent(in) :: sname ilens=len_trim(sname) !----------------------------------------------------------------------- if(sname.eq.'scratch')then open(unit=iunit,status='scratch',form='unformatted',access='direct',recl=irecl,iostat=ierr) else open(unit=iunit,file=fname(:len_trim(fname)),status=sname(:ilens),form='unformatted',access='direct',recl=irecl,iostat=ierr) endif if(ierr.ne.0)then call pln('*open_history* open error ',int=ierr) endif end subroutine open_history !=================================================================================================================================== subroutine redol(redoline,iobuf,iredo,ibuf0,init) !@(#) redo a previous input line ! redoline ... (o) edited command line to be returned ! iobuf ...... (i) history file unit to read old commands from ! iredo ...... (i) number of lines in history file ! ibuf0 ...... (i) the width of the history file in characters; <= len(redoline) ! init ....... (i) initial command string ! ! to do: ! might want to support a count on change to do the N to the Mth occurrence ! support edit window in change ! prompt to verify each change made with change() ! maybe make .NAME stick into variable $NAME in the calculator ! allow changing the edit characters in a modify character(len=*) :: redoline character(len=*) :: init character(len=256) :: cin, cinbuf ! 1 greater than length of redoline character(len=256) :: numbers save numbers !-----------------------------------------------------------------------======== data numbers/'123456789012345678901234567890123456789012345678901234567890& &12345678901234567890123456789012345678901234567890123456789012345678901234& &56789012345678901234567890123456789012345678901234567890123456789012345678& &901234567890123456789012345678901234567890123456'/ !-----------------------------------------------------------------------======== ipoint=iredo ! initial line in history file to start with icall=0 ! flag if have been thru loop or just got here cin=init ! initialize the directive ibuf=min(ibuf0,len(redoline)) if(ibuf.le.0)return !-----------------------------------------------------------------------======== 1 continue if(ipoint.le.0)then ! if no lines in redo history file redoline=' ' ! make command to 'redo' a blank line since no commands entered else read(iobuf,rec=ipoint,err=999)redoline(1:ibuf) ! get last line in history file as line to redo ! WARNING: OSF1 DIGITAL Fortran 77 Driver V5.2-10 DIGITAL Fortran 77 V5.2-171-428BH ! after this read the following storage was corrupted; switched declaration of ! init and redoline and problem cleared but it is probably corrupting cin and ! doesn't show because of logic. endif !-----------------------------------------------------------------------======== READLINE: do ! display buffer and decide on command on first call or read command ilen=max(1,len_trim(redoline(1:ibuf))) ! find length of command to redo write(*,'(a,a)')'!',redoline(:ilen) ! show old command if(icall.ne.0)then ! if not first call read the directive read(5,'(a)',iostat=ios)cinbuf if(ios.ne.0)then ! if there was an I/O error reread line cycle endif call notabs(cinbuf,cin,ilast) elseif(cin.eq.' ')then ! first call and no initial command passed in cin='l -5' ! on first call do this default command if init is blank ilast=4 else ! if initial command was not blank do it instead of default ilast=len_trim(cin) endif icall=icall+1 !-----------------------------------------------------------------------======== if(ilast.eq.0)then ! blank command line; return and execute return endif !-----------------------------------------------------------------------======== select case(cin(1:1)) ! first character defines edit action !-----------------------------------------------------------------------======== case(' ') ! modify the string call modif(redoline,cin(2:)) !-----------------------------------------------------------------------======== case('m') ! modify the string with line number header write(*,'(1x,a)',iostat=ios)numbers(:len_trim(redoline)) call modif(redoline,cin(2:)) !-----------------------------------------------------------------------======== case('c','s') ! change old string to new call change(redoline,cin(1:255),ier,1,ibuf) ! xedit-like change command ! C/STRING1/STRING2/ OR CW/STRING1/STRING2/ (CHANGE IN WINDOW) ! WHERE / MAY BE ANY CHARACTER OTHER THAN W OR BLANK, WHICH IS NOT ! INCLUDED IN STRING1 OR STRING2 !-----------------------------------------------------------------------======== case('u','b') ! up or back through buffer if(cin(2:).eq.' ')then iup=1 else iup=string_to_integer(cin(2:)) endif ipoint=max(ipoint-iup,1) goto 1 !-----------------------------------------------------------------------======== case('d','f') ! down or forward through buffer if(cin(2:).eq.' ')then idown=1 else idown=string_to_integer(cin(2:)) endif ipoint=min(ipoint+idown,iredo) goto 1 !-----------------------------------------------------------------------======== case('?','h') ! display help !123456789 123456789 123456789 123456789 123456789 123456789 123456789 123456789 call pln('#-----------------------------------------------------------------------------#') call pln('|REDO MODE OPTIONS (where N is a number): |') call pln('|-----------------------------------------------------------------------------|') call pln('|LIST HISTORY(and set buffer to last printed line): |') call pln('| l|p N # list from line N. -N shows N last lines |') call pln('| L|P N # same as l without line numbers |') call pln('| /string # search for simple string |') call pln('| w|D file # write entire history to a file |') call pln('|-----------------------------------------------------------------------------|') call pln('|SET BUFFER TO A LINE: |') call pln('| u|b N # up/back through buffer |') call pln('| d|f N # down/forward through buffer |') call pln('| N # load line number |') call pln('|-----------------------------------------------------------------------------|') call pln('|EDIT BUFFER: |') call pln('| c|s/oldstring/newstring/ # change/substitute |') call pln('| mmod_string # Modify with line number header |') call pln('| mod_string # Modify (replace, delete, insert) |') call pln('| # -- deletes |') call pln('| & -- replaces with a blank |') call pln('| ^STRING# -- inserts a string |') call pln('| -- blank leaves as-is |') call pln('| Any other -- replaces character |') call pln('|-----------------------------------------------------------------------------|') call pln('|RETURN TO NORMAL COMMAND MODE: |') call pln('| # return and execute command in buffer |') call pln('| .|q # quit and return a blank line |') call pln('|-----------------------------------------------------------------------------|') call pln('|HELP: |') call pln('| h|? # display this help text |') call pln('#-----------------------------------------------------------------------------#') !-----------------------------------------------------------------------======== case('l','p') ! display history buffer file with line numbers if(cin(2:).eq.' ')then istart=iredo-30 ! default is to go back up to 30 else istart=string_to_integer(cin(2:)) if(istart.lt.0)then istart=iredo+1+istart endif endif istart=min(max(1,istart),iredo) ! make istart a safe value do i10=istart,iredo read(iobuf,rec=i10,iostat=ios)redoline(1:ibuf) if(ios.ne.0)then exit endif ix=max(1,len_trim(redoline)) write(*,'(i5.5,1x,a)',iostat=ios)i10,redoline(:ix) if(ios.ne.0)then exit endif enddo !-----------------------------------------------------------------------======== case('w','D') ! dump to a file idump=90 if(cin(2:).eq.' ')then open(unit=idump,file='DUMP',iostat=ios,status='UNKNOWN') if(ios.ne.0)then call pln('*redol* error opening dump file') exit endif else ! messy way to eliminate leading spaces cin=cin(2:) ie=len_trim(cin) do i151=1,ie if(cin(1:1).eq.' ') cin(1:)=cin(2:) enddo if(cin.eq.' ')cin='DUMP' ie=len_trim(cin) open(unit=idump,file=cin(:ie),iostat=ios,status='UNKNOWN') if(ios.ne.0)then call pln('*redol* error opening dump file') exit endif endif do i15=1,iredo read(iobuf,rec=i15,iostat=ios)redoline(1:ibuf) if(ios.ne.0)then call pln('*redol* error reading history file') exit endif ix=max(1,len_trim(redoline)) write(idump,'(a)',iostat=ios)redoline(:ix) if(ios.ne.0)then call pln('*redol* error writing dump file') close(idump,iostat=ios) exit endif enddo close(idump) !-----------------------------------------------------------------------======== case('P','L') ! display history buffer file without line numbers if(cin(2:).eq.' ')then ! default is to go back up to 30 istart=iredo-30 else istart=string_to_integer(cin(2:)) if(istart.lt.0)then istart=iredo+1+istart endif endif istart=min(max(1,istart),iredo) ! make istart a safe value do i30=istart,iredo ! easier to cut and paste if no numbers read(iobuf,rec=i30,iostat=ios)redoline(1:ibuf) if(ios.ne.0)then goto 999 endif ix=max(1,len_trim(redoline)) write(*,'(a)',err=999)redoline(:ix) enddo !-----------------------------------------------------------------------======== case('/') ! display matches in buffer if(ilast.lt.2)then cycle endif do i20=1,iredo read(iobuf,rec=i20,err=999,iostat=ios)redoline(1:ibuf) if(index(redoline(1:ibuf),cin(2:ilast)).ne.0)then ix=max(1,len_trim(redoline)) write(*,'(i5.5,1x,a)',err=999)i20,redoline(:ix) ipoint=i20 endif enddo goto 1 !-----------------------------------------------------------------------======== case('!') ! external command if(ilast.lt.2)then cycle endif !call execute_command_line(trim(cin(2:))) ! Execute the command line specified by the string. call system(trim(cin(2:))) ! Execute the command line specified by the string. !-----------------------------------------------------------------------======== case('.','q') ! blank out command and quit exit !-----------------------------------------------------------------------======== case default ! assume anything else is a number iread=string_to_integer(cin) if(iread.gt.0.and.iread.le.iredo)then read(iobuf,rec=iread,err=999,iostat=ios)redoline(1:ibuf) ipoint=iread endif !-----------------------------------------------------------------------======== end select !-----------------------------------------------------------------------======== enddo READLINE !-----------------------------------------------------------------------======== 999 continue redoline=' ' !-----------------------------------------------------------------------======== end subroutine redol !-----------------------------------------------------------------------======== !=================================================================================================================================== subroutine notabs(INSTR,OUTSTR,ILEN) ! @(#) convert tabs in input to spaces in output while maintaining columns, assuming a tab is set every 8 characters ! given input string INSTR ! return output string OUTSTR ! o with tabs expanded assuming tabs are set every 8 characters ! o carriage return and line feed characters are replaced with a space ! o ILEN holds the position of the last non-blank character in OUTSTR ! ! ! USES: ! It is often useful to expand tabs in input files to simplify further processing such as tokenizing an input line. ! Some FORTRAN compilers hate tabs in input files; some printers; some editors will have problems with tabs. ! AUTHOR: ! John S. Urban ! ! SEE ALSO: ! GNU/Unix commands expand(1) and unexpand(1) ! IMPLICIT NONE CHARACTER(LEN=*),INTENT(IN) :: instr ! input line to scan for tab characters CHARACTER(LEN=*),INTENT(OUT) :: outstr ! tab-expanded version of INSTR produced INTEGER,INTENT(OUT) :: ilen ! column position of last character put into output string INTEGER,PARAMETER :: tabsize=8 ! assume a tab stop is set every 8th column INTEGER :: ipos ! position in OUTSTR to put next character of INSTR INTEGER :: lenin ! length of input string trimmed of trailing spaces INTEGER :: lenout ! number of characters output string can hold INTEGER :: istep ! counter that advances thru input string INSTR one character at a time CHARACTER(LEN=1) :: c ! character in input line being processed INTEGER :: iade ! ADE (ASCII Decimal Equivalent) of character being tested !----------------------------------------------------------------------------------------------------------------------------------- IPOS=1 ! where to put next character in output string OUTSTR lenin=LEN(instr) ! length of character variable INSTR lenin=LEN_TRIM(instr(1:lenin)) ! length of INSTR trimmed of trailing spaces lenout=LEN(outstr) ! number of characters output string OUTSTR can hold OUTSTR=" " ! this SHOULD blank-fill string, a buggy machine required a loop to set all characters !----------------------------------------------------------------------------------------------------------------------------------- SCAN_LINE: DO istep=1,lenin ! look through input string one character at a time c=instr(istep:istep) ! get next character iade=ICHAR(c) ! get ADE of the character expand_tabs : SELECT CASE (iade) ! take different actions depending on which character was found CASE(9) ! test if character is a tab and move pointer out to appropriate column ipos = ipos + (tabsize - (MOD(ipos-1,tabsize))) CASE(10,13) ! convert carriage-return and new-line to space ,typically to handle DOS-format files ipos=ipos+1 CASE DEFAULT ! c is anything else other than a tab,newline,or return insert it in output string IF(ipos > lenout)THEN CALL pln("*notabs* output string overflow") EXIT ELSE outstr(ipos:ipos)=c ipos=ipos+1 ENDIF END SELECT expand_tabs enddo SCAN_LINE !----------------------------------------------------------------------------------------------------------------------------------- ipos=MIN(ipos,lenout) ! tabs or newline or return characters or last character might have gone too far ilen=LEN_TRIM(outstr(:ipos)) ! trim trailing spaces !----------------------------------------------------------------------------------------------------------------------------------- END SUBROUTINE notabs !=================================================================================================================================== SUBROUTINE MODIF(CDUM,CMOD) !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC !@(#) EMULATE THE XEDIT MODIFY EDITOR COMMAND ! ! MODIFY [M] ! ====== ! ACTION- MODIFIES THE LINE CURRENTLY POINTED AT. THE MODIFY DIRECTIVES ! ARE AS FOLLOWS- ! ! DIRECTIVE EXPLANATION ! --------- ------------ ! ^STRING# CAUSES THE STRING OF CHARACTERS BETWEEN THE ^ AND THE ! NEXT # TO BE INSERTED BEFORE THE CHARACTERS POINTED TO ! BY THE ^. AN ^ OR & WITHIN THE STRING IS TREATED AS A ! REGULAR CHARACTER. IF THE CLOSING # IS NOT SPECIFIED, ! XEDIT INSERTS THE REMAINDER OF THE LINE AS IF A # WAS ! SPECIFIED AFTER THE LAST NONBLANK CHARACTER. ! ! THERE ARE TWO EXCEPTIONS. THE COMBINATION ^# CAUSES A # ! TO BE INSERTED BEFORE THE CHARACTER POINTED TO BY THE ! ^, AND AN ^ AS THE LAST CHARACTER OF THE DIRECTIVES ! CAUSES A BLANK TO BE INSERTED. ! ! # (WHEN NOT THE FIRST # AFTER AN ^) CAUSES THE CHARACTER ! ABOVE IT TO BE DELETED. ! ! & REPLACES THE CHARACTER ABOVE IT WITH A SPACE. ! ! (SPACE) A SPACE BELOW A CHARACTER LEAVES IT UNCHANGED. ! ! ANY OTHER CHARACTER REPLACES THE CHARACTER ABOVE IT. ! ! EXAMPLE- ! THE INPUT LINE........ 10 THIS STRING TO BE MORTIFD ! THE DIRECTIVES LINE... ^ IS THE# D# ^IE ! ALTERED INPUT LINE.... 10 THIS IS THE STRING TO BE MODIFIED !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CHARACTER*(*) CDUM,CMOD !STRING TO BE MODIFIED .LE. 160 CHARACTER(LEN=3) :: C PARAMETER (MAXSCRA=255) !LENGTH OF SCRATCH BUFFER CHARACTER*(MAXSCRA) DUM2 !SCRATCH CHARACTER BUFFER LOGICAL LINSRT !FLAG FOR INSERTING DATA ON LINE SAVE C DATA C/'#&^'/ !ASSIGN DEFAULT EDIT CHARACTERS LMAX=MIN0(LEN(CDUM),MAXSCRA) !DETERMINE MAXIMUM LINE LENGTH LMX1=LMAX-1 !MAX LINE LENGTH -1 DUM2=' ' !INITIALIZE NEW LINE LINSRT=.FALSE. !INITIALIZE INSERT MODE IEND=len_trim(CMOD) !DETERMINE END OF MODS I=0 !CHAR COUNTER FOR MOD LINE CMOD IC=0 !CHAR COUNTER FOR CURRENT LINE CDUM ICHAR=0 !CHAR COUNTER NEW LINE DUM2 11 CONTINUE I=I+1 !NEXT CHAR IN MOD LINE IF(ICHAR.GT.LMX1)GOTO 999 !IF TOO MANY CHARS IN NEW LINE IF(LINSRT) THEN !IF INSERTING NEW CHARS IF(I.GT.IEND) CMOD(I:I)=C(1:1) !FORCE END OF INSERT MODE IF(CMOD(I:I).EQ.C(1:1))THEN !IF END OF INSERT MODE LINSRT=.FALSE. !RESET INSERT MODE FLAG IF(IC+1.EQ.I)THEN !NULL INSERT STRING ICHAR=ICHAR+1 !INCREMENT COUNTER FOR NEW LINE DUM2(ICHAR:ICHAR)=C(1:1) !INSERT INSERT MODE TERMINATOR ENDIF DO J=IC,I !LOOP OF NUMBER OF CHARS INSERTED ICHAR=ICHAR+1 !INCREMENT COUNTER FOR NEW LINE IF(ICHAR.GT.LMAX)GOTO 999 !IF AT BUFFER LIMIT, QUIT DUM2(ICHAR:ICHAR)=CDUM(J:J) !APPEND CHARS FROM ORIG LINE ENDDO !...WHICH ALIGN WITH INSERTED CHARS IC=I !RESET CHAR COUNT TO END OF INSERT GOTO 1 !CHECK NEW LINE LENGTH AND CYCLE ENDIF !END OF TERMINATED INSERT LOGIC ICHAR=ICHAR+1 !INCREMENT NEW LINE COUNT DUM2(ICHAR:ICHAR)=CMOD(I:I) !SET NEWLINE CHAR TO INSERTED CHAR ELSE !IF NOT INSERTING CHARACTERS IC=IC+1 !INCREMENT ORIGINAL LINE COUNTER IF(CMOD(I:I).EQ.C(1:1))GOTO 1 !IF DELETE CHAR. NO COPY AND CYCLE IF(CMOD(I:I).EQ.C(3:3))THEN !IF BEGIN INSERT MODE LINSRT=.TRUE. !SET INSERT FLAG TRUE GOTO 1 !CHECK LINE LENGTH AND CONTINUE ENDIF !IF NOT BEGINNING INSERT MODE ICHAR=ICHAR+1 !INCREMENT NEW LINE COUNTER IF(CMOD(I:I).EQ.C(2:2))THEN !IF REPLACE WITH BLANK DUM2(ICHAR:ICHAR)=' ' !SET NEWLINE CHAR TO BLANK GOTO 1 !CHECK LINE LENGTH AND CYCLE ENDIF !IF NOT REPLACE WITH BLANK IF(CMOD(I:I).EQ.' ')THEN !IF BLANK, KEEP ORIGINAL CHARACTER DUM2(ICHAR:ICHAR)=CDUM(IC:IC) !SET NEW CHAR TO ORIGINAL CHAR ELSE !IF NOT KEEPING OLD CHAR DUM2(ICHAR:ICHAR)=CMOD(I:I) !REPLACE ORIGINAL CHAR WITH NEW ENDIF !END CHAR KEEP OR REPLACE ENDIF !END INSERT OR NO-INSERT 1 CONTINUE IF(I.LT.LMAX)GOTO 11 !CHECK FOR END OF LINE REACHED !AND CYCLE IF OK 999 CONTINUE CDUM=DUM2 !SET ORIGINAL CHARS TO NEW CHARS END SUBROUTINE MODIF !=================================================================================================================================== SUBROUTINE CHANGE(CDUM,CSTRNG,IER,ML,MR) ! CHANGE A CHARACTER STRING !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC !@(#) CHANGE A CHARACTER STRING LIKE XEDIT CHANGE OR C COMMAND ! CDUM CONTAINS LINE TO BE CHANGED ! CSTRNG CONTAINS THE COMMAND CHANGING THE STRING(LESS THE COUNT PARAM) ! IER RETURNS AN ERROR CODE. IF IER = -1 BAD DIRECTIVE ! = 0 NO CHANGES MADE ! > 0 THEN IER CHANGES MADE ! ML SETS THE LEFT MARGIN ! MR SETS THE RIGHT MARGIN ! ! THIS ROUTINE DOES NOT ALLOW FOR SEPARATORS ON THE CHANGE COMMAND ! (...) OR .NOT.CONTAINING (---). ! ! THE COMMAND MUST BE OF THE FORM: ! C/STRING1/STRING2/ OR CW/STRING1/STRING2/ (CHANGE IN WINDOW) ! WHERE / MAY BE ANY CHARACTER OTHER THAN W OR BLANK, WHICH IS NOT ! INCLUDED IN STRING1 OR STRING2 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CHARACTER*(*) CDUM,CSTRNG ! USE STRING LENGTH PARAMETER (MAXSCR=255) ! MAXIMUM SCRATCH LENGTH CHARACTER*(MAXSCR) STR1,STR2,DUM1 ! SCRATCH STRING BUFFERS LMAX=MIN0(LEN(CDUM),MAXSCR) ! MAX LENGTH OF NEW STRING LCDUM=len_trim(CDUM) ! GET NON-BLANK LENGTH OF LINE ! CRACK THE DIRECTIVES LINE STR1=' ' ! INITIALIZE STRINGS STR2=' ' ! INITIALIZE STRINGS LDIR=len_trim(CSTRNG) ! FIND LAST CHARACTER IN DIRECTIVE ID=2 IF(CSTRNG(2:2).EQ.'W')ID=3 ! CHECK FOR WINDOW OPTION ID1=ID+1 ! DELIMITER CHARACTER + 1 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IF(LDIR.LT.3+ID)THEN ! IF BAD DIRECTIVE call pln('*change* bad directive') goto 999 ENDIF IF(CSTRNG(ID:ID).NE.CSTRNG(LDIR:LDIR))THEN ! IF BAD DELIM ADD ONE IF THERE IS ROOM IF(LDIR.LT.LEN(CSTRNG))THEN ! CHECK IF THERE IS ROOM LDIR=LDIR+1 CSTRNG(LDIR:LDIR)=CSTRNG(ID:ID) ! MAKE LAST CHARACTER A DELIMITER ELSE ! NO ROOM TO ADD DELIMITER call pln('*change* unmatched delimiters') goto 999 ENDIF ENDIF IDEL=INDEX(CSTRNG(ID1:LDIR-1),CSTRNG(ID:ID)) ! FIND MID DELIM IF(IDEL.EQ.0)THEN ! IF NO MID DELIM call pln('*change* missing middle delimiter') goto 999 ENDIF IF(IDEL.GT.1)STR1=CSTRNG(ID1:IDEL+ID-1) ! STRING TO BE CHANGED LS1=IDEL-1 ! STRING OF STRING TBC IF(IDEL+ID.LT.LDIR-1)STR2=CSTRNG(IDEL+ID1:LDIR-1) ! NEW STRING LS2=LDIR-IDEL-ID1 ! LENGTH OF NEW STRING IF(LS2.GT.0)THEN IF(INDEX(STR2(:LS2),CSTRNG(ID:ID)).NE.0)THEN ! EXTRA DELIMITER call pln('*change* extra delimiter') goto 999 ENDIF ENDIF !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC ! DIRECTIVES HAVE BEEN CRACKED, NOW IMPLEMENT IF(ID.EQ.2)THEN ! NO WINDOW IL=1 ! IL TO LEFT MARGIN IR=LMAX ! IR TO RIGHT MOST ALLOWED ELSE ! IF WINDOW IS SET IL=ML ! USE LEFT MARGIN IR=MIN0(MR,LMAX) ! USE RIGHT MARGIN OR RIGHT MOST ENDIF ! END OF WINDOW SETTINGS !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IF(IL.EQ.1)THEN ! IF LEFT MARGIN IS 1 DUM1=' ' ! BEGIN WITH A BLANK LINE ELSE ! IF LEFT MARGIN NOT 1 DUM1=CDUM(:IL-1) ! BEGIN WITH WHAT'S BELOW MARGIN ENDIF !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IF(LS1.EQ.0)THEN ! c//str2/ means insert str2 at beginning of line (or left margin) ICHAR=LS2 + LCDUM IF(ICHAR.GT.LMAX)GOTO 1002 IF(LS2.GT.0)THEN DUM1(IL:)=STR2(:LS2)//CDUM(IL:LCDUM) ELSE DUM1(IL:)=CDUM(IL:LCDUM) ENDIF CDUM(1:LMAX)=DUM1(:LMAX) IER=1 ! Made one change. Actually, c/// should maybe return 0 RETURN ENDIF !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IER=0 ICHAR=IL IC=IL !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC DO IND=INDEX(CDUM(IC:),STR1(:LS1))+IC-1 IF(IND.EQ.IC-1.OR.IND.GT.IR)THEN EXIT ENDIF IER=IER+1 IF(IND.GT.IC)THEN LADD=IND-IC IF(ICHAR-1+LADD.GT.LMAX)GOTO 1002 DUM1(ICHAR:)=CDUM(IC:IND-1) ICHAR=ICHAR+LADD ENDIF IF(ICHAR-1+LS2.GT.LMAX)GOTO 1002 IF(LS2.NE.0)THEN DUM1(ICHAR:)=STR2(:LS2) ICHAR=ICHAR+LS2 ENDIF IC=IND+LS1 ENDDO !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IF(IER.EQ.0)RETURN LADD=LCDUM-IC IF(ICHAR+LADD.GT.LMAX)GOTO 1002 DUM1(ICHAR:)=CDUM(IC:max(ic,LCDUM)) CDUM=DUM1(:LMAX) RETURN !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 1002 call pln('*change* new line will be too long') goto 999 999 continue IER=-1 !CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC END SUBROUTINE CHANGE !=================================================================================================================================== subroutine pln(inline,int,val) ! @(#) pln: print messages with optional INTEGER or REAL value appended implicit none character(len=*),intent(in) :: inline integer,intent(in),optional :: int real,intent(in),optional :: val integer :: ios if(present(int))then ! write string with integer value appended write(*,'(a,i0)',iostat=ios)inline,int elseif(present(val))then ! write string with real value appended write(*,'(a,g20.13)',iostat=ios)inline,val else ! write string write(*,'(a)',iostat=ios)inline endif end subroutine pln !=================================================================================================================================== integer function string_to_integer(inline) ! @(#) returns an integer number from a numeric character string. ! return 0 for a blank string integer,parameter :: IBIG=2147483647 ! assumed overflow value (2**31-1) integer,parameter :: SMALL=0.01 ! and epsilon value character(len=*),intent(in) :: inline if(inline.eq.' ')then string_to_integer=0 elseif(inline.eq.'*')then string_to_integer=-99999 else call juar(inline,valu,ierr) ! on most machines int() would catch the overflow, but this is safer if(valu.gt.IBIG)then call pln('*string_to_integer* integer overflow 2**31-1 <',val=valu) string_to_integer=IBIG elseif(valu.gt.0)then string_to_integer=int(valu+SMALL) else string_to_integer=int(valu-SMALL) endif endif end function string_to_integer !=================================================================================================================================== subroutine juar(inline,valu,ierr) ! @(#) returns real value from numeric character string NOT USING CALCULATOR ! 1989 John S. Urban ! ! returns a real value from a numeric character string. ! ! o works with any g-format input, including integer, real, and ! exponential. ! ! if an error occurs in the read, iostat is returned in ierr and ! value is set to zero. if no error occurs, ierr=0. implicit none ! character(len=*),intent(in) :: inline real,intent(out) :: valu integer,intent(out) :: ierr character(len=13) :: frmt ierr=0 write(frmt,"('(bn,g',i5,'.0)')")len(inline) read(inline,fmt=frmt,iostat=ierr)valu if(ierr.ne.0)then valu=0.0 call pln('*juar* - cannot produce number from this string') call pln(inline) endif end subroutine juar !=================================================================================================================================== end module M_history !===================================================================================================================================

#ifdef TESTPRG90 !------------------------------------------------------------------------------- program redo use M_history, only : jucmd character(len=256) :: line call instructions() do write(*,'(a)',advance='no')'>' ! write prompt read(*,'(a)',iostat=ios) line ! read new input line ! if "r", edit and return a line from the history editor call jucmd(line) ! store into history if not "r". if(line.eq.'quit')stop ! exit program if user enters "quit" !------------------------------------------------------------------------- ! now call user code to process new line of data ! ! As an example, call the system shell using a common f77 extension: !------------------------------------------------------------------------- call system(line(:len_trim(line))) ! Use the next line instead if your compiler supports it !call execute_command_line(line(:len_trim(line))) ! f08 equivalent !------------------------------------------------------------------------- enddo contains subroutine instructions write(*,'(a)')'____________________________________________________' write(*,'(a)')'| |' write(*,'(a)')'| TEST OF JUCMD(3f) COMMAND INPUT EDITOR |' write(*,'(a)')'| |' write(*,'(a)')'| Enter a few commands to be passed to the shell |' write(*,'(a)')'| and then enter "r" or "r r_command" on the input |' write(*,'(a)')'| line to go into history edit mode. |' write(*,'(a)')'| once in history edit mode you may enter |' write(*,'(a)')'| "?" to get some help. |' write(*,'(a)')'| Enter the command "quit" to exit |' write(*,'(a)')'|__________________________________________________|' end subroutine instructions end program redo !------------------------------------------------------------------------------- #endif

JUCMD(3F): Fortran-based Input History Editor

NAME

SYNOPSIS

DESCRIPTION

Sample run of example program

Compilation

Source and Related Files

Alternatives:

Other versions: