Quelle  ZFIR.REXX   Sprache: REXX

/* REXX */                                                                      
/*   Erstes Vorkommen eines Strings im aktuellen Member finden      */          
/*   ----------------------------------------------------------     */          
'ISREDIT MACRO (parm1)'                                                         
                                                                                
   'isredit (dsn) = DATASET'     /* name of current dataset  */                 
   'isredit (mem) = MEMBER'      /* name of current member   */                 
                                                                                
/* Set some variables :  */                                                     
   user     = userid()                                                          
                                                                                
address ispexec                                                                 
'isredit (,col) = CURSOR'                                                       
                                                                                
parm1 = translate(parm1)                                                        
if parm1 = 'T' then                                                             
   trace ?R                                                                     
                                                                                
  /*trace a*/                                                                   
if col = 0 then                                                                 
   do                                                                           
     zedsmsg = 'Invalid cursor position'                                        
     zedlmsg = 'Please, set the cursor in the Edit Area'                        
     'setmsg msg(isrz001)'                                                      
     exit(12)                                                                   
   end                                                                          
                                                                                
'isredit (topline, botline) = DISPLAY_LINES'                                    
rc_dl = rc                                                                      
if  rc_dl /= 0 then                                                             
    do                                                                          
      zedsmsg = 'DISPLAY_LINES Error'                                           
      zedlmsg = 'Range of display lines could not be determined ',              
                'RC form DISPLAY_LINES = ' rc_dl                                
      'setmsg msg(isrz000)'                                                     
      exit(14)                                                                  
    end                                                                         
                                                                                
'isredit (maxcol) = DATA_WIDTH'                                                 
rc_dataw = rc                                                                   
if  rc_dataw /= 0 then                                                          
    do                                                                          
      zedsmsg = 'LRECL not determined'                                          
      zedlmsg = 'Data-width could not be determined, RC = ',                    
                 rc_dataw                                                       
      'setmsg msg(isrz000)'                                                     
      exit(16)                                                                  
    end                                                                         
                                                                                
'isredit (line) = LINE .ZCSR'                                                 
rc_linec = rc                                                                   
if  rc_linec /= 0 then                                                          
    do                                                                          
      zedsmsg = 'Current line not determined'                                   
      zedlmsg = 'Current line was not determined, RC = ',                       
                 rc_linec                                                       
      'setmsg msg(isrz000)'                                                     
      exit(20)                                                                  
    end                                                                         
                                                                                
i = 0                                                                           
                                                                                
/* An den Anfang des Names gehen, bis SPACE, Hochkomma oder     */              
/* Punkt gefunden */                                                            
do i = col  to 1 by -1 ,                                                        
   while  ( substr(line, i, 1) /= " " ) & ,                                     
          ( substr(line, i, 1) /= "'" ) & ,                                     
          ( substr(line, i, 1) /= "," )                                         
    nop                                                                         
end                                                                             
                                                                                
/* Wenn Name am linken Rand steht, war Auswahl falsch */                        
if i = 1 then                                                                   
   do                                                                           
     zedsmsg = 'Invalid select'                                                 
     msg = 'Please, set the cursor on the Copy-Member to be edited'             
     zedlmsg = msg                                                              
     'setmsg msg(isrz001)'                                                      
     exit(12)                                                                   
   end                                                                          
                                                                                
/* set index on first character of name  */                                     
col_anf = i + 1                                                                 
                                                                                
/* Ausgehend von Spalte col den nä. space, das nä. Hochkomma,   */              
/* den nä. punkt oder das nä. Komma suchen                      */              
do i = col_anf  to maxcol by 1 ,                                                
   while  ( substr(line, i, 1) /= ' ' ) & ,                                     
          ( substr(line, i, 1) /= "'" ) & ,                                     
          ( substr(line, i, 1) /= '.' ) & ,                                     
          ( substr(line, i, 1) /= ',' )                                         
    nop                                                                         
end                                                                             
                                                                                
/* set index on last  character of name  */                                     
col_end = i - 1                                                                 
                                                                                
/* compute length of name and evaluate name   */                                
col_len = col_end -col_anf + 1                                                  
name    = substr(line, col_anf, col_len)                                        
                                                                                
                                                                                
/* find first occurence of string determined by variable 'name'  */             
'isredit find 'name' first'                                                     
rc_find = rc                                                                    
                                                                                
/* Return-Code of find-command */                                               
end_fir:                                                                        
select                                                                          
  when rc_find = 0 then                                                         
    do                                                                          
      zedsmsg = 'First CHARS '''name''''                                        
      zedlmsg = 'First occurence of string '''name''' found'                    
      'setmsg msg(isrz000)'                                                     
    end                                                                         
  when rc_find = 4 then                                                         
    do                                                                          
      zedsmsg = 'CHARS '''name''' not found'                                    
      zedlmsg = 'The string '''name''' was not found'                           
      'setmsg msg(isrz000)'                                                     
    end                                                                         
  when rc_find = 12 then                                                        
    do                                                                          
      zedsmsg = 'Syntax Error'                                                  
      zedlmsg = 'Syntax-Error - command: FIND 'name' FIRST'                     
      'setmsg msg(isrz001)'                                                     
    end                                                                         
  otherwise                                                                     
    do                                                                          
      zedsmsg = 'Critical Error'                                                
      zedlmsg = 'Find-Command RC: 'rc_find                                      
      'setmsg msg(isrz001)'                                                     
    end                                                                         
end                                                                             
                                                                                
exit(rc)