Power GUI Programming with VisualAge C++/powergui.iso/trialva/ibmcppw/macros/ispfcmd.lx

Text File | 1996-02-22 | 27.3 KB | 630 lines

/******************************************************************************
 * ISPF Prefix commands                                                       *
 *                                                                            *
 * Arguments:  cmd  - prefix command to be executed.  This may be any of the  *
 *                    following:  add                                         *
 *                                delete                                      *
 *                                target                                      *
 *                                show                                        *
 *                                exclude                                     *
 *                                shift                                       *
 *                                duplicate                                   *
 *                                current                                     *
 *                                case                                        *
 *                                                                            *
 *             parm - command specific parameters                             *
 *                                                                            *
 *****************************************************************************/
arg cmd parm

markno = 0                             /* global mark count */
'extract prefixentry'                  /* get text in prefix entry field */
parse upper var prefixentry pe         /* uppercase text */
count = getcount(pe)                   /* pull out numeric part of command */

select
   /* Add command.  This command inserts one or more lines into the file.
      Parameters: none */
   when "ADD" = cmd then do

      'set prefixentry'                /* reset prefix entry field */
      'extract class'                  /* get the class of this line */
      if pos("PFXSHOW",class) \= 0 then do
                                       /* this is an exclude header */
         if nextline("next visible") then
                                       /* move to next visible line */
            'prev class PFXEXCLUDE'    /* find previous exclude line */
         else do                       /* no more visible lines */
            do forever                 /* loop through file */
               if \nextline() then     /* if at end of file */
                  leave                /* get out of loop */
               'extract class'         /* get class of line */
               if pos("PFXEXCLUDE",class) = 0 then do
                                       /* if not exclude line */
                  'prev'               /* go back one */
                  leave                /* get out of loop */
               end
            end
         end
      end
      'add 'count                      /* insert count lines */
      exit                             /* done */
   end

   /* Target command.  This command executes a block copy or move.
      Parameters: before | after | overlay [block] */
   when "TARGET" = cmd then do
      parse var parm target block

      call setmark                     /* set a mark */

      if "BLOCK" = block then do
         if \nextline() | findprefix(substr(pe,1,2)) = "" then
            call errormsg(2 pe)
         call setmark                  /* mark end of block */
      end

      'top'                            /* go to top of file */
      src = findprefix("C M")          /* search for copy or move */
      if src = "" then                 /* if not found issue error */
         call errormsg(1 pe)
      'block clear'                    /* clear current block */
      'block mark element'             /* mark the current element */
      c1 = substr(src,1,1)             /* get first char of copy or move */
      if c1 = "C" then call setmark    /* if copy, set another mark */
      if c1 = substr(src,2,1) then do  /* if block copy or move... */
         if \nextline() |,
            findprefix(substr(src,1,2)) = "" then call errormsg(2 src)
                                       /* find matching block */
         'block mark element'          /* mark block */
         if c1 = "C" then call setmark /* if copy, set another mark */
      end
      if c1 = "C" then                 /* set type of block operation */
         action = "COPY"
      else
         action = "MOVE"

      overlay = "OVERLAY" = target     /* set overlay flag */
      if overlay then                  /* if overlay... */
         target = before               /* copy/move before */

      'mark find PFXMARK1'             /* locate target */
      'block 'action target' clear'    /* issue copy or move */
      if RC = -3 then                  /* if copy/move into itself, error */
         call errormsg(6 action)

      if overlay then do               /* if overlay command */
         'mark find PFXMARK1'          /* find overlay line */
         'block mark element'          /* set the block on the line */
         if block = "BLOCK" then do    /* if this is a block overlay */
            'mark find PFXMARK2'       /* find the closing block */
            'block mark element'       /* mark the whole block */
         end
         'block delete'                /* delete the overlayed lines */
      end

   end

   /* Delete command.  This command deletes one or more lines.
      Parameters:  [block] - indicate block delete */
   when "DELETE" = cmd then do
      'block clear'                    /* clear the current block */
      'block mark element'             /* mark this element */
      if parm = "BLOCK" then do        /* if block delete... */
         if \nextline() | findprefix("DD") = "" then call errormsg(2 pe)
                                       /* look for end of block */
      end
      else do                          /* else not block delete */
         lines = count - 1
         if lines > 0 then
            'scroll down' lines        /* find last line to be deleted */
      end
      'extract class'                  /* get the class of the last line */
      if pos("PFXSHOW",class) \= 0 then do
                                       /* this is an exclude header */
         if nextline("next visible") then
                                       /* move to next visible line */
            'prev class PFXEXCLUDE'    /* find previous exclude line */
         else do                       /* no more visible lines */
            do forever                 /* loop through file */
               if \nextline() then     /* if at end of file */
                  leave                /* get out of loop */
               'extract class'         /* get class of line */
               if pos("PFXEXCLUDE",class) = 0 then do
                                       /* if not exclude line */
                  'prev'               /* go back one */
                  leave                /* get out of loop */
               end
            end
         end
      end
      'extract deleting'               /* get deleting command */
      'set deleting'                   /* remove it */
      'block mark element'             /* mark the delete block */
      'block delete'                   /* delete the block */
      if headers() then                /* if there are still header lines */
         'set deleting' deleting       /* restore deleting command */
      exit                             /* all done */
   end

   /* Show command.  This command shows one or more excluded lines.
      Parameters: all | first | last - indicates which part of the excluded
                                       block to show. */
   when "SHOW" = cmd then do
      'extract class'                  /* get class of current line */
      if pos("PFXSHOW",class) == 0 then
         call errormsg(3)              /* issue error if not exclude header */
      call setmark                     /* set a mark on this line */
      'set prefixentry'                /* clear the prefix entry text */

      if parm = "LAST" then do         /* if show last command */
         do forever                    /* look for end of block */
            if \nextline() then leave  /* if no more lines, leave */
            'extract class'            /* get class of line */
            if pos("PFXEXCLUDE",class) = 0 then do
                                       /* if not part of block, leave */
               'prev'
               leave
            end
         end
         dir = 'prev'                  /* set direction */
      end
      else do
         dir = 'next'                  /* set direction */
         'next'
      end

      if parm = "ALL" then             /* if showing whole block */
         'extract elements into count' /* set count to file size */

      do i = 1 to count                /* loop through the lines */
         'extract class'               /* get class of line */
         if pos("PFXEXCLUDE",class) == 0 then leave
                                       /* if not an excluded line, leave */
         parse var class pre "PFXEXCLUDE" post
         'set class 'pre post          /* remove PFXEXCLUDE from class */
         if \nextline(dir) then leave  /* if no more lines, leave */
      end

      if "FIRST" = parm then do        /* if show fisrt command */
         call beginchange              /* make sure changes not recorded */
         'prev'                        /* back up a line */
         'add'                         /* add a new exclude header */
         'set class PFXSHOW'           /* set exclude header class */
         'set show on'                 /* make it a show line */
         call setmark                  /* mark this line */
         'mark find PFXMARK1'          /* find old header */
         call deleteheader             /* delete the header */
         'mark find PFXMARK2'          /* find new header */
         'mark clear PFXMARK2'         /* change mark name to PFXMARK1 */
         markno = 0
         call setmark
         call endchange                /* restore recording status */
      end
      else                             /* not a show first */
         'mark find PFXMARK1'          /* find header */

      call excludeheader               /* set exclude header text */
   end

   /* Exclude command.  This command excludes one or more lines.
      Parameters - [ALL | BLOCK] - indicates exclude all or block exclude */
   when "EXCLUDE" = cmd then do
      'extract classes'                /* Add PFXEXCLUDE and PFXSHOW classes */
      if pos("PFXEXCLUDE",classes) = 0 then
         'set classes 'classes' PFXSHOW PFXEXCLUDE'
      'extract highlight'              /* Add PFXSHOW to highlight classes */
      if pos("PFXSHOW",highlight) = 0 then
         'set highlight 'highlight' PFXSHOW'
      'extract exclude'                /* Add PFXEXCLUDE to exclude classes */
      if pos("PFXEXCLUDE",exclude) = 0 then
         'set exclude 'exclude' PFXEXCLUDE'
      'extract protect'                /* Add PFXSHOW to protect classes */
      if pos("PFXSHOW",protect) = 0 then
         'set protect 'protect' PFXSHOW'

      'extract class'                  /* get class of current line */
      if pos("PFXEXCLUDE",class) > 0 then do
         'set prefixentry'             /* clear prefix entry field */
         exit                          /* quit if line already hidden */
      end

      call setmark                     /* set a mark */
      'extract element into startline' /* get element number */

      if parm = "BLOCK" then do        /* if block exclude... */
         if \nextline() |,
            findprefix(substr(pe,1,2)) = "" then call errormsg(2 pe)
                                       /* if block not found issue error */
         'set prefixentry'             /* clear prefix entry field text */
         'extract element into endline'/* get element number of end of block */
         count = endline - startline + 1
                                       /* calculate number of lines to exclude*/
      end
      else if parm = "ALL" then        /* if excluding all the lines */
         'extract elements into count' /* get file size */

      call beginchange                 /* make sure changes not recorded */
      'mark find PFXMARK1'             /* find first line to exclude */
      'splitjoin split'                /* open a new line before it */
      'set class PFXSHOW'              /* set exclude header class */
      'set show on'                    /* make it a show line */
      call endchange                   /* restore recording */

      'next'                           /* move to next line */
      do i = 1 to count                /* loop through and exclude the lines */
         'extract class'
         if pos("PFXSHOW",class) > 0 then leave
         'set class 'class' PFXEXCLUDE'
         if \nextline() then leave
      end

      call excludeheader               /* set exclude header */
   end

   /* Shift command.  This command shifts one or more lines.
      Parameters: right | left - indicates shift direction
                  trunc | notrunc - indicates if shift should truncate line
                  [block] - indicates block shift */
   when "SHIFT" = cmd then do
      parse var parm dir trunc type

      call setmark                     /* set a mark on this line */
      'block clear'                    /* clear the current block */
      'block mark element'             /* mark this line */

      if type = "BLOCK" then do        /* if block shift */
         if \nextline() |,
            findprefix(substr(pe,1,2)) = "" then call errormsg(2 pe)
                                       /* search for end of block */
         'set prefixentry'             /* clear prefix entry field text */
         'block mark element'          /* mark the block */
      end

      truncate = trunc \= "NOTRUNC"    /* set truncation flag */
      if truncate then do              /* if truncate... */
         'extract limiterror into savelimiterror'
                                       /* save limiterror mode */
         'set limiterror truncate'     /* set limiterror mode to truncate */
         trunc = ""                    /* no option needed for turncate */
      end

      'block shift 'dir count trunc' clear'
                                       /* issue shift command */

      if truncate then                 /* if truncate, restore limiterror */
         'set limiterror 'savelimiterror
   end

   /* Duplicate command.  This command duplicates the current line one or more times
      Parameters:  none */
   when "DUPLICATE" = cmd then do
      call setmark                     /* set a mark on this line */
      'block clear'                    /* clear the current block */
      'block mark element'             /* mark this line */

      if parm = "BLOCK" then do        /* if block repeat... */
                                       /* look for end of block */
         if \nextline() | findprefix(substr(pe,1,2)) = "" then
            call errormsg(2 pe)
         'set prefixentry'             /* clear prefix entry field */
         'block mark element'          /* mark the block */
      end

      do i = 1 to count                /* copy the line count times */
         'block copy after'
      end
      'block clear'                    /* clear the block */
   end

   /* Current command.  This command sets the current line.
      Parameters:  none */
   when "CURRENT" = cmd then do
      call setmark                     /* set a mark on this line */

      'set focus.next 1'               /* set to top of window */
      'mark find PFXMARK1'             /* make this the current line */
   end

   /* Case command.  This command changes the case of the specified line
      Parameters: upper [block]| lower [block] - indicates desired case */
   when "CASE" = cmd then do
      parse var parm case block
      'set prefixentry'                /* clear prefix entry field */
      'block clear'                    /* clear the current block */
      'block mark element'             /* mark this line */
      if block = "BLOCK" then do
         if case = "UPPER" then do       /* look for block end */
            if \nextline() | findprefix("UCC") = "" then call errormsg(2 pe)
         end
         else if case = "LOWER" then do       /* look for block end */
            if \nextline() | findprefix("LCC") = "" then call errormsg(2 pe)
         end
      end
      else do
         extract element into start
         end = start + count -1              /* get number of lines affected */
         if end > start then
            'find element' end           /* move to last line            */
      end
      'extract class'                  /* get the class of the last line */
      if pos("PFXSHOW",class) \= 0 then do
                                       /* this is an exclude header */
         if nextline("next visible") then
                                       /* move to next visible line */
            'prev class PFXEXCLUDE'    /* find previous exclude line */
         else do                       /* no more visible lines */
            do forever                 /* loop through file */
               if \nextline() then     /* if at end of file */
                  leave                /* get out of loop */
               'extract class'         /* get class of line */
               if pos("PFXEXCLUDE",class) = 0 then do
                                       /* if not exclude line */
                  'prev'               /* go back one */
                  leave                /* get out of loop */
               end
            end
         end
      end
      'set prefixentry'                /* clear prefix entry field */
      'block mark element'             /* mark the case block   */
      'block 'case' clear'             /* set the case          */
      exit
   end
