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