home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR503.W96 / DBUCOPY.PR_ / DBUCOPY.PR
Text File  |  1995-06-26  |  18KB  |  855 lines
  1. /***
  2. *
  3. *  Dbucopy.prg
  4. *
  5. *  DBU Copy and Append Module
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. */
  11.  
  12.  
  13. ******
  14. *    capprep
  15. *
  16. *    copy/append/replace
  17. *
  18. *    note: see multibox in DBUUTIL.PRG
  19. ******
  20. PROCEDURE capprep
  21.  
  22. PRIVATE filename, files, fi_disp, okee_dokee, cur_el, rel_row, def_ext, mode,;
  23.         fi_done, for_cond, while_cond, how_many, bcur, for_row, height,;
  24.         field_mvar, with_what
  25.  
  26. IF M->func_sel = 3
  27.     * replace command
  28.     help_code = 22
  29.  
  30.     * select current work area
  31.     SELECT (M->cur_area)
  32.  
  33.     * initialize variables to contain fieldname and replace expression
  34.     field_mvar = ""
  35.     with_what = ""
  36.  
  37.     * get master field list into local array for selection
  38.     DECLARE field_m[FCOUNT()]
  39.     all_fields(M->cur_area, M->field_m)
  40.  
  41.     * set up for multi-box
  42.     DECLARE boxarray[9]
  43.     boxarray[1] = "repl_title(sysparam)"
  44.     boxarray[2] = "repl_field(sysparam)"
  45.     boxarray[3] = "with_exp(sysparam)"
  46.     boxarray[4] = "for_exp(sysparam)"
  47.     boxarray[5] = "while_exp(sysparam)"
  48.     boxarray[6] = "scope_num(sysparam)"
  49.     boxarray[7] = "ok_button(sysparam)"
  50.     boxarray[8] = "can_button(sysparam)"
  51.     boxarray[9] = "fieldlist(sysparam)"
  52.  
  53.     * size and configuration
  54.     bcur = 9            && beginning cursor on field list
  55.     for_row = 6
  56.     height = 10
  57.     okee_dokee = "do_replace()"
  58.     fi_disp = "repl_field(3)"
  59.  
  60. ELSE
  61.     * initialize filename variable
  62.     filename = ""
  63.  
  64.     * only copy and append use a list of text files
  65.     DECLARE txt_list[adir("*.TXT") + 20]        && directory of text files
  66.     array_dir("*.TXT",txt_list)                    && fill array with filenames
  67.  
  68.     * set up for multi-box
  69.     DECLARE boxarray[10]
  70.  
  71.     IF M->func_sel = 1
  72.         * copy command
  73.         help_code = 12
  74.         bcur = 2            && beginning cursor on filename entry field
  75.         boxarray[1] = "copy_title(sysparam)"
  76.         boxarray[2] = "trg_getfil(sysparam)"
  77.         fi_disp = "trg_getfil(3)"
  78.         okee_dokee = "do_copy()"
  79.  
  80.     ELSE
  81.         * append command
  82.         help_code = 15
  83.         bcur = 10            && beginning cursor on selection list
  84.         boxarray[1] = "appe_title(sysparam)"
  85.         boxarray[2] = "src_getfil(sysparam)"
  86.         fi_disp = "src_getfil(3)"
  87.         okee_dokee = "do_append()"
  88.  
  89.     ENDIF
  90.  
  91.     * remainder of setup common to copy and append
  92.     boxarray[3] = "for_exp(sysparam)"
  93.     boxarray[4] = "while_exp(sysparam)"
  94.     boxarray[5] = "scope_num(sysparam)"
  95.     boxarray[6] = "tog_sdf(sysparam)"
  96.     boxarray[7] = "ok_button(sysparam)"
  97.     boxarray[8] = "tog_delim(sysparam)"
  98.     boxarray[9] = "can_button(sysparam)"
  99.     boxarray[10] = "filelist(sysparam)"
  100.  
  101.     * size and configuration
  102.     for_row = 5
  103.     height = 11
  104.  
  105.     * DBF for normal mode
  106.     files = "dbf_list"
  107.     def_ext = ".DBF"
  108.  
  109.     * when is a filename acceptable?
  110.     fi_done = "not_empty('filename')"
  111.  
  112. ENDIF
  113.  
  114. * initialize local variables
  115. STORE "" TO for_cond, while_cond
  116.  
  117. * normal mode, scope = ALL, top of selection list
  118. STORE 1 TO mode,cur_el
  119. rel_row = 0
  120. how_many = 0
  121.  
  122. * do it with the all-purpose switchbox
  123. multibox(8, 17, M->height, M->bcur, M->boxarray)
  124. RETURN
  125.  
  126.  
  127. ******************************
  128. * functions specific to COPY *
  129. ******************************
  130.  
  131. ******
  132. *    copy_title()
  133. *
  134. *    display title for "copy"
  135. ******
  136. FUNCTION copy_title
  137.  
  138. PARAMETERS sysparam
  139.  
  140. RETURN box_title(M->sysparam, "Copy " +;
  141.                               SUBSTR(M->cur_dbf, RAT("\", M->cur_dbf) + 1) +;
  142.                               " to...")
  143.  
  144.  
  145. ******
  146. *    trg_getfil()
  147. *
  148. *    get target filename for "copy"
  149. ******
  150. FUNCTION trg_getfil
  151.  
  152. PARAMETERS sysparam
  153.  
  154. help_code = M->prime_help
  155. RETURN getfile(M->sysparam, 3)
  156.  
  157.  
  158. ******
  159. *    do_copy()
  160. *
  161. *    do the copy command
  162. *
  163. *    note: this function is called when <enter> is pressed
  164. *          while the cursor is on the "Ok" button
  165. ******
  166. FUNCTION do_copy
  167.  
  168. PRIVATE done, add_name, new_el
  169.  
  170. * assume incomplete
  171. done = .F.
  172.  
  173. DO CASE
  174.  
  175.     CASE EMPTY(M->filename)
  176.         error_msg("Target not selected")
  177.  
  178.     CASE M->filename == M->cur_dbf
  179.         error_msg("File cannot be coppied onto itself")
  180.  
  181.     CASE .NOT. EMPTY(M->for_cond) .AND. TYPE(M->for_cond) <> "L"
  182.         error_msg("FOR condition must be a Logical expression")
  183.  
  184.     CASE .NOT. EMPTY(M->while_cond) .AND. TYPE(M->while_cond) <> "L"
  185.         error_msg("WHILE condition must be a Logical expression")
  186.  
  187.     OTHERWISE
  188.         * ok to copy file
  189.  
  190.         IF FILE(M->filename)
  191.  
  192.             IF rsvp("Target File " + IF(aseek(M->dbf, M->filename) > 0,;
  193.                     "Is Open", "Exists") + "...Overwrite? (Y/N)") <> "Y"
  194.                 RETURN .F.
  195.  
  196.             ENDIF
  197.         ENDIF
  198.  
  199.         stat_msg("Copying")
  200.  
  201.         IF aseek(M->dbf, M->filename) > 0
  202.             * copying to an open file...good luck!
  203.             SELECT (aseek(M->dbf, M->filename))
  204.             USE
  205.             STORE .T. TO need_field,need_ntx,need_relat,need_filtr
  206.  
  207.         ENDIF
  208.  
  209.         SELECT (M->cur_area)
  210.  
  211.         IF RAT(M->def_ext, M->filename) = LEN(M->filename) - 3
  212.             * target has default extension..does it exists in current dir?
  213.             add_name = .NOT. FILE(name(M->filename) + M->def_ext)
  214.  
  215.         ELSE
  216.             add_name = .F.
  217.  
  218.         ENDIF
  219.  
  220.         IF EMPTY(M->for_cond)
  221.             * literal true is the same as no FOR condition
  222.             for_cond = ".T."
  223.  
  224.         ENDIF
  225.  
  226.         IF EMPTY(M->while_cond)
  227.             * literal true is correct only from top of file
  228.             while_cond = ".T."
  229.  
  230.             IF M->how_many = 0
  231.                 * unless a scope has been entered
  232.                 GO TOP
  233.  
  234.             ENDIF
  235.         ENDIF
  236.  
  237.         DO CASE
  238.  
  239.             CASE M->mode = 1 .AND. M->how_many = 0
  240.                 COPY TO &filename WHILE &while_cond FOR &for_cond
  241.  
  242.             CASE M->mode = 1 .AND. M->how_many > 0
  243.                 COPY TO &filename NEXT M->how_many WHILE &while_cond;
  244.                         FOR &for_cond
  245.  
  246.             CASE M->mode = 2 .AND. M->how_many = 0
  247.                 COPY TO &filename WHILE &while_cond FOR &for_cond;
  248.                         SDF
  249.  
  250.             CASE M->mode = 2 .AND. M->how_many > 0
  251.                 COPY TO &filename NEXT M->how_many WHILE &while_cond;
  252.                         FOR &for_cond SDF
  253.  
  254.             CASE M->mode = 3 .AND. M->how_many = 0
  255.                 COPY TO &filename WHILE &while_cond FOR &for_cond;
  256.                         DELIMITED
  257.  
  258.             CASE M->mode = 3 .AND. M->how_many > 0
  259.                 COPY TO &filename NEXT M->how_many WHILE &while_cond;
  260.                         FOR &for_cond DELIMITED
  261.  
  262.         ENDCASE
  263.  
  264.         IF aseek(M->dbf, M->filename) > 0
  265.             * copying to an open file...good luck again!
  266.             SELECT (aseek(M->dbf, M->filename))
  267.             USE &filename
  268.  
  269.         ENDIF
  270.  
  271.         IF FILE(name(M->filename) + M->def_ext) .AND. M->add_name
  272.             * add only .dbf files in the current directory
  273.             new_el = afull(&files) + 1
  274.  
  275.             IF M->new_el <= LEN(&files)
  276.                 &files[M->new_el] = M->filename
  277.                 array_sort(&files)
  278.  
  279.             ENDIF
  280.         ENDIF
  281.  
  282.         stat_msg("File copied")
  283.         done = .T.
  284.  
  285. ENDCASE
  286.  
  287. RETURN M->done
  288.  
  289.  
  290. ********************************
  291. * functions specific to APPEND *
  292. ********************************
  293.  
  294. ******
  295. *    appe_title()
  296. *
  297. *    display title for "append"
  298. ******
  299. FUNCTION appe_title
  300.  
  301. PARAMETERS sysparam
  302.  
  303. RETURN box_title(M->sysparam, "Append to " +;
  304.                               SUBSTR(M->cur_dbf, RAT("\", M->cur_dbf) + 1) +;
  305.                               " from")
  306.  
  307.  
  308. ******
  309. *    src_getfil()
  310. *
  311. *    get source filename for "append"
  312. ******
  313. FUNCTION src_getfil
  314.  
  315. PARAMETERS sysparam
  316.  
  317. help_code = M->prime_help
  318. RETURN getfile(M->sysparam, 3)
  319.  
  320.  
  321. ******
  322. *    do_append()
  323. *
  324. *    do the append command
  325. *
  326. *    note: this function is called when <enter> is pressed
  327. *          while the cursor is on the "Ok" button
  328. ******
  329. FUNCTION do_append
  330.  
  331. PRIVATE done
  332.  
  333. * assume incomplete
  334. done = .F.
  335.  
  336. DO CASE
  337.  
  338.     CASE EMPTY(M->filename)
  339.         error_msg("Source not selected")
  340.  
  341.     CASE M->filename == M->cur_dbf
  342.         error_msg("File cannot be appended from itself")
  343.  
  344.     CASE .NOT. FILE(M->filename)
  345.         error_msg("Can't open " + M->filename)
  346.  
  347.     CASE .NOT. EMPTY(M->for_cond) .AND. TYPE(M->for_cond) <> "L"
  348.         error_msg("FOR condition must be a Logical expression")
  349.  
  350.     CASE .NOT. EMPTY(M->while_cond) .AND. TYPE(M->while_cond) <> "L"
  351.         error_msg("WHILE condition must be a Logical expression")
  352.  
  353.     OTHERWISE
  354.         * ok to append
  355.  
  356.         IF aseek(M->dbf, M->filename) > 0
  357.             * appending from an open file
  358.             SELECT (aseek(M->dbf, M->filename))
  359.             USE
  360.             STORE .T. TO need_field,need_ntx,need_relat,need_filtr
  361.  
  362.         ENDIF
  363.  
  364.         stat_msg("Appending")
  365.         SELECT (M->cur_area)
  366.  
  367.         IF EMPTY(M->for_cond)
  368.             * literal true is the same as no FOR condition
  369.             for_cond = ".T."
  370.  
  371.         ENDIF
  372.  
  373.         IF EMPTY(M->while_cond)
  374.             * literal true is the same as no WHILE condition
  375.             while_cond = ".T."
  376.  
  377.         ENDIF
  378.  
  379.         DO CASE
  380.  
  381.             CASE M->mode = 1 .AND. M->how_many = 0
  382.                 APPEND FROM &filename WHILE &while_cond FOR;
  383.                             &for_cond
  384.  
  385.             CASE M->mode = 1 .AND. M->how_many > 0
  386.                 APPEND FROM &filename NEXT M->how_many WHILE;
  387.                             &while_cond FOR &for_cond
  388.  
  389.             CASE M->mode = 2 .AND. M->how_many = 0
  390.                 APPEND FROM &filename WHILE &while_cond FOR;
  391.                             &for_cond SDF
  392.  
  393.             CASE M->mode = 2 .AND. M->how_many > 0
  394.                 APPEND FROM &filename NEXT M->how_many WHILE;
  395.                             &while_cond FOR &for_cond SDF
  396.  
  397.             CASE M->mode = 3 .AND. M->how_many = 0
  398.                 APPEND FROM &filename WHILE &while_cond FOR;
  399.                             &for_cond DELIMITED
  400.  
  401.             CASE M->mode = 3 .AND. M->how_many > 0
  402.                 APPEND FROM &filename NEXT M->how_many WHILE;
  403.                             &while_cond FOR &for_cond DELIMITED
  404.  
  405.         ENDCASE
  406.  
  407.         IF aseek(M->dbf, M->filename) > 0
  408.             * appending from an open file
  409.             SELECT (aseek(M->dbf, M->filename))
  410.             USE &filename
  411.  
  412.         ENDIF
  413.  
  414.         stat_msg("Append completed")
  415.         done = .T.
  416.  
  417. ENDCASE
  418.  
  419. RETURN M->done
  420.  
  421.  
  422. *********************************
  423. * functions specific to REPLACE *
  424. *********************************
  425.  
  426. ******
  427. *    repl_title()
  428. *
  429. *    display title for "replace"
  430. ******
  431. FUNCTION repl_title
  432.  
  433. PARAMETERS sysparam
  434.  
  435. RETURN box_title(M->sysparam, "Replace in " +;
  436.                               SUBSTR(M->cur_dbf, RAT("\", M->cur_dbf) + 1) +;
  437.                               "...")
  438.  
  439.  
  440. ******
  441. *    repl_field()
  442. *
  443. *    get fieldname for replace (only one field can be replaced at a time)
  444. ******
  445. FUNCTION repl_field
  446.  
  447. PARAMETERS sysparam
  448.  
  449. help_code = M->prime_help
  450. RETURN genfield(M->sysparam, .T.)
  451.  
  452.  
  453. ******
  454. *    with_exp()
  455. *
  456. *    get "with" expression for replace
  457. ******
  458. FUNCTION with_exp
  459.  
  460. PARAMETERS sysparam
  461. PRIVATE rval
  462.  
  463. help_code = M->prime_help
  464. rval = get_exp(M->sysparam, "WITH   ", 4, "with_what")
  465.  
  466. IF M->sysparam = 4 .AND. LASTKEY() = 13 .AND. .NOT. EMPTY(M->with_what)
  467.     * expression just entered..dehilite and jump to 'Ok'
  468.     get_exp(3, "WITH   ", 4, "with_what")
  469.     to_ok()
  470.  
  471. ENDIF
  472.  
  473. RETURN M->rval
  474.  
  475.  
  476. ******
  477. *    do_replace()
  478. *
  479. *    do the replace command
  480. *
  481. *    note: this function is called when <enter> is pressed
  482. *          while the cursor is on the "Ok" button
  483. ******
  484. FUNCTION do_replace
  485.  
  486. PRIVATE done
  487.  
  488. * assume incomplete
  489. done = .F.
  490.  
  491. DO CASE
  492.  
  493.     CASE EMPTY(M->field_mvar)
  494.         error_msg("Field not selected")
  495.  
  496.     CASE EMPTY(M->with_what)
  497.         error_msg("Replace expression not entered")
  498.  
  499.     CASE TYPE(M->with_what) <> TYPE(M->field_mvar) .and. ;
  500.         !(TYPE(M->field_mvar) == "M") .and. ;
  501.         !(TYPE(M->with_what) == "UI")
  502.         error_msg("Type mismatch between replace expression and field")
  503.  
  504.     CASE .NOT. EMPTY(M->for_cond) .AND. TYPE(M->for_cond) <> "L"
  505.         error_msg("FOR condition must be a Logical expression")
  506.  
  507.     CASE .NOT. EMPTY(M->while_cond) .AND. TYPE(M->while_cond) <> "L"
  508.         error_msg("WHILE condition must be a Logical expression")
  509.  
  510.     OTHERWISE
  511.         * ok to replace
  512.         stat_msg("Replacing data")
  513.  
  514.         IF EMPTY(M->for_cond)
  515.             * literal true is the same as no FOR condition
  516.             for_cond = ".T."
  517.  
  518.         ENDIF
  519.  
  520.         IF EMPTY(M->while_cond)
  521.             * literal true is the same as no WHILE condition
  522.             while_cond = ".T."
  523.  
  524.             IF M->how_many = 0
  525.                 * unless a scope has been entered
  526.                 GO TOP
  527.  
  528.             ENDIF
  529.         ENDIF
  530.  
  531.        IF !FLOCK()
  532.            stat_msg("                 ")
  533.            error_msg("Record update failed")
  534.            done := .F.
  535.        ELSE
  536.  
  537.            IF M->how_many = 0
  538.                 REPLACE &field_mvar WITH &with_what;
  539.                        WHILE &while_cond FOR &for_cond
  540.  
  541.            ELSE
  542.                 REPLACE NEXT M->how_many &field_mvar WITH &with_what;
  543.                        WHILE &while_cond FOR &for_cond
  544.  
  545.            ENDIF
  546.            stat_msg("Replace completed")
  547.             done = .T.
  548.       ENDIF
  549.       UNLOCK
  550.  
  551. ENDCASE
  552.  
  553. RETURN M->done
  554.  
  555.  
  556. *************************************************
  557. * functions common to COPY, APPEND, and REPLACE *
  558. *************************************************
  559.  
  560. ******
  561. *    for_exp()
  562. *
  563. *    get "for" expression
  564. ******
  565. FUNCTION for_exp
  566.  
  567. PARAMETERS sysparam
  568.  
  569. help_code = 16
  570. RETURN get_exp(M->sysparam, "FOR    ", M->for_row, "for_cond")
  571.  
  572.  
  573. ******
  574. *    while_exp()
  575. *
  576. *    get "while" expression
  577. ******
  578. FUNCTION while_exp
  579.  
  580. PARAMETERS sysparam
  581.  
  582. help_code = 16
  583. RETURN get_exp(M->sysparam, "WHILE  ", M->for_row + 1, "while_cond")
  584.  
  585.  
  586. ******
  587. *    scope_num()
  588. *
  589. *    get scope
  590. ******
  591. FUNCTION scope_num
  592.  
  593. PARAMETERS sysparam
  594. local saveColor
  595. PRIVATE old_scope
  596.  
  597. help_code = 17
  598. saveColor := SetColor(M->colorNorm)
  599.  
  600. DO CASE
  601.  
  602.     CASE M->sysparam = 1 .OR. M->sysparam = 3
  603.         * normal display
  604.         @ M->wt + M->for_row + 2, M->wl + 2;
  605.         SAY "SCOPE  " + pad(IF(M->how_many = 0, "ALL",;
  606.                             "NEXT " + LTRIM(STR(M->how_many))), 20)
  607.  
  608.         IF M->sysparam = 1
  609.             * report position
  610.             @ M->wt + M->for_row + 2, M->wl + 9 SAY ""
  611.  
  612.         ENDIF
  613.  
  614.     CASE M->sysparam = 2
  615.         * hi-lite
  616.         SetColor(M->colorHilite)
  617.         @ M->wt + M->for_row + 2, M->wl + 9;
  618.         SAY pad(IF(M->how_many = 0,;
  619.                    "ALL", "NEXT " + LTRIM(STR(M->how_many))), 20)
  620.  
  621.     CASE M->sysparam = 4
  622.         * selected
  623.  
  624.         IF CHR(M->keystroke) $ "0123456789" + CHR(13)
  625.             * numeric digit or <enter>
  626.  
  627.             IF M->keystroke <> 13
  628.                 * include initial digit in entry
  629.                 KEYBOARD CHR(M->keystroke)
  630.  
  631.             ENDIF
  632.  
  633.             old_scope = M->how_many        && in case of abort
  634.  
  635.             * set certain keys to exit the READ
  636.             SET KEY 5 TO clear_gets
  637.             SET KEY 24 TO clear_gets
  638.             xkey_clear()
  639.  
  640.             * image is important
  641.             SetColor(M->colorHilite)
  642.             @ M->wt + M->for_row + 2, M->wl + 9 SAY pad("NEXT",20)
  643.  
  644.             SetColor(M->colorNorm)
  645.             @ M->wt + M->for_row + 2, M->wl + 14;
  646.             GET M->how_many PICTURE "99999999"
  647.  
  648.             SET CURSOR ON
  649.             READ
  650.             SET CURSOR OFF
  651.  
  652.             * remember the exit key
  653.             keystroke = LASTKEY()
  654.  
  655.             * restore keys to normal
  656.             SET KEY 5 TO
  657.             SET KEY 24 TO
  658.             xkey_norm()
  659.  
  660.             IF M->keystroke = 13
  661.                 * jump to "Ok" button
  662.                 to_ok()
  663.                 @ M->wt + M->for_row + 2, M->wl + 9;
  664.                 SAY pad(IF(M->how_many = 0, "ALL", "NEXT " +;
  665.                         LTRIM(STR(M->how_many))), 20)
  666.  
  667.             ELSE
  668.  
  669.                 IF menu_key() <> 0
  670.                     * menu request
  671.                     how_many = M->old_scope
  672.  
  673.                 ENDIF
  674.  
  675.                 IF M->keystroke <> 27 .AND. .NOT. isdata(M->keystroke)
  676.                     * forward the request
  677.                     KEYBOARD CHR(M->keystroke)
  678.  
  679.                 ENDIF
  680.             ENDIF
  681.  
  682.         ELSE
  683.             * character key..scope = 0 = ALL
  684.             how_many = 0
  685.  
  686.         ENDIF
  687. ENDCASE
  688.  
  689. SetColor(saveColor)
  690. RETURN 2
  691.  
  692.  
  693. ***************************************
  694. * functions common to COPY and APPEND *
  695. ***************************************
  696.  
  697. ******
  698. *    tog_sdf()
  699. *
  700. *    toggle sdf mode
  701. ******
  702. FUNCTION tog_sdf
  703.  
  704. PARAMETERS sysparam
  705. local saveColor
  706.  
  707. help_code = 11
  708. saveColor := SetColor(M->colorNorm)
  709.  
  710. DO CASE
  711.  
  712.     CASE M->sysparam = 1 .OR. M->sysparam = 3
  713.         * normal display
  714.         @ M->wt + 9, M->wl + 8 SAY " SDF "
  715.  
  716.         IF M->mode = 2
  717.             * SDF is current mode
  718.             @ M->wt + 8, M->wl + 7, M->wt + 10, M->wl + 13 BOX sframe
  719.  
  720.         ENDIF
  721.  
  722.         IF M->sysparam = 1
  723.             * report position
  724.             @ M->wt + 9, M->wl + 9 SAY ""
  725.  
  726.         ENDIF
  727.  
  728.     CASE M->sysparam = 2
  729.         * hi-lite
  730.         SetColor(M->colorHilite)
  731.         @ M->wt + 9, M->wl + 8 SAY " SDF "
  732.  
  733.     CASE M->sysparam = 4 .AND. M->keystroke = 13
  734.         * selected..no character keys accepted here
  735.  
  736.         IF M->mode = 2
  737.             * SDF...toggle off
  738.             @ M->wt + 8, M->wl + 7, M->wt + 10, M->wl + 13 BOX "        "
  739.             mode = 1
  740.  
  741.             * change from .TXT to .DBF
  742.             cur_el = 1
  743.             rel_row = 0
  744.             files = "dbf_list"
  745.             def_ext = ".DBF"
  746.             filelist(1)            && display new list
  747.  
  748.         ELSE
  749.             * toggle SDF on
  750.  
  751.             IF M->mode = 3
  752.                 * toggle DELIMITED off
  753.                 @ M->wt + 8, M->wl + 16, M->wt + 10, M->wl + 28 BOX "        "
  754.  
  755.             ELSE
  756.                 * normal mode..change from .DBF to .TXT
  757.                 cur_el = 1
  758.                 rel_row = 0
  759.                 files = "txt_list"
  760.                 def_ext = ".TXT"
  761.                 filelist(1)        && display new list
  762.  
  763.             ENDIF
  764.  
  765.             * indicate SDF on
  766.             @ M->wt + 8, M->wl + 7, M->wt + 10, M->wl + 13 BOX sframe
  767.             mode = 2
  768.  
  769.         ENDIF
  770. ENDCASE
  771.  
  772. SetColor(saveColor)
  773. RETURN 2
  774.  
  775.  
  776. ******
  777. *    tog_delim
  778. *
  779. *    toggle delimited mode
  780. ******
  781. FUNCTION tog_delim
  782.  
  783. PARAMETERS sysparam
  784. local saveColor
  785.  
  786. help_code = 11
  787. saveColor := SetColor(M->colorNorm)
  788. DO CASE
  789.  
  790.     CASE M->sysparam = 1 .OR. M->sysparam = 3
  791.         * normal display
  792.         @ M->wt + 9, M->wl + 17 SAY " DELIMITED "
  793.  
  794.         IF M->mode = 3
  795.             * DELIMITED is current mode
  796.             @ M->wt + 8, M->wl + 16, M->wt + 10, M->wl + 28 BOX sframe
  797.  
  798.         ENDIF
  799.  
  800.         IF M->sysparam = 1
  801.             * report position
  802.             @ M->wt + 9, M->wl + 17 SAY ""
  803.  
  804.         ENDIF
  805.  
  806.     CASE M->sysparam = 2
  807.         * hi-lite
  808.         SetColor(M->colorHilite)
  809.         @ M->wt + 9, M->wl + 17 SAY " DELIMITED "
  810.  
  811.     CASE M->sysparam = 4 .AND. M->keystroke = 13
  812.         * selected..no character keys accepted here
  813.  
  814.         IF M->mode = 3
  815.             * DELIMITED...toggle off
  816.             @ M->wt + 8, M->wl + 16, M->wt + 10, M->wl + 28 BOX "        "
  817.             mode = 1
  818.  
  819.             * change from .TXT to .DBF
  820.             cur_el = 1
  821.             rel_row = 0
  822.             files = "dbf_list"
  823.             def_ext = ".DBF"
  824.             filelist(1)            && display new list
  825.  
  826.         ELSE
  827.             * toggle DELIMITED on
  828.  
  829.             IF M->mode = 2
  830.                 * toggle SDF off
  831.                 @ M->wt + 8, M->wl + 7, M->wt + 10, M->wl + 13 BOX "        "
  832.  
  833.             ELSE
  834.                 * normal mode..change from .DBF to .TXT
  835.                 cur_el = 1
  836.                 rel_row = 0
  837.                 files = "txt_list"
  838.                 def_ext = ".TXT"
  839.                 filelist(1)        && display new list
  840.  
  841.             ENDIF
  842.  
  843.             * indicate DELIMITED on
  844.             @ M->wt + 8, M->wl + 16, M->wt + 10, M->wl + 28 BOX sframe
  845.             mode = 3
  846.  
  847.         ENDIF
  848. ENDCASE
  849.  
  850. SetColor(saveColor)
  851. RETURN 2
  852.  
  853.  
  854. * EOF DBUCOPY.PRG
  855.