end

call setmark                           /* save the current position */
do i = 1 to (markno - 1)               /* loop through the marked lines */
   'extract mark.PFXMARK'i' into markcol'
   if markcol \= 0 then do             /* if mark not deleted */
      'mark find PFXMARK'i             /* find the mark */
      'set prefixentry'                /* clear the prefix entry field */
   end
end
'mark find PFXMARK'markno              /* restore the current position */

cleanup:

do i = 1 to markno                     /* loop through and delete marks */
   'mark clear PFXMARK'i
end

exit                                   /* all done */

/******************************************************************************
 *                                                                            *
 * function getcount(str)                                                     *
 *                                                                            *
 * This function returns the numeric part of a character string.  If there is *
 * no numeric part, then 1 is returned.                                       *
 *                                                                            *
 ******************************************************************************/
getcount:

procedure

arg count

do while datatype(substr(count,1,1)) \= "NUM"
   if length(count) = 1 then
      count = 1
   else
      count = substr(count,2)
end

do while datatype(substr(count,length(count))) \= "NUM"
   if length(count) = 1 then
      count = 1
   else
      count = delstr(count,length(count))
end

return abs(count)

/******************************************************************************
 *                                                                            *
 * setmark routine                                                            *
 *                                                                            *
 * This routine sets a mark on the current line.  It uses the global variable *
 * markno to give the mark a unique name.                                     *
 *                                                                            *
 ******************************************************************************/
