change(3f) - [M_strings:EDITING] change old string to new string with
a directive like a line editor
(LICENSE:PD)
subroutine change(target_string,cmd,ierr)
character(len=*),intent(inout) :: target_string
character(len=*),intent(in) :: cmd
integer :: ierr
change an old substring into a new substring in a character variable
like a line editor. Primarily used to create interactive utilities
such as input history editors for interactive line-mode programs. The
output string is assumed long enough to accommodate the change.
a directive resembles a line editor directive of the form
C/old_string/new_string/
where / may be any character which is not included in old_string
or new_string.
a null old_string implies "beginning of string".
target_string line to be changed
cmd contains instructions to change the string
ierr error code.
o =-1 bad directive
o =0 no changes made
o >0 count of changes made
Sample program:
program demo_change
use M_strings, only : change
implicit none
character(len=132) :: line='This is a test string to change'
integer :: ierr
write(*,*)trim(line)
! change miniscule a to uppercase A
call change(line,'c/a/A/',ierr)
write(*,*)trim(line)
! put string at beginning of line
call change(line,'c//prefix: /',ierr)
write(*,*)trim(line)
! remove blanks
call change(line,'c/ //',ierr)
write(*,*)trim(line)
end program demo_change
Expected output
This is a test string to change
This is A test string to chAnge
prefix: This is A test string to chAnge
prefix:ThisisAteststringtochAnge
John S. Urban
Public Domain
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| character(len=*), | intent(inout) | :: | target_string | |||
| character(len=*), | intent(in) | :: | cmd | |||
| integer | :: | ierr |
subroutine change(target_string,cmd,ierr)
! Change a string assumed long enough to accommodate the change, with a directive that resembles a line editor directive of the form
! C/old_string/new_string/
! where / may be any character which is not included in old_string or new_string.
! a null old_string implies "beginning of string"
!===================================================================================================================================
! ident_13="@(#) M_strings change(3f) change a character string like a line editor"
character(len=*),intent(inout) :: target_string ! line to be changed
character(len=*),intent(in) :: cmd ! contains the instructions changing the string
character(len=1) :: delimiters
integer :: ierr ! error code. ier=-1 bad directive;=0 no changes made;>0 ier changes made
integer :: itoken
integer,parameter :: id=2 ! expected location of delimiter
character(len=:),allocatable :: old,new ! scratch string buffers
logical :: ifok
integer :: lmax ! length of target string
integer :: start_token,end_token
!-----------------------------------------------------------------------------------------------------------------------------------
lmax=len_trim(cmd) ! significant length of change directive
if(lmax >= 4)then ! strtok ignores blank tokens so look for special case where first token is really null
delimiters=cmd(id:id) ! find delimiter in expected location
itoken=0 ! initialize strtok(3f) procedure
if(strtok(cmd(id:),itoken,start_token,end_token,delimiters)) then ! find OLD string
old=cmd(start_token+id-1:end_token+id-1)
else
old=''
endif
if(cmd(id:id) == cmd(id+1:id+1))then
new=old
old=''
else ! normal case
ifok=strtok(cmd(id:),itoken,start_token,end_token,delimiters) ! find NEW string
if(end_token == (len(cmd)-id+1) )end_token=len_trim(cmd(id:)) ! if missing ending delimiter
new=cmd(start_token+id-1:min(end_token+id-1,lmax))
endif
call substitute(target_string,old,new,ierr,1,len_trim(target_string)) ! change old substrings to new substrings
else ! command was two or less characters
ierr=-1
call journal('sc','*change* incorrect change directive -too short')
endif
!-----------------------------------------------------------------------------------------------------------------------------------
end subroutine change