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