setmark:

procedure expose markno

markno = markno + 1
'extract element into e'
'mark set PFXMARK'markno e '-1'
return

/******************************************************************************
 *                                                                            *
 * function findprefix(str)                                                   *
 *                                                                            *
 * This function looks for a line whose prefix entry field contains text that *
 * begins with str.  If str contains more than one string, then the first     *
 * line that matches either is returned.  The actual prefix text is returned  *
 * by this function.                                                          *
 *                                                                            *
 ******************************************************************************/
findprefix:

procedure

arg parm

do forever
   'extract prefixentry into pe'
   parse upper var pe upperpe
   cmds = parm
   do while length(cmds) > 0
      parse var cmds cmd cmds
      if length(upperpe) >= length(cmd) then
         if cmd = substr(upperpe,1,length(cmd)) then
            return upperpe
   end
   'find prefixentry'
   if RC \= 0 then return ""
end

/******************************************************************************
 *                                                                            *
 * beginchange routine                                                        *
 *                                                                            *
 * This routine changes the recording state so that changes will not be       *
 * recorded.                                                                  *
 *                                                                            *
 ******************************************************************************/
beginchange:

procedure expose savechanges saverecording

'extract changes into savechanges'
'extract recording into saverecording'

'set recording off'
return

/******************************************************************************
 *                                                                            *
 * endchange routine                                                          *
 *                                                                            *
 * This routine restored the recording state to that before beginchange was   *
 * called.                                                                    *
 *                                                                            *
 ******************************************************************************/
