change Subroutine

public subroutine change(target_string, cmd, ierr)

NAME

change(3f) - [M_strings:EDITING] change old string to new string with
a directive like a line editor
(LICENSE:PD)

SYNOPSIS

subroutine change(target_string,cmd,ierr)

 character(len=*),intent(inout) :: target_string
 character(len=*),intent(in)    :: cmd
 integer                        :: ierr

DESCRIPTION

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".

OPTIONS

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

EXAMPLES

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

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(inout) :: target_string
character(len=*), intent(in) :: cmd
integer :: ierr

Contents

Source Code


Source Code

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