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