home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR503.W96 / DBU.PR_ / DBU.PR
Text File  |  1995-06-26  |  22KB  |  813 lines
  1. /***
  2. *
  3. *  Dbu.prg
  4. *
  5. *  DBU Main Module
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. */
  11.  
  12. PROCEDURE Dbu( param1, param2, param3 )
  13.  
  14.    PUBLIC n_files,keystroke,lkey,frame,sframe,cur_dir,more_up,more_down,;
  15.    kf1,kf2,kf3,kf4,kf5,kf6,need_field,need_ntx,need_relat,need_filtr,;
  16.    help_code,view_err,cur_area,cur_dbf,cur_ntx,cur_fields,error_on,;
  17.    exit_str,page,sysfunc,func_sel,cur_func,local_func,local_sel,box_open,;
  18.    color1,color2,color3,color4,color5,color6,color7,color8,color9,;
  19.    color10,color11,color12,com_line,curs_on,helpfile
  20.  
  21.  
  22.    ******
  23.    *  The parameters are optional and have the following meaning:
  24.    *
  25.    *  - filename (.VEW or .DBF) to Browse
  26.    *
  27.    *  - color directive where:
  28.    *     /C = use color even if monochrome
  29.    *     /M = monochrome (don't use color)
  30.    *
  31.    *  - file opening mode (for network support)
  32.    *     /E = exclusive use of files
  33.    *
  34.    *  Parameters may be specified in any order
  35.    ******
  36.  
  37.    * avoid a type mismatch & convert to uppercase
  38.    IF VALTYPE( param1 ) != "C"
  39.       param1 = ""
  40.    ENDIF
  41.  
  42.    IF VALTYPE( param2 ) != "C"
  43.       param2 = ""
  44.    ENDIF
  45.  
  46.    IF VALTYPE( param3 ) != "C"
  47.       param3 := ""
  48.    ENDIF
  49.  
  50.    // Combine all the command line params together
  51.    param1 := UPPER( param1 + "~" + param2 + "~" + param3 + "~" )
  52.  
  53.    // Process the command line parameters where com_line will contain the
  54.    // view/file name to open and param2 will contain the color directive
  55.    param3 := ParseCommLine( param1 )
  56.    com_line := param3[1]
  57.    param2   := param3[2]
  58.  
  59.    SET CURSOR OFF                                && cursors are for gets
  60.    SAVE SCREEN                                   && the screen you save...
  61.    SET SCOREBOARD OFF                            && who's keeping score, anyhow
  62.    SET KEY 28 TO                                 && some folks need help
  63.  
  64.    IF (ISCOLOR() .OR. "/C" $ UPPER(param2)) .AND. .NOT. "/M" $ UPPER(param2)
  65.       * make it pretty
  66.       color1 = "W+/B,N/W,B"                      && normal
  67.       color2 = "B/W"                             && item hilite
  68.       color3 = "W+/R"                            && error or high intensity
  69.       color4 = "W+/B,B/W,,,W+/B"                 && achoice/list array..unselected is norm
  70.       color5 = "B/BG,B/W,,,W/BG"                 && achoice/sysmenu..true unselected
  71.       color6 = "W+/BG"                           && menu frame
  72.       color7 = "B/BG,B/W"                        && browse, modify structure, set relation
  73.       color8 = "B/W,B/BG,,,B/W"                  && memos, dialogue
  74.       color9 = "W+/B,N/BG"                       && memo titles
  75.       color10 = "B/BG"                           && dialogue box hilite
  76.       color11 = "W+/BG"                          && menu title hilite
  77.       color12 = "W+/B"                           && set relation hilite
  78.  
  79.    ELSE
  80.       * monochrome
  81.       color1 = "W/N,N/W"
  82.       color2 = "N/W"
  83.       color3 = "W+/N"
  84.       color4 = "W/N,N/W,,,W/N"
  85.       color5 = "W+/N,N/W,,,W/N"
  86.       color6 = "W/N"
  87.       color7 = "W/N,N/W"
  88.       color8 = "W/N,N/W,,,W/N"
  89.       color9 = "N/W,N/W"
  90.       color10 = "N/W"
  91.       color11 = "N/W"
  92.       color12 = "W+/N"
  93.  
  94.    ENDIF
  95.  
  96.    * let's get this baby off the ground
  97.    SetColor(color1)
  98.    CLEAR
  99.  
  100.    * system constants
  101.    more_up = CHR(24)                             && visual up arrow
  102.    more_down = CHR(25)                           && visual down arrow
  103.    frame = "╒═╕│╛═╘│"                            && box characters
  104.    lframe = "╤═╕│╛═╧│"
  105.    mframe = "┬─┬│┘─└│"
  106.    sframe = "┌─┐│┘─└│"
  107.  
  108.    * global variables
  109.    STORE .F. TO need_field,need_ntx,need_relat,need_filtr,box_open
  110.    STORE "" TO kf1,kf2,kf3,kf4,kf5,kf6
  111.    help_code = 0                                 && let them eat cake
  112.    curs_on = .F.                                 && what cursor?
  113.    cur_dir = ""                                  && current directory
  114.    cur_dbf = ""                                  && current data file
  115.    cur_ntx = ""                                  && current controlling index file
  116.    cur_fields = ""                               && fields array for current area
  117.    cur_area = 0                                  && current work area
  118.    page = 1                                      && active view screen
  119.    n_files = 0                                   && 14 user files max
  120.    view_file = ""                                && file to save view
  121.    view_err = ""                                 && displayed by "set_view"
  122.  
  123.    view_err = "DBU - Copyright (c) 1990-1993 Computer Associates Int'l, " +;
  124.    "All Rights Reserved."
  125.  
  126.    * search for help file
  127.    IF FILE( "dbu.hlp" )
  128.       helpfile := "dbu.hlp"
  129.  
  130.    ELSE
  131.       helpfile := GetHelpFile()
  132.  
  133.    ENDIF
  134.  
  135.    **
  136.    *  Arrays declared in main module are considered public and
  137.    *  may be accessed or altered by any module in the system. The
  138.    *  matrix defines 6 work areas with 7 indexes and 64 fields
  139.    *  for each. 15 relations are also provided. All elements are
  140.    *  initialized to avoid a type mismatch.
  141.    **
  142.  
  143.    * names of data files
  144.    DECLARE dbf[6]
  145.  
  146.    * names of index files
  147.    DECLARE ntx1[7]
  148.    DECLARE ntx2[7]
  149.    DECLARE ntx3[7]
  150.    DECLARE ntx4[7]
  151.    DECLARE ntx5[7]
  152.    DECLARE ntx6[7]
  153.  
  154.    * index expression keys
  155.    DECLARE expKey[7]
  156.  
  157.    * 15 relations
  158.    DECLARE s_relate[15]                          && source of relation
  159.    DECLARE k_relate[15]                          && key to relation
  160.    DECLARE t_relate[15]                          && target of relation
  161.  
  162.    * individual field names for active list
  163.    DECLARE field_n1[64]
  164.    DECLARE field_n2[64]
  165.    DECLARE field_n3[64]
  166.    DECLARE field_n4[64]
  167.    DECLARE field_n5[64]
  168.    DECLARE field_n6[64]
  169.  
  170.    * master field list..128 fields overall max
  171.    DECLARE field_list[128]
  172.  
  173.    * first and last row of each screen section
  174.    DECLARE row_a[3]                              && first row of each screen section
  175.    DECLARE row_x[3]                              && last row of each screen sectionn
  176.  
  177.    * constant values
  178.    row_a[1] = 6
  179.    row_x[1] = 6
  180.    row_a[2] = 10
  181.    row_x[2] = 12
  182.    row_a[3] = 16
  183.    row_x[3] = 22
  184.  
  185.    * col() of data file columns
  186.    DECLARE column[6]
  187.  
  188.    * current row for each data column and each screen section
  189.    DECLARE _cr1[3]
  190.    DECLARE _cr2[3]
  191.    DECLARE _cr3[3]
  192.    DECLARE _cr4[3]
  193.    DECLARE _cr5[3]
  194.    DECLARE _cr6[3]
  195.  
  196.    * current element for each data column and each screen section
  197.    DECLARE _el1[3]
  198.    DECLARE _el2[3]
  199.    DECLARE _el3[3]
  200.    DECLARE _el4[3]
  201.    DECLARE _el5[3]
  202.    DECLARE _el6[3]
  203.  
  204.    * titles for function keys and help screens
  205.    DECLARE func_title[8]
  206.    DECLARE menu_deflt[8]
  207.    DECLARE help_title[22]
  208.  
  209.    **
  210.    * initialize arrays
  211.    **
  212.  
  213.    * active data files
  214.    afill(dbf, "")
  215.  
  216.    * index files for each data file
  217.    afill(ntx1, "")
  218.    afill(ntx2, "")
  219.    afill(ntx3, "")
  220.    afill(ntx4, "")
  221.    afill(ntx5, "")
  222.    afill(ntx6, "")
  223.  
  224.    * fields for each data file
  225.    afill(field_n1, "")
  226.    afill(field_n2, "")
  227.    afill(field_n3, "")
  228.    afill(field_n4, "")
  229.    afill(field_n5, "")
  230.    afill(field_n6, "")
  231.  
  232.    * source, key, and target for relations
  233.    afill(s_relate, "")
  234.    afill(k_relate, "")
  235.    afill(t_relate, "")
  236.  
  237.    * master field list
  238.    afill(field_list, "")
  239.  
  240.    * titles for function keys
  241.    func_title[1] = "Help"
  242.    func_title[2] = "Open"
  243.    func_title[3] = "Create"
  244.    func_title[4] = "Save"
  245.    func_title[5] = "Browse"
  246.    func_title[6] = "Utility"
  247.    func_title[7] = "Move"
  248.    func_title[8] = "Set"
  249.  
  250.    afill(menu_deflt, 1)
  251.  
  252.    * draw top of screen rows 0 thru 3
  253.    @ 0,0 SAY " F1        F2        F3        F4        F5        F6        " +;
  254.    "F7        F8       "
  255.    show_keys()
  256.    @ 2,0 SAY REPLICATE("─", 80)
  257.    error_msg(view_err)
  258.  
  259.    * when to bubble up
  260.    exit_str = "356"
  261.  
  262.    * pop-up menus with parallel boolean arrays for achoice()
  263.    DECLARE help_m[1]
  264.    DECLARE help_b[1]
  265.    help_m[1] = "Help"
  266.    help_b[1] = .T.
  267.  
  268.    DECLARE open_m[3]
  269.    DECLARE open_b[3]
  270.    open_m[1] = "Database"
  271.    open_m[2] = "Index"
  272.    open_m[3] = "View"
  273.    open_b[1] = "sysfunc = 0 .AND. .NOT. box_open"
  274.    open_b[2] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(cur_dbf)"
  275.    open_b[3] = "sysfunc = 0 .AND. .NOT. box_open"
  276.  
  277.    DECLARE create_m[2]
  278.    DECLARE create_b[2]
  279.    create_m[1] = "Database"
  280.    create_m[2] = "Index"
  281.    create_b[1] = "sysfunc = 0"
  282.    create_b[2] = "sysfunc = 0 .AND. .NOT. EMPTY(cur_dbf)"
  283.  
  284.    DECLARE save_m[2]
  285.    DECLARE save_b[2]
  286.    save_m[1] = "View"
  287.    save_m[2] = "Struct"
  288.    save_b[1] = "sysfunc = 0 .AND. .NOT. box_open"
  289.    save_b[2] = "sysfunc = 3 .AND. func_sel = 1 .AND. .NOT. box_open"
  290.  
  291.    DECLARE browse_m[2]
  292.    DECLARE browse_b[2]
  293.    browse_m[1] = "Database"
  294.    browse_m[2] = "View"
  295.    browse_b[1] = "sysfunc = 0 .AND. .NOT. EMPTY(cur_dbf)"
  296.    browse_b[2] = "sysfunc = 0 .AND. .NOT. EMPTY(dbf[1])"
  297.  
  298.    DECLARE utility_m[6]
  299.    DECLARE utility_b[6]
  300.    utility_m[1] = "Copy"
  301.    utility_m[2] = "Append"
  302.    utility_m[3] = "Replace"
  303.    utility_m[4] = "Pack"
  304.    utility_m[5] = "Zap"
  305.    utility_m[6] = "Run"
  306.    afill(utility_b, "sysfunc = 0 .AND. .NOT. EMPTY(cur_dbf)", 1, 5)
  307.    utility_b[6] = "sysfunc = 0"
  308.  
  309.    DECLARE move_m[4]
  310.    DECLARE move_b[4]
  311.    move_m[1] = "Seek"
  312.    move_m[2] = "Goto"
  313.    move_m[3] = "Locate"
  314.    move_m[4] = "Skip"
  315.    afill(move_b, "sysfunc = 5 .AND. .NOT. box_open")
  316.    move_b[1] = move_b[1] + " .AND. .NOT. EMPTY(cur_ntx)"
  317.  
  318.    DECLARE set_m[3]
  319.    DECLARE set_b[3]
  320.    set_m[1] = "Relation"
  321.    set_m[2] = "Filter"
  322.    set_m[3] = "Fields"
  323.    set_b[1] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(dbf[2])"
  324.    set_b[2] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(cur_dbf)"
  325.    set_b[3] = "sysfunc = 0 .AND. .NOT. box_open .AND. .NOT. EMPTY(cur_dbf)"
  326.  
  327.    * titles for help screens
  328.    help_title[1] = "GENERAL INFORMATION"
  329.    help_title[2] = "FIELDS LISTS"
  330.    help_title[3] = "BROWSE"
  331.    help_title[4] = "CREATE / MODIFY STRUCTURE"
  332.    help_title[5] = "CREATE INDEX"
  333.    help_title[6] = "OPEN DATABASE"
  334.    help_title[7] = "FILTERS"
  335.    help_title[8] = "OPEN INDEX"
  336.    help_title[9] = "SET RELATIONSHIP"
  337.    help_title[10] = "LOCATE EXPRESSION"
  338.    help_title[11] = "SDF / DELIMITED"
  339.    help_title[12] = "COPY"
  340.    help_title[13] = "SEEK EXPRESSION"
  341.    help_title[14] = "GO TO RECORD NUMBER"
  342.    help_title[15] = "APPEND"
  343.    help_title[16] = "FOR / WHILE"
  344.    help_title[17] = "SCOPE"
  345.    help_title[18] = "DOS WINDOW"
  346.    help_title[19] = "MEMO EDITOR"
  347.    help_title[20] = "SKIP <n> RECORDS"
  348.    help_title[21] = "SAVE / RESTORE VIEW"
  349.    help_title[22] = "REPLACE"
  350.  
  351.    * arrays for file names in default directory
  352.    DECLARE dbf_list[adir("*.DBF") + 20]          && directory of data files
  353.    DECLARE ntx_list[adir("*" + INDEXEXT()) + 20] && directory of index files
  354.    DECLARE vew_list[adir("*.VEW") + 20]          && directory of view files
  355.  
  356.    * fill the arrays with filenames
  357.    array_dir("*.DBF",dbf_list)
  358.    array_dir("*" + INDEXEXT(),ntx_list)
  359.    array_dir("*.VEW",vew_list)
  360.  
  361.    * default to set view
  362.    local_func = 0                                && local menu
  363.    local_sel = 1                                 && local menu item
  364.    keystroke = 0                                 && current keystroke
  365.    lkey = 0                                      && previous keystroke
  366.    sysfunc = 0                                   && system menu
  367.    func_sel = 1                                  && system menu item
  368.  
  369.    * clean up and process command line if entered
  370.    com_line = LTRIM(TRIM(com_line))
  371.  
  372.    IF .NOT. EMPTY(com_line)
  373.  
  374.       DO CASE
  375.  
  376.       CASE RAT(".", com_line) > RAT("\", com_line)
  377.     * file extension entered
  378.     IF .NOT. FILE(com_line)
  379.        * file must exist
  380.        com_line = ""
  381.  
  382.     ENDIF
  383.  
  384.       CASE FILE(com_line + ".VEW")
  385.     * look for file name with .VEW extension
  386.     com_line = com_line + ".VEW"
  387.  
  388.       CASE FILE(com_line + ".DBF")
  389.     * look for file name with .DBF extension
  390.     com_line = com_line + ".DBF"
  391.  
  392.       OTHERWISE
  393.     * file not found..ignore command line
  394.     com_line = ""
  395.  
  396.       ENDCASE
  397.  
  398.       IF .NOT. EMPTY(com_line)
  399.     * command line file exists
  400.  
  401.     IF RAT(".VEW", com_line) = LEN(com_line) - 3
  402.        * assume a valid .VEW file
  403.        view_file = com_line
  404.        set_from(.F.)                        && restore view
  405.        KEYBOARD CHR(-4) + CHR(24) + CHR(13) && browse view
  406.  
  407.     ELSE
  408.        * assume a valid .DBF file
  409.        dbf[1] = com_line                    && primary database
  410.  
  411.        IF NetUse( com_line )
  412.           all_fields(1, M->field_n1)        && all fields active
  413.           KEYBOARD CHR(-4) + CHR(13)        && browse database
  414.        ELSE
  415.           dbf[1] := ""
  416.        ENDIF
  417.  
  418.     ENDIF
  419.  
  420.     IF .NOT. EMPTY(dbf[1])
  421.        * view established..cancel display of message
  422.        view_err = ""
  423.     ENDIF
  424.       ENDIF
  425.    ENDIF
  426.  
  427.    DO WHILE .T.
  428.       * forever
  429.       cur_func = M->sysfunc                      && to recognize a change
  430.  
  431.       DO CASE
  432.  
  433.       CASE M->sysfunc = 5
  434.     * browse
  435.  
  436.     IF .NOT. EMPTY(dbf[1])
  437.        * there is a view..do the set up
  438.        setup()
  439.  
  440.        IF EMPTY(M->view_err)
  441.           * set up successful so far
  442.           cur_fields = "field_n" + SUBSTR("123456", M->cur_area, 1)
  443.  
  444.           DO CASE
  445.  
  446.           CASE M->func_sel = 1 .AND. EMPTY(M->cur_dbf)
  447.         * browse one file
  448.         view_err = "No data file in current select area"
  449.  
  450.           CASE M->func_sel = 1 .AND. EMPTY(&cur_fields[1])
  451.         * browse one file
  452.         view_err = "No active field list in current select area"
  453.  
  454.           CASE EMPTY(field_list[1])
  455.         * browse entire view
  456.         view_err = "No active field list"
  457.  
  458.           OTHERWISE
  459.         * ok to browse
  460.  
  461.         IF M->func_sel = 1
  462.            * browse one file..hi-lite the name
  463.            hi_cur()
  464.  
  465.         ENDIF
  466.  
  467.         help_code = 3
  468.         DO browse
  469.         dehi_cur()
  470.  
  471.           ENDCASE
  472.        ENDIF
  473.  
  474.     ELSE
  475.        view_err = "No database in use"
  476.  
  477.     ENDIF
  478.  
  479.     sysfunc = 0                             && back to the main view screen
  480.  
  481.       CASE M->sysfunc = 3
  482.  
  483.     IF M->func_sel = 1
  484.        * modify structure
  485.        hi_cur()
  486.        help_code = 4
  487.        DO modi_stru
  488.        dehi_cur()
  489.  
  490.        IF EMPTY(M->cur_dbf)
  491.           * new structure not created..kill dummy View channel
  492.           cur_area = 0
  493.  
  494.        ENDIF
  495.  
  496.     ELSE
  497.        * create or re-create index
  498.  
  499.        IF EMPTY(M->cur_dbf)
  500.           view_err = "No data file in current select area"
  501.  
  502.        ELSE
  503.           help_code = 5
  504.           DO make_ntx
  505.  
  506.        ENDIF
  507.     ENDIF
  508.  
  509.     sysfunc = 0                             && back to the main view screen
  510.  
  511.       CASE M->sysfunc = 6 .AND. M->func_sel <> 6
  512.     * copy/append/replace/pack/zap
  513.  
  514.     IF EMPTY(M->cur_dbf)
  515.        view_err = "No data file in current select area"
  516.        sysfunc = 0                          && back to the main view screen
  517.        LOOP
  518.  
  519.     ENDIF
  520.  
  521.     IF .NOT. EMPTY(dbf[1])
  522.        * do view set up
  523.        setup()
  524.  
  525.     ENDIF
  526.  
  527.     IF .NOT. EMPTY(M->view_err)
  528.        * error in set up
  529.        sysfunc = 0                          && back to the main view screen
  530.        LOOP
  531.  
  532.     ENDIF
  533.  
  534.     hi_cur()
  535.  
  536.     DO CASE
  537.  
  538.     CASE M->func_sel < 4
  539.        * copy, append, or replace
  540.        DO capprep
  541.  
  542.     CASE M->func_sel = 4
  543.        * pack command
  544.  
  545.        IF rsvp("Pack " + M->cur_dbf + "? (Y/N)") = "Y"
  546.           * pack confirmed
  547.           stat_msg("Packing " + M->cur_dbf)
  548.           SELECT (M->cur_area)
  549.  
  550.           * we will have to rebuild the index files after PACK
  551.           ntx := "ntx" + SUBSTR("123456", M->cur_area, 1)
  552.           M->i := 1
  553.           DO WHILE M->i <= 7
  554.        IF EMPTY (&ntx[i])  // no more
  555.          EXIT
  556.        ENDIF
  557.  
  558.        expKey[i] := IndexKey (i)
  559.        M->i ++
  560.           ENDDO
  561.  
  562.  
  563.           IF NetPack()
  564.  
  565.        M->i := 1
  566.        DO WHILE M->i <= 7
  567.          IF EMPTY (&ntx[i])  // no more
  568.            EXIT
  569.          ENDIF
  570.  
  571.                             INDEX ON &(expKey[i]) TO (&ntx[i])
  572.          M->i ++
  573.        ENDDO
  574.        dbClearIndex()
  575.  
  576.        stat_msg(M->cur_dbf + " Packed")
  577.  
  578.        * update indexes and filter
  579.        need_ntx := .T.
  580.        need_filtr := .T.
  581.  
  582.           ELSE
  583.         /*
  584.         IF !NetUse( M->cur_dbf )
  585.            /// If we can't re-open, we're in trouble...
  586.            ALERT( "Assertion failed:;Unable to re-open file" )
  587.            QUIT
  588.         ENDIF
  589.         */
  590.         clear_dbf(M->cur_area, 2)
  591.         cur_dbf = dbf[M->cur_area]
  592.         stat_msg("")
  593.           ENDIF
  594.  
  595.        ENDIF
  596.  
  597.     CASE M->func_sel = 5
  598.        * zap command
  599.  
  600.        IF rsvp("Zap " + M->cur_dbf + "? (Y/N)") = "Y"
  601.           * zap confirmed
  602.           stat_msg("Zapping " + M->cur_dbf)
  603.           SELECT (M->cur_area)
  604.  
  605.           * we will have to rebuild the index files after ZAP
  606.           ntx := "ntx" + SUBSTR("123456", M->cur_area, 1)
  607.           M->i := 1
  608.           DO WHILE M->i <= 7
  609.         IF EMPTY (&ntx[i])  // no more
  610.            EXIT
  611.         ENDIF
  612.  
  613.         expKey[i] := IndexKey (i)
  614.         M->i ++
  615.       ENDDO
  616.  
  617.  
  618.           IF NetZap()
  619.         stat_msg(M->cur_dbf + " Zapped")
  620.         * update filter
  621.         need_filtr := .T.
  622.           ELSE
  623.  
  624.         /*
  625.         IF !NetUse( M->cur_dbf )       //Attempt to re-open shared
  626.            /// If we can't re-open, we're in trouble...
  627.            ALERT( "Assertion failed:;Unable to re-open file" )
  628.            QUIT
  629.         ENDIF
  630.         */
  631.         clear_dbf(M->cur_area, 2)
  632.         cur_dbf = dbf[M->cur_area]
  633.         stat_msg("")
  634.           ENDIF
  635.  
  636.        ENDIF
  637.  
  638.     ENDCASE
  639.  
  640.     dehi_cur()
  641.     sysfunc = 0                             && back to the main view screen
  642.  
  643.       CASE M->sysfunc = 6 .AND. M->func_sel = 6
  644.     * run a DOS command or program
  645.     @ 4,0 CLEAR
  646.  
  647.     IF .NOT. EMPTY(dbf[1])
  648.        * set view before a possible chdir
  649.        setup()
  650.  
  651.     ENDIF
  652.  
  653.     IF .NOT. EMPTY(M->view_err)
  654.        * display message and continue for possible
  655.        * correction of "File not found", etc.
  656.        error_msg(M->view_err, 24, 7)
  657.        view_err = ""
  658.  
  659.     ENDIF
  660.  
  661.     run_com = ""
  662.     com_line = ""
  663.     help_code = 18
  664.  
  665.     DO WHILE .NOT. q_check()
  666.        * re-draw top 3 rows after each command
  667.        @ 0,0 SAY " F1        F2        F3        F4        " +;
  668.        "F5        F6        F7        F8       "
  669.        show_keys()
  670.        @ 2,0 SAY REPLICATE("─", 80)
  671.        @ 24,0 SAY "Run ═" + CHR(16) + " "
  672.  
  673.        * accept command entry
  674.        run_com = enter_rc(M->com_line,24,7,127,"@KS73",M->color1)
  675.  
  676.        IF .NOT. EMPTY(M->run_com) .AND. M->keystroke = 13
  677.           * only the enter key will run the command
  678.           com_line = M->run_com             && preserve previous command
  679.           @ 24,0                            && clear the command entry
  680.  
  681.           SET CURSOR ON
  682.           RUN &run_com
  683.           SET CURSOR OFF
  684.  
  685.        ELSE
  686.           * check for menu request
  687.           sysmenu()
  688.  
  689.           IF M->local_func = 1
  690.         DO syshelp
  691.  
  692.           ENDIF
  693.        ENDIF
  694.     ENDDO
  695.  
  696.     * re-establish the environment
  697.     @ 3,0 CLEAR
  698.  
  699.     * rebuild directory arrays..must keep current
  700.     DECLARE dbf_list[adir("*.DBF") + 20]
  701.     DECLARE ntx_list[adir("*" + INDEXEXT()) + 20]
  702.     DECLARE vew_list[adir("*.VEW") + 20]
  703.  
  704.     * fill the arrays with filenames..data files
  705.     array_dir("*.DBF",dbf_list)
  706.  
  707.     * index files
  708.     array_dir("*" + INDEXEXT(),ntx_list)
  709.  
  710.     * view files
  711.     array_dir("*.VEW",vew_list)
  712.     cur_area = 0                            && re-draw view screen
  713.     sysfunc = 0                             && back to the main view screen
  714.  
  715.       OTHERWISE
  716.     * main view screen..sysfunc = 0
  717.     help_code = 1
  718.     DO set_view
  719.  
  720.     IF M->keystroke = 27
  721.        * exit confirmed in set_view
  722.        SET TYPEAHEAD TO 0                   && remaining keystrokes to DOS
  723.        CLOSE DATABASES                      && kill the view
  724.        RESTORE SCREEN                       && ...may be your own
  725.        SET CURSOR ON                        && always leave them laughing
  726.        SET COLOR TO                         && back to normal
  727.        QUIT                                 && -=[Bye]=-
  728.  
  729.     ENDIF
  730.       ENDCASE
  731.    ENDDO
  732.  
  733.    RETURN
  734.  
  735.  
  736.  
  737. /***
  738. *
  739. *  ParseCommLine( cCommandLine ) --> { cFile, cColorDescriptor }
  740. *
  741. */
  742. FUNCTION ParseCommLine( cStr )
  743.    LOCAL aRet := { "", "" }                   // Return value containing file and colors
  744.    LOCAL nPos := 1                            // Position of next token in string
  745.    LOCAL cToken                               // Extracted command line parameter
  746.  
  747.    WHILE ( nPos != 0 )
  748.  
  749.       IF (( nPos := AT( "~", cStr ) ) != 0 )
  750.  
  751.     cToken := SUBSTR( cStr, 1, nPos - 1 )
  752.     cStr   := SUBSTR( cStr, ++nPos )
  753.  
  754.     DO CASE
  755.     CASE ( cToken == "/E" )
  756.        NetMode( .F. )
  757.  
  758.     CASE ( cToken $ "/C/M" )
  759.        aRet[2] := cToken
  760.  
  761.     CASE !( cToken == "" )
  762.        aRet[1] := cToken
  763.  
  764.     ENDCASE
  765.  
  766.       ENDIF
  767.  
  768.    ENDDO
  769.  
  770.    RETURN ( aRet )
  771.  
  772.  
  773.  
  774. /***
  775. *
  776. *  GetHelpFile() --> cHelpFile
  777. *
  778. */
  779. FUNCTION GetHelpFile()
  780.    LOCAL cPath := GETENV( "PATH" )
  781.    LOCAL nPos  := 1
  782.    LOCAL cFile
  783.    LOCAL lFound
  784.  
  785.    WHILE ( nPos != 0 )
  786.  
  787.       nPos  := AT( ";", cPath )
  788.  
  789.       // Account for backslash in path
  790.       IF ( SUBSTR( cPath, nPos - 1, 1 ) == "\" )
  791.     cFile := SUBSTR( cPath, 1, IF( nPos == 0, LEN( cPath ), nPos - 1 )) + "dbu.hlp"
  792.       ELSE
  793.     cFile := SUBSTR( cPath, 1, IF( nPos == 0, LEN( cPath ), nPos - 1 )) + "\dbu.hlp"
  794.       ENDIF
  795.  
  796.       IF FILE( cFile )
  797.     EXIT     // We found it, time to bail...
  798.       ENDIF
  799.  
  800.       IF ( nPos == 0 )
  801.     cFile := ""
  802.       ELSE
  803.     cPath := SUBSTR( cPath, nPos + 1 )
  804.       ENDIF
  805.  
  806.    END
  807.  
  808.    RETURN ( cFile )
  809.  
  810.  
  811.  
  812. * EOF DBU.PRG
  813.