home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / viscobv7.zip / vac22os2 / ibmcobol / macros / xeditcmd.lx < prev    next >
Text File  |  1998-02-24  |  25KB  |  556 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.       'set focus.next 1'               /* set to top row */
  301.       'mark find PFXMARK1'             /* make this the current line */
  302.    end
  303. end
  304.  
  305. call setmark                           /* save the current position */
  306. do i = 1 to (markno - 1)               /* loop through the marked lines */
  307.    'mark find PFXMARK'i                /* find the mark */
  308.    'set prefixentry'                   /* clear the prefix entry field */
  309. end
  310. 'mark find PFXMARK'markno              /* restore the current position */
  311.  
  312. cleanup:
  313.  
  314. do i = 1 to markno                     /* loop through and delete marks */
  315.    'mark clear PFXMARK'i
  316. end
  317.  
  318. exit                                   /* all done */
  319.  
  320. /******************************************************************************
  321.  *                                                                            *
  322.  * function getcount(str)                                                     *
  323.  *                                                                            *
  324.  * This function returns the numeric part of a character string.  If there is *
  325.  * no numeric part, then 1 is returned.                                       *
  326.  *                                                                            *
  327.  ******************************************************************************/
  328. getcount:
  329.  
  330. procedure
  331.  
  332. arg count
  333.  
  334. do while datatype(substr(count,1,1)) \= "NUM"
  335.    if length(count) = 1 then
  336.       count = 1
  337.    else
  338.       count = substr(count,2)
  339. end
  340.  
  341. do while datatype(substr(count,length(count))) \= "NUM"
  342.    if length(count) = 1 then
  343.       count = 1
  344.    else
  345.       count = delstr(count,length(count))
  346. end
  347.  
  348. return abs(count)
  349.  
  350. /******************************************************************************
  351.  *                                                                            *
  352.  * setmark routine                                                            *
  353.  *                                                                            *
  354.  * This routine sets a mark on the current line.  It uses the global variable *
  355.  * markno to give the mark a unique name.                                     *
  356.  *                                                                            *
  357.  ******************************************************************************/
  358. setmark:
  359.  
  360. procedure expose markno
  361.  
  362. markno = markno + 1
  363. 'extract element into e'
  364. 'mark set PFXMARK'markno e '-1'
  365. return
  366.  
  367. /******************************************************************************
  368.  *                                                                            *
  369.  * function findprefix(str)                                                   *
  370.  *                                                                            *
  371.  * This function looks for a line whose prefix entry field contains text that *
  372.  * begins with str.  If str contains more than one string, then the first     *
  373.  * line that matches either is returned.  The actual prefix text is returned  *
  374.  * by this function.                                                          *
  375.  *                                                                            *
  376.  ******************************************************************************/
  377. findprefix:
  378.  
  379. procedure
  380.  
  381. arg parm
  382.  
  383. do forever
  384.    'extract prefixentry into pe'
  385.    parse upper var pe upperpe
  386.    cmds = parm
  387.    do while length(cmds) > 0
  388.       parse var cmds cmd cmds
  389.       if length(upperpe) >= length(cmd) then
  390.          if cmd = substr(upperpe,1,length(cmd)) then
  391.             return upperpe
  392.    end
  393.    'find prefixentry'
  394.    if RC \= 0 then return ""
  395. end
  396.  
  397. /******************************************************************************
  398.  *                                                                            *
  399.  * beginchange routine                                                        *
  400.  *                                                                            *
  401.  * This routine changes the recording state so that changes will not be       *
  402.  * recorded.                                                                  *
  403.  *                                                                            *
  404.  ******************************************************************************/
  405. beginchange:
  406.  
  407. procedure expose savechanges saverecording
  408.  
  409. 'extract changes into savechanges'
  410. 'extract recording into saverecording'
  411.  
  412. 'set recording off'
  413. return
  414.  
  415. /******************************************************************************
  416.  *                                                                            *
  417.  * endchange routine                                                          *
  418.  *                                                                            *
  419.  * This routine restored the recording state to that before beginchange was   *
  420.  * called.                                                                    *
  421.  *                                                                            *
  422.  ******************************************************************************/
  423. endchange:
  424.  
  425. procedure expose saverecording savechanges
  426.  
  427. 'set recording 'saverecording
  428. 'set changes 'savechanges
  429. return
  430.  
  431. /******************************************************************************
  432.  *                                                                            *
  433.  * excludeheader routine                                                      *
  434.  *                                                                            *
  435.  * This routine counts the number of excluded line is a block and sets the    *
  436.  * exclude header text appropriately.                                         *
  437.  *                                                                            *
  438.  ******************************************************************************/
  439. excludeheader:
  440.  
  441. procedure
  442.  
  443. 'mark find PFXMARK1'
  444. lines = 0
  445. do forever
  446.    if \nextline() then leave
  447.    'extract class'
  448.    if pos("PFXEXCLUDE",class) == 0 then leave
  449.    lines = lines + 1
  450. end
  451.  
  452. call beginchange
  453. 'mark find PFXMARK1'
  454. if 0 = lines then do
  455.    call deleteheader
  456.    call endchange
  457.    exit
  458. end
  459. 'extract limiterror into savelimiterror'
  460. 'set limiterror ignore'
  461. if 1 = lines then
  462.    'set content 'xeditmsg(4)
  463. else
  464.    'set content 'xeditmsg(5 lines)
  465. 'set limiterror 'savelimiterror
  466. call endchange
  467.  
  468. 'extract deleting'
  469. if deleting = "" then do
  470.    'macroload pfxdel.lx'
  471.    'set deleting pfxdel'
  472. end
  473.  
  474. return
  475.  
  476. /******************************************************************************
  477.  *                                                                            *
  478.  * deleteheader routine                                                       *
  479.  *                                                                            *
  480.  * This routine deletes the current exclude header line.                      *
  481.  *                                                                            *
  482.  ******************************************************************************/
  483. deleteheader:
  484.  
  485. procedure
  486.  
  487. 'extract deleting'
  488. 'set deleting'
  489. 'delete'
  490. if headers() then
  491.    'set deleting 'deleting
  492.  
  493. return
  494.  
  495. /******************************************************************************
  496.  *                                                                            *
  497.  * function headers()                                                         *
  498.  *                                                                            *
  499.  * This function returns TRUE if there are any headers remaining.             *
  500.  *                                                                            *
  501.  ******************************************************************************/
  502. headers:
  503.  
  504. procedure
  505.  
  506. 'extract classes'
  507. if (pos("PFXSHOW",classes) = 0) then
  508.    return 0
  509.  
  510. 'extract element into e'
  511. 'mark set PFXMARKH' e '-1'
  512. 'top'
  513. 'next class PFXSHOW'
  514. 'extract class'
  515. 'mark find PFXMARKH'
  516. 'mark clear PFXMARKH'
  517.  
  518. return (pos("PFXSHOW",class) \= 0)
  519.  
  520. /******************************************************************************
  521.  *                                                                            *
  522.  * function nextline(dir)                                                     *
  523.  *                                                                            *
  524.  * This function accepts a direction (prev or next) and move to the previous  *
  525.  * or next line.  It returns TRUE if the operation completed successfully.    *
  526.  *                                                                            *
  527.  ******************************************************************************/
  528. nextline:
  529.  
  530. procedure
  531.  
  532. arg dir parm
  533.  
  534. if dir \= "PREV" then
  535.    dir = 'next'
  536.  
  537. 'extract element into preve'
  538. dir parm
  539. 'extract element'
  540. return element \= preve
  541.  
  542. /******************************************************************************
  543.  *                                                                            *
  544.  * errormsg(msgno insert) routine                                             *
  545.  *                                                                            *
  546.  * This routine issues an error message msgno and exits.                      *
  547.  *                                                                            *
  548.  ******************************************************************************/
  549. errormsg:
  550.  
  551. arg msgno insert
  552.  
  553. 'msg 'xeditmsg(msgno insert)
  554. signal cleanup
  555.  
  556.