modif(3f) - [M_strings:EDITING] emulate the MODIFY command from the
line editor XEDIT
(LICENSE:PD)
subroutine modif(cline,cmod)
character(len=*) :: cline ! input string to change
! directive provides directions on changing string
character(len=*) :: cmod
MODIF(3f) Modifies the line currently pointed at using a directive that acts much like a line editor directive. Primarily used to create interactive utilities such as input history editors for interactive line-mode programs.
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,
MODIF(3f) 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 input/output:
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
Sample program:
program demo_modif
use M_strings, only : modif
implicit none
character(len=256) :: line
integer :: ios
integer :: count
integer :: COMMAND_LINE_LENGTH
character(len=:),allocatable :: COMMAND_LINE
! get command name length
call get_command_argument(0,length=count)
! get command line length
call get_command(length=COMMAND_LINE_LENGTH)
! allocate string big enough to hold command line
allocate(character(len=COMMAND_LINE_LENGTH+200) :: COMMAND_LINE)
! get command line as a string
call get_command(command=COMMAND_LINE)
! trim leading spaces just in case
COMMAND_LINE=adjustl(COMMAND_LINE)
! remove command name
COMMAND_LINE=adjustl(COMMAND_LINE(COUNT+2:))
INFINITE: do
read(*,'(a)',iostat=ios)line
if(ios /= 0)exit
call modif(line,COMMAND_LINE)
write(*,'(a)')trim(line)
enddo INFINITE
end program demo_modif
John S. Urban
Public Domain
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*) | :: | cline | ||||
| character(len=*), | intent(in) | :: | mod |
subroutine modif(cline,mod)
!$@(#) M_strings::modif(3f): Emulate the MODIFY command from the line editor XEDIT
!
! MODIF
! =====
! ACTION- MODIFIES THE LINE CURRENTLY POINTED AT. THE INPUT STRING CLINE IS ASSUMED TO BE LONG ENOUGH TO ACCOMMODATE THE CHANGES
! 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,
! MODIF(3f) INSERTS THE REMAINDER OFTHELINE 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(len=*) :: cline !STRING TO BE MODIFIED
character(len=*),intent(in) :: mod !STRING TO DIRECT MODIFICATION
character(len=len(cline)) :: cmod
character(len=3),parameter :: c='#&^' !ASSIGN DEFAULT EDIT CHARACTERS
integer :: maxscra !LENGTH OF SCRATCH BUFFER
character(len=len(cline)) :: dum2 !SCRATCH CHARACTER BUFFER
logical :: linsrt !FLAG FOR INSERTING DATA ON LINE
integer :: i, j, ic, ichr, iend, lmax, lmx1
maxscra=len(cline)
cmod=trim(mod)
lmax=min0(len(cline),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 CLINE
ichr=0 !CHAR COUNTER NEW LINE DUM2
11 continue
i=i+1 !NEXT CHAR IN MOD LINE
if(ichr > lmx1)goto 999 !IF TOO MANY CHARS IN NEW LINE
if(linsrt) then !IF INSERTING NEW CHARS
if(i > iend) cmod(i:i)=c(1:1) !FORCE END OF INSERT MODE
if(cmod(i:i) == c(1:1))then !IF END OF INSERT MODE
linsrt=.false. !RESET INSERT MODE FLAG
if(ic+1 == i)then !NULL INSERT STRING
ichr=ichr+1 !INCREMENT COUNTER FOR NEW LINE
dum2(ichr:ichr)=c(1:1) !INSERT INSERT MODE TERMINATOR
endif
do j=ic,i !LOOP OF NUMBER OF CHARS INSERTED
ichr=ichr+1 !INCREMENT COUNTER FOR NEW LINE
if(ichr > lmax)goto 999 !IF AT BUFFER LIMIT, QUIT
dum2(ichr:ichr)=cline(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
ichr=ichr+1 !INCREMENT NEW LINE COUNT
dum2(ichr:ichr)=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) == c(1:1))goto 1 !IF DELETE CHAR. NO COPY AND CYCLE
if(cmod(i:i) == 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
ichr=ichr+1 !INCREMENT NEW LINE COUNTER
if(cmod(i:i) == c(2:2))then !IF REPLACE WITH BLANK
dum2(ichr:ichr)=' ' !SET NEWLINE CHAR TO BLANK
goto 1 !CHECK LINE LENGTH AND CYCLE
endif !IF NOT REPLACE WITH BLANK
if(cmod(i:i) == ' ')then !IF BLANK, KEEP ORIGINAL CHARACTER
dum2(ichr:ichr)=cline(ic:ic) !SET NEW CHAR TO ORIGINAL CHAR
else !IF NOT KEEPING OLD CHAR
dum2(ichr:ichr)=cmod(i:i) !REPLACE ORIGINAL CHAR WITH NEW
endif !END CHAR KEEP OR REPLACE
endif !END INSERT OR NO-INSERT
1 continue
if(i < lmax)goto 11 !CHECK FOR END OF LINE REACHED
!AND CYCLE IF OK
999 continue
cline=dum2 !SET ORIGINAL CHARS TO NEW CHARS
end subroutine modif !RETURN