modif Subroutine

public subroutine modif(cline, mod)

NAME

modif(3f) - [M_strings:EDITING] emulate the MODIFY command from the
line editor XEDIT
(LICENSE:PD)

SYNOPSIS

subroutine modif(cline,cmod)

 character(len=*) :: cline ! input string to change
 ! directive provides directions on changing string
 character(len=*) :: cmod

DESCRIPTION

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.

EXAMPLES

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

AUTHOR

John S. Urban

LICENSE

Public Domain

Arguments

Type IntentOptional Attributes Name
character(len=*) :: cline
character(len=*), intent(in) :: mod

Contents

Source Code


Source Code

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