/* rexx */                                                                      
/*-------------------------------------------------------------------*/         
/*                                                                   */         
/*                        REXX Exec : COMMENT                        */         
/*                                                                   */         
/*                      ***** Edit Macro *****                       */         
/*                                                                   */         
/*  Description : Change lines into comments                         */         
/*                Use the Q line command or QQ block commands        */         
/*                                                                   */         
/*  Created on : 26 Aug 2023                                         */         
/*  Created by : Kevin Ferguson                                      */         
/*             : Userid MIT001                                       */         
/*             : Using ABBYDALE.DEVL.EMACS(COMMENT)                  */         
/*                                                                   */         
/*  Called by : Edit macro                                           */         
/*                                                                   */         
/*  Calls : strRepl, setlang                                         */         
/*                                                                   */         
/*  Panels Used : none                                               */         
/*                                                                   */         
/*  Change Activity :                                                */         
/*                                                                   */         
/*  MM/DD/YYYY  ID   Comment                                         */         
/*  ---------------------------------------------------------------  */         
/*  08/28/2023  NON  Remove the ugly seek highlight                  */         
/*                                                                   */         
/*                ©Copyright of Abbydale Systems LLC.                */         
/*                                                                   */         
/*-------------------------------------------------------------------*/         
Parse Arg Help         /* Check for Help */                                     
dialogid = sysvar(sysicmd)                                                      
parse source Exec_String                                                        
excnme = word(Exec_String,3)                                                    
If SYSVAR("SYSISPF")<>"ACTIVE" then do                                          
   Say "ISPF must be active to use "COMMENT                                     
   exit(16)                                                                     
end                                                                             
Address ISREDIT "MACRO (Help) NOPROCESS"                                        
If Help = "?" Then do                                                           
   ZEDSMSG = 'Help displayed'                                                   
   ZEDLMSG = 'Help was displayed. No other action taken'                        
   ZDLMSG = 'Help displayed'                                                    
   Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"                                
   Address ISPEXEC "SETMSG MSG(ISRZ001)"                                        
   Call Disp_Help                                                               
   exit(4)                                                                      
end                                                                             
Address ISPEXEC "CONTROL ERRORS RETURN"                                         
Address ISREDIT "(CR, CC) = CURSOR"                                             
Address ISREDIT "PROCESS RANGE Q"                                               
Address ISREDIT "(RC) = RANGE_CMD"                                              
Address ISREDIT "(FAR) = LINENUM .ZLAST"                                        
Address ISREDIT "(LAR) = LINENUM .ZFIRST"                                       
address ISREDIT "(FR)  = LINENUM .ZFRANGE"                                      
address ISREDIT "(LR)  = LINENUM .ZLRANGE"                                      
address ISREDIT "(whower) = MEMBER"                                             
if fr = 0 then do                                                               
   if lr = 0 then do                                                            
      ZEDSMSG = 'Invalid call'                                                  
      ZEDLMSG = 'No QQ block detected'                                          
      Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"                             
      Address ISPEXEC "SETMSG MSG(ISRZ001)"                                     
      exit(8)                                                                   
   end                                                                          
end                                                                             
"ISREDIT SCAN OFF"                                                              
"ISREDIT SEEK 'PROC ' FIRST"                                                    
if rc = 0 then do                                                               
   do k = lar to far                                                            
      Address ISREDIT "(temp) = LINE" k                                         
      if words(temp) = 0 then iterate                                           
      if word(temp,1) = "/*" then iterate                                       
      tester = word(temp,1)                                                     
      parse upper var tester                                                    
      if tester = "PROC" then k = far                                           
   end                                                                          
   if tester = "PROC" then do                                                   
      mystar = fr                                                               
      myend  = lr                                                               
      do k = mystar to myend                                                    
         Address ISREDIT "(temp) = LINE" k                                      
         if words(temp) = 0 then iterate                                        
         if substr(word(temp,1),1,2) = "/*" then iterate                        
         if substr(temp,1,2) <> "  " then do                                    
            temp = "/*"||substr(temp,1,72)                                      
         end                                                                    
         else do                                                                
            temp = "/*"||substr(temp,3,72)                                      
         end                                                                    
         address ISREDIT "LINE "k "= (temp)"                                    
      end                                                                       
      k = k - 1                                                                 
      if k = mystar then signal SingleOut                                       
      signal MultiOut                                                           
   end                                                                          