endchange:

procedure expose saverecording savechanges

'set recording 'saverecording
'set changes 'savechanges
return

/******************************************************************************
 *                                                                            *
 * excludeheader routine                                                      *
 *                                                                            *
 * This routine counts the number of excluded line is a block and sets the    *
 * exclude header text appropriately.                                         *
 *                                                                            *
 ******************************************************************************/
excludeheader:

procedure

'mark find PFXMARK1'
lines = 0
do forever
   if \nextline() then leave
   'extract class'
   if pos("PFXEXCLUDE",class) == 0 then leave
   lines = lines + 1
end

call beginchange
'mark find PFXMARK1'
if 0 = lines then do
   call deleteheader
   call endchange
   exit
end
'extract limiterror into savelimiterror'
'set limiterror ignore'
if 1 = lines then
   'set content 'ispfmsg(4)
else
   'set content 'ispfmsg(5 lines)
'set limiterror 'savelimiterror
call endchange

'extract deleting'
if deleting = "" then do
   'macroload pfxdel.lx'
   'set deleting pfxdel'
end

return

/******************************************************************************
 *                                                                            *
 * deleteheader routine                                                       *
 *                                                                            *
 * This routine deletes the current exclude header line.                      *
 *                                                                            *
 ******************************************************************************/
deleteheader:

procedure

'extract deleting'
'set deleting'
'delete'
if headers() then
   'set deleting 'deleting

return

/******************************************************************************
 *                                                                            *
 * function headers()                                                         *
 *                                                                            *
 * This function returns TRUE if there are any headers remaining.             *
 *                                                                            *
 ******************************************************************************/
headers:

procedure

'extract classes'
if (pos("PFXSHOW",classes) = 0) then
   return 0

'extract element into e'
'mark set PFXMARKH' e '-1'
'top'
'next class PFXSHOW'
'extract class'
'mark find PFXMARKH'
'mark clear PFXMARKH'

return (pos("PFXSHOW",class) \= 0)

/******************************************************************************
 *                                                                            *
 * function nextline(dir)                                                     *
 *                                                                            *
 * This function accepts a direction (prev or next) and move to the previous  *
 * or next line.  It returns TRUE if the operation completed successfully.    *
 *                                                                            *
 ******************************************************************************/
nextline:

procedure

arg dir parm

if dir \= "PREV" then
   dir = 'next'

'extract element into preve'
dir parm
'extract element'
return element \= preve

/******************************************************************************
 *                                                                            *
 * errormsg(msgno insert) routine                                             *
 *                                                                            *
 * This routine issues an error message msgno and exits.                      *
 *                                                                            *
 ******************************************************************************/
errormsg:

arg msgno insert

'msg 'ispfmsg(msgno insert)
signal cleanup