home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / VSCPPv7.zip / VACPP / IBMCPP / macros / ISPFCMD.LX < prev    next >
Text File  |  1995-05-11  |  26KB  |  595 lines
  1. /******************************************************************************
  2.  * ISPF Prefix commands                                                       *
  3.  *                                                                            *
  4.  * Arguments:  cmd  - prefix command to be executed.  This may be any of the  *
  5.  *                    following:  add                                         *
  6.  *                                delete                                      *
  7.  *                                target                                      *
  8.  *                                show                                        *
  9.  *                                exclude                                     *
  10.  *                                shift                                       *
  11.  *                                duplicate                                   *
  12.  *                                current                                     *
  13.  *                                case                                        *
  14.  *                                                                            *
  15.  *             parm - command specific parameters                             *
  16.  *                                                                            *
  17.  *****************************************************************************/
  18. arg cmd parm
  19.  
  20. markno = 0                             /* global mark count */
  21. 'extract prefixentry'                  /* get text in prefix entry field */
  22. parse upper var prefixentry pe         /* uppercase text */
  23. count = getcount(pe)                   /* pull out numeric part of command */
  24.  
  25. select
  26.    /* Add command.  This command inserts one or more lines into the file.
  27.       Parameters: none */
  28.    when "ADD" = cmd then do
  29.  
  30.       'set prefixentry'                /* reset prefix entry field */
  31.       'extract class'                  /* get the class of this line */
  32.       if pos("PFXSHOW",class) \= 0 then do
  33.                                        /* this is an exclude header */
  34.          if nextline("next visible") then
  35.                                        /* move to next visible line */
  36.             'prev class PFXEXCLUDE'    /* find previous exclude line */
  37.          else do                       /* no more visible lines */
  38.             do forever                 /* loop through file */
  39.                if \nextline() then     /* if at end of file */
  40.                   leave                /* get out of loop */
  41.                'extract class'         /* get class of line */
  42.                if pos("PFXEXCLUDE",class) = 0 then do
  43.                                        /* if not exclude line */
  44.                   'prev'               /* go back one */
  45.                   leave                /* get out of loop */
  46.                end
  47.             end
  48.          end
  49.       end
  50.       'add 'count                      /* insert count lines */
  51.       exit                             /* done */
  52.    end
  53.  
  54.    /* Target command.  This command executes a block copy or move.
  55.       Parameters: before | after | overlay [block] */
  56.    when "TARGET" = cmd then do
  57.       parse var parm target block
  58.  
  59.       call setmark                     /* set a mark */
  60.  
  61.       if "BLOCK" = block then do
  62.          if \nextline() | findprefix(substr(pe,1,2)) = "" then
  63.             call errormsg(2 pe)
  64.          call setmark                  /* mark end of block */
  65.       end
  66.  
  67.       'top'                            /* go to top of file */
  68.       src = findprefix("C M")          /* search for copy or move */
  69.       if src = "" then                 /* if not found issue error */
  70.          call errormsg(1 pe)
  71.       'block clear'                    /* clear current block */
  72.       'block mark element'             /* mark the current element */
  73.       c1 = substr(src,1,1)             /* get first char of copy or move */
  74.       if c1 = "C" then call setmark    /* if copy, set another mark */
  75.       if c1 = substr(src,2,1) then do  /* if block copy or move... */
  76.          if \nextline() |,
  77.             findprefix(substr(src,1,2)) = "" then call errormsg(2 src)
  78.                                        /* find matching block */
  79.          'block mark element'          /* mark block */
  80.          if c1 = "C" then call setmark /* if copy, set another mark */
  81.       end
  82.       if c1 = "C" then                 /* set type of block operation */
  83.          action = "COPY"
  84.       else
  85.          action = "MOVE"
  86.  
  87.       overlay = "OVERLAY" = target     /* set overlay flag */
  88.       if overlay then                  /* if overlay... */
  89.          target = before               /* copy/move before */
  90.  
  91.       'mark find PFXMARK1'             /* locate target */
  92.       'block 'action target' clear'    /* issue copy or move */
  93.       if RC = -3 then                  /* if copy/move into itself, error */
  94.          call errormsg(6 action)
  95.  
  96.       if overlay then do               /* if overlay command */
  97.          'mark find PFXMARK1'          /* find overlay line */
  98.          'block mark element'          /* set the block on the line */
  99.          if block = "BLOCK" then do    /* if this is a block overlay */
  100.             'mark find PFXMARK2'       /* find the closing block */
  101.             'block mark element'       /* mark the whole block */
  102.          end
  103.          'block delete'                /* delete the overlayed lines */
  104.       end
  105.  
  106.    end
  107.  
  108.    /* Delete command.  This command deletes one or more lines.
  109.       Parameters:  [block] - indicate block delete */
  110.    when "DELETE" = cmd then do
  111.       'block clear'                    /* clear the current block */
  112.       'block mark element'             /* mark this element */
  113.       if parm = "BLOCK" then do        /* if block delete... */
  114.          if \nextline() | findprefix("DD") = "" then call errormsg(2 pe)
  115.                                        /* look for end of block */
  116.       end
  117.       else do                          /* else not block delete */
  118.          lines = count - 1
  119.          if lines > 0 then
  120.             'scroll down' lines        /* find last line to be deleted */
  121.       end
  122.       'extract class'                  /* get the class of the last line */
  123.       if pos("PFXSHOW",class) \= 0 then do
  124.                                        /* this is an exclude header */
  125.          if nextline("next visible") then
  126.                                        /* move to next visible line */
  127.             'prev class PFXEXCLUDE'    /* find previous exclude line */
  128.          else do                       /* no more visible lines */
  129.             do forever                 /* loop through file */
  130.                if \nextline() then     /* if at end of file */
  131.                   leave                /* get out of loop */
  132.                'extract class'         /* get class of line */
  133.                if pos("PFXEXCLUDE",class) = 0 then do
  134.                                        /* if not exclude line */
  135.                   'prev'               /* go back one */
  136.                   leave                /* get out of loop */
  137.                end
  138.             end
  139.          end
  140.       end
  141.       'extract deleting'               /* get deleting command */
  142.       'set deleting'                   /* remove it */
  143.       'block mark element'             /* mark the delete block */
  144.       'block delete'                   /* delete the block */
  145.       if headers() then                /* if there are still header lines */
  146.          'set deleting' deleting       /* restore deleting command */
  147.       exit                             /* all done */
  148.    end
  149.  
  150.    /* Show command.  This command shows one or more excluded lines.
  151.       Parameters: all | first | last - indicates which part of the excluded
  152.                                        block to show. */
  153.    when "SHOW" = cmd then do
  154.       'extract class'                  /* get class of current line */
  155.       if pos("PFXSHOW",class) == 0 then
  156.          call errormsg(3)              /* issue error if not exclude header */
  157.       call setmark                     /* set a mark on this line */
  158.       'set prefixentry'                /* clear the prefix entry text */
  159.  
  160.       if parm = "LAST" then do         /* if show last command */
  161.          do forever                    /* look for end of block */
  162.             if \nextline() then leave  /* if no more lines, leave */
  163.             'extract class'            /* get class of line */
  164.             if pos("PFXEXCLUDE",class) = 0 then do
  165.                                        /* if not part of block, leave */
  166.                'prev'
  167.                leave
  168.             end
  169.          end
  170.          dir = 'prev'                  /* set direction */
  171.       end
  172.       else do
  173.          dir = 'next'                  /* set direction */
  174.          'next'
  175.       end
  176.  
  177.       if parm = "ALL" then             /* if showing whole block */
  178.          'extract elements into count' /* set count to file size */
  179.  
  180.       do i = 1 to count                /* loop through the lines */
  181.          'extract class'               /* get class of line */
  182.          if pos("PFXEXCLUDE",class) == 0 then leave
  183.                                        /* if not an excluded line, leave */
  184.          parse var class pre "PFXEXCLUDE" post
  185.          'set class 'pre post          /* remove PFXEXCLUDE from class */
  186.          if \nextline(dir) then leave  /* if no more lines, leave */
  187.       end
  188.  
  189.       if "FIRST" = parm then do        /* if show fisrt command */
  190.          call beginchange              /* make sure changes not recorded */
  191.          'prev'                        /* back up a line */
  192.          'add'                         /* add a new exclude header */
  193.          'set class PFXSHOW'           /* set exclude header class */
  194.          'set show on'                 /* make it a show line */
  195.          call setmark                  /* mark this line */
  196.          'mark find PFXMARK1'          /* find old header */
  197.          call deleteheader             /* delete the header */
  198.          'mark find PFXMARK2'          /* find new header */
  199.          'mark clear PFXMARK2'         /* change mark name to PFXMARK1 */
  200.          markno = 0
  201.          call setmark
  202.          call endchange                /* restore recording status */
  203.       end
  204.       else                             /* not a show first */
  205.          'mark find PFXMARK1'          /* find header */
  206.  
  207.       call excludeheader               /* set exclude header text */
  208.    end
  209.  
  210.    /* Exclude command.  This command excludes one or more lines.
  211.       Parameters - [ALL | BLOCK] - indicates exclude all or block exclude */
  212.    when "EXCLUDE" = cmd then do
  213.       'extract classes'                /* Add PFXEXCLUDE and PFXSHOW classes */
  214.       if pos("PFXEXCLUDE",classes) = 0 then
  215.          'set classes 'classes' PFXSHOW PFXEXCLUDE'
  216.       'extract highlight'              /* Add PFXSHOW to highlight classes */
  217.       if pos("PFXSHOW",highlight) = 0 then
  218.          'set highlight 'highlight' PFXSHOW'
  219.       'extract exclude'                /* Add PFXEXCLUDE to exclude classes */
  220.       if pos("PFXEXCLUDE",exclude) = 0 then
  221.          'set exclude 'exclude' PFXEXCLUDE'
  222.       'extract protect'                /* Add PFXSHOW to protect classes */
  223.       if pos("PFXSHOW",protect) = 0 then
  224.          'set protect 'protect' PFXSHOW'
  225.  
  226.       'extract class'                  /* get class of current line */
  227.       if pos("PFXEXCLUDE",class) > 0 then do
  228.          'set prefixentry'             /* clear prefix entry field */
  229.          exit                          /* quit if line already hidden */
  230.       end
  231.  
  232.       call setmark                     /* set a mark */
  233.       'extract element into startline' /* get element number */
  234.  
  235.       if parm = "BLOCK" then do        /* if block exclude... */
  236.          if \nextline() |,
  237.             findprefix(substr(pe,1,2)) = "" then call errormsg(2 pe)
  238.                                        /* if block not found issue error */
  239.          'set prefixentry'             /* clear prefix entry field text */
  240.          'extract element into endline'/* get element number of end of block */
  241.          count = endline - startline + 1
  242.                                        /* calculate number of lines to exclude*/
  243.       end
  244.       else if parm = "ALL" then        /* if excluding all the lines */
  245.          'extract elements into count' /* get file size */
  246.  
  247.       call beginchange                 /* make sure changes not recorded */
  248.       'mark find PFXMARK1'             /* find first line to exclude */
  249.       'splitjoin split'                /* open a new line before it */
  250.       'set class PFXSHOW'              /* set exclude header class */
  251.       'set show on'                    /* make it a show line */
  252.       call endchange                   /* restore recording */
  253.  
  254.       'next'                           /* move to next line */
  255.       do i = 1 to count                /* loop through and exclude the lines */
  256.          'extract class'
  257.          if pos("PFXSHOW",class) > 0 then leave
  258.          'set class 'class' PFXEXCLUDE'
  259.          if \nextline() then leave
  260.       end
  261.  
  262.       call excludeheader               /* set exclude header */
  263.    end
  264.  
  265.    /* Shift command.  This command shifts one or more lines.
  266.       Parameters: right | left - indicates shift direction
  267.                   trunc | notrunc - indicates if shift should truncate line
  268.                   [block] - indicates block shift */
  269.    when "SHIFT" = cmd then do
  270.       parse var parm dir trunc type
  271.  
  272.       call setmark                     /* set a mark on this line */
  273.       'block clear'                    /* clear the current block */
  274.       'block mark element'             /* mark this line */
  275.       
  276.       if type = "BLOCK" then do        /* if block shift */
  277.          if \nextline() |,
  278.             findprefix(substr(pe,1,2)) = "" then call errormsg(2 pe)
  279.                                        /* search for end of block */
  280.          'set prefixentry'             /* clear prefix entry field text */
  281.          'block mark element'          /* mark the block */
  282.       end
  283.  
  284.       truncate = trunc \= "NOTRUNC"    /* set truncation flag */
  285.       if truncate then do              /* if truncate... */
  286.          'extract limiterror into savelimiterror'
  287.                                        /* save limiterror mode */
  288.          'set limiterror truncate'     /* set limiterror mode to truncate */
  289.          trunc = ""                    /* no option needed for turncate */
  290.       end
  291.  
  292.       'block shift 'dir count trunc' clear'
  293.                                        /* issue shift command */
  294.  
  295.       if truncate then                 /* if truncate, restore limiterror */
  296.          'set limiterror 'savelimiterror
  297.    end
  298.  
  299.    /* Duplicate command.  This command duplicates the current line one or more times
  300.       Parameters:  none */
  301.    when "DUPLICATE" = cmd then do
  302.       call setmark                     /* set a mark on this line */
  303.       'block clear'                    /* clear the current block */
  304.       'block mark element'             /* mark this line */
  305.  
  306.       if parm = "BLOCK" then do        /* if block repeat... */
  307.                                        /* look for end of block */
  308.          if \nextline() | findprefix(substr(pe,1,2)) = "" then
  309.             call errormsg(2 pe)
  310.          'set prefixentry'             /* clear prefix entry field */
  311.          'block mark element'          /* mark the block */
  312.       end
  313.  
  314.       do i = 1 to count                /* copy the line count times */
  315.          'block copy after'
  316.       end
  317.       'block clear'                    /* clear the block */
  318.    end
  319.  
  320.    /* Current command.  This command sets the current line.
  321.       Parameters:  none */
  322.    when "CURRENT" = cmd then do
  323.       call setmark                     /* set a mark on this line */
  324.  
  325.       'extract focus.top into row'     /* get top row */
  326.       'set cursorrow 'row              /* move the cursor there */
  327.       'mark find PFXMARK1'             /* make this the current line */
  328.    end
  329.  
  330.    /* Case command.  This command changes the case of the specified line
  331.       Parameters: upper | lower - indicates desired case */
  332.    when "CASE" = cmd then do
  333.       'set prefixentry'                /* clear prefix entry field */
  334.       'block clear'                    /* clear the current block */
  335.       'block mark element'             /* mark this line */
  336.       'block 'parm' clear'
  337.       exit
  338.    end
  339. end
  340.  
  341. call setmark                           /* save the current position */
  342. do i = 1 to (markno - 1)               /* loop through the marked lines */
  343.    'extract mark.PFXMARK'i' into markcol'
  344.    if markcol \= 0 then do             /* if mark not deleted */
  345.       'mark find PFXMARK'i             /* find the mark */
  346.       'set prefixentry'                /* clear the prefix entry field */
  347.    end
  348. end
  349. 'mark find PFXMARK'markno              /* restore the current position */
  350.  
  351. cleanup:
  352.  
  353. do i = 1 to markno                     /* loop through and delete marks */
  354.    'mark clear PFXMARK'i
  355. end
  356.  
  357. exit                                   /* all done */
  358.  
  359. /******************************************************************************
  360.  *                                                                            *
  361.  * function getcount(str)                                                     *
  362.  *                                                                            *
  363.  * This function returns the numeric part of a character string.  If there is *
  364.  * no numeric part, then 1 is returned.                                       *
  365.  *                                                                            *
  366.  ******************************************************************************/
  367. getcount:
  368.  
  369. procedure
  370.  
  371. arg count
  372.  
  373. do while datatype(substr(count,1,1)) \= "NUM"
  374.    if length(count) = 1 then
  375.       count = 1
  376.    else
  377.       count = substr(count,2)
  378. end
  379.  
  380. do while datatype(substr(count,length(count))) \= "NUM"
  381.    if length(count) = 1 then
  382.       count = 1
  383.    else
  384.       count = delstr(count,length(count))
  385. end
  386.  
  387. return abs(count)
  388.  
  389. /******************************************************************************
  390.  *                                                                            *
  391.  * setmark routine                                                            *
  392.  *                                                                            *
  393.  * This routine sets a mark on the current line.  It uses the global variable *
  394.  * markno to give the mark a unique name.                                     *
  395.  *                                                                            *
  396.  ******************************************************************************/
  397. setmark:
  398.  
  399. procedure expose markno
  400.  
  401. markno = markno + 1
  402. 'extract element into e'
  403. 'mark set PFXMARK'markno e '-1'
  404. return
  405.  
  406. /******************************************************************************
  407.  *                                                                            *
  408.  * function findprefix(str)                                                   *
  409.  *                                                                            *
  410.  * This function looks for a line whose prefix entry field contains text that *
  411.  * begins with str.  If str contains more than one string, then the first     *
  412.  * line that matches either is returned.  The actual prefix text is returned  *
  413.  * by this function.                                                          *
  414.  *                                                                            *
  415.  ******************************************************************************/
  416. findprefix:
  417.  
  418. procedure
  419.  
  420. arg parm
  421.  
  422. do forever
  423.    'extract prefixentry into pe'
  424.    parse upper var pe upperpe
  425.    cmds = parm
  426.    do while length(cmds) > 0
  427.       parse var cmds cmd cmds
  428.       if length(upperpe) >= length(cmd) then
  429.          if cmd = substr(upperpe,1,length(cmd)) then
  430.             return upperpe
  431.    end
  432.    'find prefixentry'
  433.    if RC \= 0 then return ""
  434. end
  435.  
  436. /******************************************************************************
  437.  *                                                                            *
  438.  * beginchange routine                                                        *
  439.  *                                                                            *
  440.  * This routine changes the recording state so that changes will not be       *
  441.  * recorded.                                                                  *
  442.  *                                                                            *
  443.  ******************************************************************************/
  444. beginchange:
  445.  
  446. procedure expose savechanges saverecording
  447.  
  448. 'extract changes into savechanges'
  449. 'extract recording into saverecording'
  450.  
  451. 'set recording off'
  452. return
  453.  
  454. /******************************************************************************
  455.  *                                                                            *
  456.  * endchange routine                                                          *
  457.  *                                                                            *
  458.  * This routine restored the recording state to that before beginchange was   *
  459.  * called.                                                                    *
  460.  *                                                                            *
  461.  ******************************************************************************/
  462. endchange:
  463.  
  464. procedure expose saverecording savechanges
  465.  
  466. 'set recording 'saverecording
  467. 'set changes 'savechanges
  468. return
  469.  
  470. /******************************************************************************
  471.  *                                                                            *
  472.  * excludeheader routine                                                      *
  473.  *                                                                            *
  474.  * This routine counts the number of excluded line is a block and sets the    *
  475.  * exclude header text appropriately.                                         *
  476.  *                                                                            *
  477.  ******************************************************************************/
  478. excludeheader:
  479.  
  480. procedure
  481.  
  482. 'mark find PFXMARK1'
  483. lines = 0
  484. do forever
  485.    if \nextline() then leave
  486.    'extract class'
  487.    if pos("PFXEXCLUDE",class) == 0 then leave
  488.    lines = lines + 1
  489. end
  490.  
  491. call beginchange
  492. 'mark find PFXMARK1'
  493. if 0 = lines then do
  494.    call deleteheader
  495.    call endchange
  496.    exit
  497. end
  498. 'extract limiterror into savelimiterror'
  499. 'set limiterror ignore'
  500. if 1 = lines then
  501.    'set content 'ispfmsg(4)
  502. else
  503.    'set content 'ispfmsg(5 lines)
  504. 'set limiterror 'savelimiterror
  505. call endchange
  506.  
  507. 'extract deleting'
  508. if deleting = "" then do
  509.    'macroload pfxdel.lx'
  510.    'set deleting pfxdel'
  511. end
  512.  
  513. return
  514.  
  515. /******************************************************************************
  516.  *                                                                            *
  517.  * deleteheader routine                                                       *
  518.  *                                                                            *
  519.  * This routine deletes the current exclude header line.                      *
  520.  *                                                                            *
  521.  ******************************************************************************/
  522. deleteheader:
  523.  
  524. procedure
  525.  
  526. 'extract deleting'
  527. 'set deleting'
  528. 'delete'
  529. if headers() then
  530.    'set deleting 'deleting
  531.  
  532. return
  533.  
  534. /******************************************************************************
  535.  *                                                                            *
  536.  * function headers()                                                         *
  537.  *                                                                            *
  538.  * This function returns TRUE if there are any headers remaining.             *
  539.  *                                                                            *
  540.  ******************************************************************************/
  541. headers:
  542.  
  543. procedure
  544.  
  545. 'extract classes'
  546. if (pos("PFXSHOW",classes) = 0) then
  547.    return 0
  548.  
  549. 'extract element into e'
  550. 'mark set PFXMARKH' e '-1'
  551. 'top'
  552. 'next class PFXSHOW'
  553. 'extract class'
  554. 'mark find PFXMARKH'
  555. 'mark clear PFXMARKH'
  556.  
  557. return (pos("PFXSHOW",class) \= 0)
  558.  
  559. /******************************************************************************
  560.  *                                                                            *
  561.  * function nextline(dir)                                                     *
  562.  *                                                                            *
  563.  * This function accepts a direction (prev or next) and move to the previous  *
  564.  * or next line.  It returns TRUE if the operation completed successfully.    *
  565.  *                                                                            *
  566.  ******************************************************************************/
  567. nextline:
  568.  
  569. procedure
  570.  
  571. arg dir parm
  572.  
  573. if dir \= "PREV" then
  574.    dir = 'next'
  575.  
  576. 'extract element into preve'
  577. dir parm
  578. 'extract element'
  579. return element \= preve
  580.  
  581. /******************************************************************************
  582.  *                                                                            *
  583.  * errormsg(msgno insert) routine                                             *
  584.  *                                                                            *
  585.  * This routine issues an error message msgno and exits.                      *
  586.  *                                                                            *
  587.  ******************************************************************************/
  588. errormsg:
  589.  
  590. arg msgno insert
  591.  
  592. 'msg 'ispfmsg(msgno insert)
  593. signal cleanup
  594.  
  595.