end                                                                             
if whower <> "COMMENT" then do                                                  
   "ISREDIT SEEK 'Identification Division' FIRST"                               
   If rc = 0 then do                                                            
      "ISREDIT SEEK 'Environment Division' FIRST"                               
      If rc = 0 then do                                                         
         "ISREDIT SEEK 'Data Division' FIRST"                                   
         If rc = 0 then do                                                      
            "ISREDIT SEEK 'Procedure Division' FIRST"                           
            If rc = 0 then do                                                   
               mystar = fr                                                      
               myend  = lr                                                      
               do k = mystar to myend                                           
                  Address ISREDIT "(temp) = LINE" k                             
                  temp = substr(temp,1,6)||"*"||substr(temp,8,72)               
                  address ISREDIT "LINE "k "= (temp)"                           
               end                                                              
               k = k - 1                                                        
               if k = mystar then signal SingleOut                              
               signal MultiOut                                                  
            end                                                                 
         end                                                                    
      end                                                                       
   end                                                                          
end                                                                             
"ISREDIT SEEK '/*' FIRST"    /* look for the string */                          
If rc = 0 then do                                                               
   "ISREDIT (NUM1) = LINENUM .ZCSR"                                             
   "ISREDIT SEEK '*/' FIRST"    /* look for the string */                       
   If rc = 0 then do                                                            
      "ISREDIT (NUM2) = LINENUM .ZCSR"                                          
      "ISREDIT SEEK 'rexx' FIRST"    /* look for the string */                  
ClistFound:                                                                     
      If rc = 0 then do                                                         
         heads = """/*"""                                                       
         tails = """*/"""                                                       
         if fr = lar then do                                                    
            if lr = Far then do                                                 
InsertItRexx:                                                                   
               Address ISREDIT "(temp) = LINE" cr                               
               temp = strRepl(temp,'/*','%*')                                   
               temp = strRepl(temp,'*/','*%')                                   
               Address ISREDIT "LINE "cr "= (temp)"                             
               Address ISREDIT "LINE_AFTER" cr "=" tails                        
               Address ISREDIT "LINE_BEFORE" cr "=" heads                       
               signal SingleOut                                                 
            end                                                                 
         end                                                                    
         if fr = lr then do                                                     
            cr = fr                                                             
            signal InsertItRexx                                                 
         end                                                                    
         mystar = fr                                                            
         myend  = lr                                                            
         do k = mystar to myend                                                 
            Address ISREDIT "(temp) = LINE" k                                   
            temp = strRepl(temp,'/*','%*')                                      
            temp = strRepl(temp,'*/','*%')                                      
            address ISREDIT "LINE "k "= (temp)"                                 
         end                                                                    
         Address ISREDIT "LINE_AFTER" lr "=" tails                              
         Address ISREDIT "LINE_BEFORE" fr "=" heads                             
         signal MultiOUT                                                        
      end                                                                       
   end                                                                          
end                                                                             
else do                                                                         
   "ISREDIT SEEK ' CSECT ' FIRST 2 66"    /* look for the string */             
   If rc = 0 then do                                                            
      "ISREDIT SEEK ' USING ' FIRST 2 66"    /* look for the string */          
      If rc = 0 then do                                                         
         mystar = fr                                                            
         myend  = lr                                                            
         do k = mystar to myend                                                 
            Address ISREDIT "(temp) = LINE" k                                   
            if substr(temp,1,1) = " " then do                                   
               if substr(temp,72,1) = " " then do                               
                  temp = "*"||substr(temp,2,71)                                 
               end                                                              
               else do                                                          
                  temp = "*"||substr(temp,2,69)||"* "                           
               end                                                              
            end                                                                 
            else do                                                             
               if substr(temp,1,1) = "*" then iterate                           
               if substr(temp,72,1) = " " then do                               
                  temp = "*"||substr(temp,1,71)                                 
               end                                                              
            end                                                                 
            address ISREDIT "LINE "k "= (temp)"                                 
         end                                                                    
         k = k - 1                                                              
         if k = mystar then signal SingleOut                                    
         signal MultiOut                                                        
      end                                                                       
   end                                                                          
end                                                                             
"ISREDIT SEEK '//'  FIRST 1 2"    /* look for the string */                     
if rc = 0 then do                                                               
   "ISREDIT SEEK ' EXEC '  FIRST 3 66"    /* look for the string */             
   If rc = 0 then do                                                            
      mystar = fr                                                               
      myend  = lr                                                               
      do k = mystar to myend                                                    
         Address ISREDIT "(temp) = LINE" k                                      
         if substr(temp,1,2) = "//" then do                                     
            temp = strRepl(temp,"//","//*",1)                                   
         end                                                                    
         if substr(temp,1,1) <> "/" then do                                     
            temp = "*"||temp                                                    
            if length(temp) > 72 then temp = substr(temp,1,72)                  
         end                                                                    
         address ISREDIT "LINE "k "= (temp)"                                    
      end                                                                       
      k = k - 1                                                                 
      if k = mystar then signal SingleOut                                       
      signal MultiOut                                                           
      say k fr                                                                  
      say "JCL"                                                                 
   end                                                                          
end                                                                             
ZEDSMSG = 'Unknown file type'                                                   
ZEDLMSG = 'Unable to determine data type'                                       
Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"                                   
Address ISPEXEC "SETMSG MSG(ISRZ001)"                                           
exit(12)                                                                        
SingleOut:                                                                      
ZEDSMSG = 'Line commented out'                                                  
ZEDLMSG = 'Line 'strip(cr,l,"0") 'commented out'                                
signal LeaveIt                                                                  
multiOut:                                                                       
ZEDSMSG = 'Lines commented out'                                                 
ZEDLMSG = 'Lines 'strip(fr,l,"0") '-' strip(lr,l,"0") 'commented out'           
LeaveIt:                                                                        
Address ISPEXEC "VPUT (ZDLMSG ZDLMSG) SHARED"                                   
Address ISPEXEC "SETMSG MSG(ISRZ001)"                                           
Address ISREDIT "UP MAX"                                                        
count = 0                                                                       
Address ISREDIT "LOCATE FIRST MSGLINE"                                          
if rc = 0 then do                                                               
   do until rc > 0                                                              
      count = count + 1                                                         
      Address ISREDIT "LOCATE NEXT MSGLINE"                                     
   end                                                                          
end                                                                             
fr = strip(fr,'l',"0")                                                          
Address ISREDIT "FIND ' '"                                      /*NON*/         
Address ISREDIT "RESET FIND"                                    /*NON*/         
Address ISREDIT "DOWN" fr                                                       
Address ISREDIT "CURSOR" fr "1"                                                 
exit(0)                                                                         
/*-------------------------------------------------------------------*/         
/*                        Disp_Help Procedure                        */         
/*-------------------------------------------------------------------*/         
Disp_Help: Procedure EXPOSE excnme                                              
excnme = RIGHT(excnme,8," ")                                                    
say ""excnme " - Will comment out a line or lines in a Rexx Exec"               
say             "To comment out a block use QQ in the line column"              
say""                                                                           
say "Usage: "excnme " xxxxx | ?"                                                
say""                                                                           
say"    ?        - Generates this information."                                 
say""                                                                           
say"   Return Codes :"                                                          
say"                 4 - Help displayed"                                        
say"                 8 - Invlaid call"                                          
say"                12 - Unknown file type"                                     
say"                16 - Not under ISPF or Halt(PA1) pressed"                   
say""                                                                           
Return                                                                          
/*-------------------------------------------------------------------*/         
/*                    End of Disp_Help Procedure                     */         
/*-------------------------------------------------------------------*/         
/*                        Trap HALT Condition                        */         
/*-------------------------------------------------------------------*/         
halt:                                                                           
say "HALT acknowledged in line" sigl                                            
say "Cleanup processing in progress"                                            
address "TSO"                                                                   
"delstack"                                                                      
exit(16)                                                                        
/*-------------------------------------------------------------------*/         
/*                          End of COMMENT                           */         
/*-------------------------------------------------------------------*/