home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR503.W96 / DBUVIEW.PR_ / DBUVIEW.PR
Text File  |  1995-06-26  |  68KB  |  3,271 lines
  1. /***
  2. *
  3. *  Dbuview.prg
  4. *
  5. *  DBU View Maintenance Module
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. */
  11.  
  12.  
  13. ******
  14. *    set_view
  15. *
  16. *    select files, set fields, relations, filters
  17. *
  18. *    note: only data files are opened and closed when
  19. *          requested..all other aspects of the View are
  20. *          set when needed by calling the setup() function
  21. *          in the utilities module
  22. ******
  23. PROCEDURE set_view
  24. local saveColor
  25. PRIVATE bar_line,empty_line,ntx,field_n,el,cur_row,t_row,ch_draw,;
  26.         strn,is_redraw,is_insert,horiz_keys,prev_area,i
  27.  
  28. saveColor := SetColor(M->color1)
  29.  
  30. * establish local array for index file names (no path or extension)
  31. DECLARE d_array[LEN(M->ntx1)]
  32.  
  33. * initialize local variables
  34. horiz_keys = CHR(4) + CHR(19) + CHR(1) + CHR(6)    && quick return from bar_menu
  35. bar_line = ""        && built by bline()
  36. empty_line = ""        && ditto
  37. prev_area = 0        && detect horizontal movement (zero to initialize)
  38. ch_draw = .F.        && switch for channel function
  39.  
  40. * global help code
  41. help_code = 1
  42.  
  43. * global key value..zero is convenient for branch to "otherwise" case below
  44. keystroke = 0
  45.  
  46. * special attention for open and create menu defaults
  47. set_deflt()
  48.  
  49. IF .NOT. EMPTY(M->view_err)
  50.     * with soap it's loaded
  51.     error_msg(M->view_err)
  52.     view_err = ""
  53.  
  54. ENDIF
  55.  
  56. DO WHILE .NOT. q_check()
  57.     * one big switch..exit condition determined elsewhere
  58.  
  59.     DO CASE
  60.  
  61.         CASE M->cur_area = 0
  62.             * draw View screen..see if complete reset needed
  63.             cur_area = aseek(M->dbf, M->cur_dbf)
  64.  
  65.             IF M->cur_area = 0
  66.                 * complete reset needed
  67.  
  68.                 FOR i = 1 TO 3
  69.                     * current rows and current elements
  70.                STORE row_a[M->i] TO _cr1[M->i],_cr2[M->i],_cr3[M->i],;
  71.                                _cr4[M->i],_cr5[M->i],_cr6[M->i]
  72.                STORE 1 TO _el1[M->i],_el2[M->i],_el3[M->i],_el4[M->i],;
  73.                         _el5[M->i],_el6[M->i]
  74.  
  75.                 NEXT
  76.  
  77.                 * global variables
  78.                 cur_dbf = dbf[1]
  79.                 STORE 1 TO cur_area, page
  80.  
  81.                 * set default for open and create menus
  82.                 set_deflt()
  83.  
  84.             ENDIF
  85.  
  86.             * draw the main View screen
  87.             draw_view(0)
  88.  
  89.         CASE M->cur_area <> M->prev_area
  90.             * horizontal movement detected (or initial entry)
  91.             cur_dbf = dbf[M->cur_area]    && current data file
  92.  
  93.             * save on function calls
  94.             strn = SUBSTR("123456", M->cur_area, 1)
  95.  
  96.             * set variables to matrix into current data channel
  97.             ntx = "ntx" + strn
  98.             field_n = "field_n" + strn
  99.          el = "_el" + strn
  100.  
  101.             * use temporary variable for adjustment
  102.          t_row = "_cr" + strn
  103.  
  104.             IF M->page > 1 .AND. M->prev_area <> 0
  105.                 * adjust element by (old row - new row)
  106.                 &el[M->page] = &el[M->page] +;
  107.                                &cur_row[M->page] - &t_row[M->page]
  108.  
  109.                 * new row = old row
  110.                 &t_row[M->page] = &cur_row[M->page]
  111.  
  112.             ENDIF
  113.  
  114.             * set to current data channel
  115.             cur_row = M->t_row
  116.  
  117.             * clear for next loop
  118.             prev_area = M->cur_area
  119.  
  120.         CASE M->keystroke = 19
  121.             * left arrow..move one channel to the left
  122.  
  123.             IF M->cur_area > 1
  124.                 * ok to move left
  125.                 cur_area = M->cur_area - 1
  126.  
  127.             ENDIF
  128.  
  129.             keystroke = 0
  130.  
  131.         CASE M->keystroke = 1
  132.             * home key..extreme left
  133.             cur_area = 1
  134.             keystroke = 0
  135.  
  136.         CASE M->keystroke = 4
  137.             * right arrow..move one channel to the right
  138.  
  139.             IF M->cur_area < 6 .AND. .NOT. EMPTY(M->cur_dbf)
  140.                 * ok to move right..next channel
  141.                 cur_area = M->cur_area + 1
  142.  
  143.                 IF EMPTY(dbf[M->cur_area])
  144.                     * inactive channel..cannot enter indexes or fields
  145.                     page = 1
  146.                     set_deflt()
  147.  
  148.                 ENDIF
  149.             ENDIF
  150.  
  151.             keystroke = 0
  152.  
  153.         CASE M->keystroke = 6
  154.             * end key..move to extreme right
  155.  
  156.             IF M->cur_area < 6 .AND. .NOT. EMPTY(M->cur_dbf)
  157.                 * ok to move right..determine last active channel
  158.                 i = afull(M->dbf)
  159.  
  160.                 IF M->i < 6 .AND. (M->page = 1 .OR. M->cur_area = M->i)
  161.                     * move to inactive channel
  162.                     cur_area = M->i + 1
  163.  
  164.                     * cannot enter indexes or fields
  165.                     page = 1
  166.                     set_deflt()
  167.  
  168.                 ELSE
  169.                     * move to last active channel
  170.                     cur_area = M->i
  171.  
  172.                 ENDIF
  173.  
  174.             ENDIF
  175.  
  176.             keystroke = 0
  177.  
  178.         CASE M->keystroke = 18 .OR. M->keystroke = 5
  179.             * PgUp or up arrow
  180.  
  181.             IF M->page > 1
  182.                 * ok to move up
  183.                 page = M->page - 1
  184.                 set_deflt()
  185.  
  186.             ENDIF
  187.  
  188.             keystroke = 0
  189.  
  190.         CASE M->keystroke = 3 .OR. M->keystroke = 24
  191.             * PgDn or down arrow
  192.  
  193.             IF M->page < 3 .AND. .NOT. EMPTY(M->cur_dbf)
  194.                 * ok to move down
  195.                 page = M->page + 1
  196.                 set_deflt()
  197.  
  198.                 * adjust row and element for smooth cursor movement
  199.                 &el[M->page] = &el[M->page] -;
  200.                                (&cur_row[M->page] - row_a[M->page])
  201.                 &cur_row[M->page] = row_a[M->page]
  202.  
  203.             ENDIF
  204.  
  205.             keystroke = 0
  206.  
  207.         CASE M->keystroke = 22 .OR. M->keystroke = 13 .OR.;
  208.              isdata(M->keystroke) .OR. (M->local_func = 2 .AND.;
  209.              (M->local_sel = 1 .OR. M->local_sel = 2)) .OR.;
  210.              (M->local_func = 8 .AND. M->local_sel = 3)
  211.             * insert or enter or local menu item
  212.  
  213.             IF M->local_func <> 0
  214.                 * local menu item..set page to menu selection
  215.                 page = M->local_sel
  216.                 set_deflt()
  217.  
  218.                 * menu select behaves like insert
  219.                 keystroke = 22
  220.  
  221.             ENDIF
  222.  
  223.             IF M->page = 1 .AND. M->n_files < 14
  224.                 * open a data file
  225.                 is_redraw = M->cur_area < 6 .AND. (M->keystroke = 22 .OR.;
  226.                                                   EMPTY(M->cur_dbf))
  227.  
  228.                 is_insert = (M->keystroke = 22 .AND.;
  229.                             .NOT. EMPTY(M->cur_dbf) .AND. M->cur_area < 6)
  230.  
  231.                 IF M->is_redraw
  232.                     * open up dummy channel on screen
  233.                     draw_view(M->cur_area)
  234.  
  235.                     * a dummy for a dummy
  236.                     SetColor(M->color2)
  237.                     @ row_a[1], column[M->cur_area] + 2 SAY SPACE(8)
  238.                     SetColor(M->color1)
  239.  
  240.                 ELSE
  241.                     * hilite the affected View item
  242.                     hi_cur()
  243.  
  244.                 ENDIF
  245.  
  246.                 * call the open function and save the return status
  247.                 ch_draw = open_dbf(M->is_insert, .F.)
  248.  
  249.                 IF M->ch_draw
  250.                     * update screen with "channel" function
  251.                     channel(&ntx, &field_n, &el, &cur_row,;
  252.                             M->cur_area, M->cur_area)
  253.  
  254.                     * new current data file
  255.                     cur_dbf = dbf[M->cur_area]
  256.  
  257.                 ELSE
  258.                     * put the screen back the way it was
  259.  
  260.                     IF M->is_redraw
  261.                         * kill the dummy
  262.                         draw_view(0)
  263.  
  264.                     ELSE
  265.                         * un-hilite
  266.                         dehi_cur()
  267.  
  268.                     ENDIF
  269.                 ENDIF
  270.  
  271.             ELSE
  272.  
  273.                 IF M->page > 1
  274.                     * pages 2 and 3 handled by channel function
  275.                     channel(&ntx, &field_n, &el, &cur_row,;
  276.                             M->cur_area, M->cur_area)
  277.  
  278.                 ELSE
  279.                     error_msg("Too many files open")
  280.  
  281.                 ENDIF
  282.             ENDIF
  283.  
  284.             keystroke = 0
  285.  
  286.         CASE M->keystroke = 7
  287.             * delete
  288.  
  289.             IF M->page = 1 .AND. .NOT. EMPTY(M->cur_dbf)
  290.                 * close this work area and shift subsequent ones down
  291.                 stat_msg("Closing File")
  292.                 clear_dbf(M->cur_area, 2)
  293.  
  294.                 IF M->cur_area = 6
  295.                     * no need to re-write screen..clear windows
  296.                     ch_draw = .T.
  297.                     channel(&ntx, &field_n, &el, &cur_row,;
  298.                             M->cur_area, M->cur_area)
  299.  
  300.                 ELSE
  301.                     * re-write screen
  302.                     draw_view(0)
  303.  
  304.                 ENDIF
  305.  
  306.                 * new current data file
  307.                 cur_dbf = dbf[M->cur_area]
  308.  
  309.                 * clear status message
  310.                 stat_msg("")
  311.  
  312.             ELSE
  313.  
  314.                 IF M->page > 1
  315.                     * pages 2 and 3 handled by channel function
  316.                     channel(&ntx, &field_n, &el, &cur_row,;
  317.                             M->cur_area, M->cur_area)
  318.  
  319.                 ENDIF
  320.             ENDIF
  321.  
  322.             keystroke = 0
  323.  
  324.         CASE M->local_func = 8 .AND. M->local_sel = 1
  325.             * "set_relation" selected from pull-down menu
  326.             set_relation()
  327.             keystroke = 0
  328.  
  329.         CASE M->local_func = 8 .AND. M->local_sel = 2
  330.             * "set filter" selected from pull-down menu
  331.             get_filter()
  332.             keystroke = 0
  333.  
  334.         CASE M->local_func = 2 .AND. M->local_sel = 3
  335.             * "restore View from .VEW file" selected from pull-down menu
  336.             set_from(.T.)
  337.  
  338.             IF .NOT. EMPTY(M->view_file) .AND. M->keystroke = 13
  339.                 * View set..re-write screen
  340.                 cur_area = 0
  341.                 cur_dbf = ""
  342.  
  343.             ENDIF
  344.  
  345.             keystroke = 0
  346.  
  347.         CASE M->local_func = 4
  348.             * "save View" selected from pull-down menu
  349.             save_view()
  350.             keystroke = 0
  351.  
  352.         CASE M->local_func = 1
  353.             * "help" selected from pull-down menu
  354.             DO syshelp
  355.             keystroke = 0
  356.  
  357.         OTHERWISE
  358.             * all pending cases have been processed
  359.  
  360.             DO CASE
  361.  
  362.                 CASE M->page = 1
  363.                     * get keystroke if pending
  364.  
  365.                     IF .NOT. key_ready()
  366.                         * no key pending..hilite the current item
  367.                         hi_cur()
  368.  
  369.                         * wait for keystroke
  370.                         read_key()
  371.  
  372.                         * re-write the current item as normal
  373.                         dehi_cur()
  374.  
  375.                     ENDIF
  376.  
  377.                 CASE M->page = 2
  378.                     * copy index file names to "name only" array
  379.                     d_copy(&ntx)
  380.  
  381.                     * do the menu selection on the main View screen
  382.                     bar_menu(column[M->cur_area] + 2,;
  383.                              column[M->cur_area] + 9, M->d_array)
  384.  
  385.                 CASE M->page = 3
  386.                     * do the menu selection on the main View screen
  387.                     bar_menu(column[M->cur_area] + 1,;
  388.                              column[M->cur_area] + 10, &field_n)
  389.  
  390.             ENDCASE
  391.  
  392.             IF M->keystroke = 27
  393.  
  394.                 IF rsvp("Exit to DOS? (Y/N)") <> "Y"
  395.                     keystroke = 0
  396.  
  397.                 ENDIF
  398.             ENDIF
  399.     ENDCASE
  400. ENDDO
  401.  
  402. IF M->sysfunc = 3 .AND. M->func_sel = 1 .AND. EMPTY(M->cur_dbf)
  403.     * indicate create structure by opening a dummy channel
  404.     draw_view(M->cur_area)
  405.  
  406. ENDIF
  407.  
  408. RETURN
  409.  
  410.  
  411. ******
  412. *    channel()
  413. *
  414. *    process one channel for "set view"
  415. *
  416. *    note: the array identifiers associated with the current
  417. *          channel are passed to this function in order to
  418. *          avoid the repeated macro expansion inherent in
  419. *          constructs like &ntx[&el[]]
  420. ******
  421. FUNCTION channel
  422.  
  423. PARAMETERS ch_ntx, ch_field_n, ch_el, ch_cur_row, n, dbf_num
  424. local saveColor
  425. PRIVATE f_n, is_ins, temp_buff, d_item
  426.  
  427. saveColor := SetColor(M->color1)
  428.  
  429. DO CASE
  430.  
  431.     CASE M->ch_draw
  432.         * update the screen for channel "n"..clear windows
  433.         scroll(row_a[2], column[M->n], row_x[2], column[M->n] + 11, 0)
  434.         scroll(row_a[3], column[M->n], row_x[3], column[M->n] + 11, 0)
  435.  
  436.         * display the specified file name "dbf_num"
  437.         @ row_a[1],column[M->n] + 2 SAY pad(name(dbf[M->dbf_num]), 8)
  438.  
  439.         IF .NOT. EMPTY(ch_ntx[1])
  440.             * list the index files if any
  441.             d_copy(M->ch_ntx)
  442.             list_array(row_a[2],column[M->n] + 2,row_x[2],column[M->n] + 9,;
  443.                        M->d_array,ch_el[2] - (ch_cur_row[2] - row_a[2]))
  444.  
  445.         ENDIF
  446.  
  447.         * display field list
  448.         list_array(row_a[3], column[M->n] + 1, row_x[3], column[M->n] + 10,;
  449.                    M->ch_field_n, ch_el[3] - (ch_cur_row[3] - row_a[3]))
  450.  
  451.         ch_draw = .F.                && reset the screen update flag
  452.  
  453.     CASE M->keystroke = 22 .OR. M->keystroke = 13 .OR. isdata(M->keystroke)
  454.         * insert or enter or character key
  455.  
  456.         IF isdata(M->keystroke)
  457.             * forward character to GET system
  458.             KEYBOARD CHR(M->keystroke)
  459.  
  460.         ENDIF
  461.  
  462.         * remember if insert
  463.         is_ins = (M->keystroke = 22)
  464.  
  465.         DO CASE
  466.  
  467.             CASE M->page = 2 .AND. (M->n_files < 14 .OR. (M->keystroke <> 22;
  468.                  .AND. .NOT. EMPTY(ch_ntx[ch_el[2]])))
  469.                 * add or change an index file in the current list..save window
  470.                 temp_buff = SAVESCREEN(row_a[2], column[M->n] + 1,;
  471.                                        row_x[2], column[M->n] + 11)
  472.  
  473.                 IF M->is_ins
  474.                     * insert
  475.  
  476.                     IF ch_el[2] + row_x[2] - ch_cur_row[2] = afull(M->ch_ntx)
  477.                         * last filename will scroll off the window
  478.                         @ row_x[2], column[M->n] + 11 SAY M->more_down
  479.  
  480.                     ENDIF
  481.  
  482.                     IF ch_cur_row[2] < row_x[2]
  483.                         * open a blank row..scroll down
  484.                         scroll(ch_cur_row[2], column[M->n] + 1,;
  485.                                     row_x[2], column[M->n] + 10, -1)
  486.  
  487.                     ENDIF
  488.  
  489.                     * show entry blank
  490.                     d_item = SPACE(8)
  491.  
  492.                 ELSE
  493.                     * show the affected View item
  494.                     d_item = pad(name(ch_ntx[ch_el[2]]), 8)
  495.  
  496.                 ENDIF
  497.  
  498.                 * hilite the affected View item
  499.                 SetColor(M->color2)
  500.                 @ ch_cur_row[2],column[M->n] + 2 SAY M->d_item
  501.                 SetColor(M->color1)
  502.  
  503.                 * get selection
  504.                 f_n = get_ntx(ch_cur_row[2], column[M->n] + 2,;
  505.                               ch_ntx[ch_el[2]], M->is_ins)
  506.  
  507.                 IF .NOT. M->f_n == ch_ntx[ch_el[2]] .AND. .NOT. EMPTY(M->f_n)
  508.                     * index file added to list
  509.                     need_ntx = .T.
  510.  
  511.                     IF M->is_ins
  512.                         * make room for new index file name
  513.                         array_ins(M->ch_ntx,ch_el[2])
  514.  
  515.                     ENDIF
  516.  
  517.                     * assign filename to array element
  518.                     ch_ntx[ch_el[2]] = M->f_n
  519.  
  520.                     IF ch_el[2] = 1
  521.                         * controlling index..remove relations where target
  522.                         not_target(M->n, .T.)
  523.  
  524.                     ENDIF
  525.  
  526.                     * display the name of the newly selected index file
  527.                     @ ch_cur_row[2],column[M->n] + 2;
  528.                     SAY pad(name(ch_ntx[ch_el[2]]), 8)
  529.  
  530.                 ELSE
  531.                     * aborted entry..restore the window as it was
  532.                     RESTSCREEN(row_a[2], column[M->n] + 1,;
  533.                                row_x[2], column[M->n] + 11, M->temp_buff)
  534.  
  535.                 ENDIF
  536.  
  537.             CASE M->page = 3
  538.                 * add or change a fieldname in the current list..save window
  539.                 temp_buff = SAVESCREEN(row_a[3], column[M->n] + 1,;
  540.                                        row_x[3], column[M->n] + 11)
  541.  
  542.                 IF M->is_ins
  543.                     * insert
  544.  
  545.                     IF ch_el[3] + row_x[3] - ch_cur_row[3] = afull(M->ch_field_n)
  546.                         * last fieldname will scroll off the window
  547.                         @ row_x[3], column[M->n] + 11 SAY M->more_down
  548.  
  549.                     ENDIF
  550.  
  551.                     IF ch_cur_row[3] < row_x[3]
  552.                         * open a blank row..scroll down
  553.                         scroll(ch_cur_row[3], column[M->n] + 1,;
  554.                                     row_x[3], column[M->n] + 10, -1)
  555.  
  556.                     ENDIF
  557.  
  558.                     * show entry blank
  559.                     d_item = SPACE(10)
  560.  
  561.                 ELSE
  562.                     * show the affected View item
  563.                     d_item = pad(ch_field_n[ch_el[3]], 10)
  564.  
  565.                 ENDIF
  566.  
  567.                 * hilite the affected View item
  568.                 SetColor(M->color2)
  569.                 @ ch_cur_row[3],column[M->n] + 1 SAY M->d_item
  570.                 SetColor(M->color1)
  571.  
  572.                 * get selection
  573.                 f_n = get_field(ch_cur_row[3], column[M->n] + 1, M->n,;
  574.                                 ch_field_n[ch_el[3]])
  575.  
  576.                 IF (M->is_ins .OR. .NOT. M->f_n == ch_field_n[ch_el[3]]);
  577.                    .AND. .NOT. EMPTY(M->f_n)
  578.                     * fieldname added to list
  579.                     need_field = .T.
  580.  
  581.                     IF M->is_ins
  582.                         * make room for new field name
  583.                         array_ins(M->ch_field_n,ch_el[3])
  584.  
  585.                     ENDIF
  586.  
  587.                     * assign fieldname to array element
  588.                     ch_field_n[ch_el[3]] = M->f_n
  589.  
  590.                     * display the name of the newly selected field
  591.                     @ ch_cur_row[3],column[M->n] + 1;
  592.                     SAY pad(ch_field_n[ch_el[3]], 10)
  593.  
  594.                 ELSE
  595.                     * aborted entry..restore the window as it was
  596.                     RESTSCREEN(row_a[3], column[M->n] + 1,;
  597.                                row_x[3], column[M->n] + 11, M->temp_buff)
  598.  
  599.                 ENDIF
  600.         ENDCASE
  601.  
  602.     CASE M->keystroke = 7
  603.         * delete
  604.  
  605.         DO CASE
  606.  
  607.             CASE M->page = 2 .AND. .NOT. EMPTY(ch_ntx[ch_el[2]])
  608.                 * remove index file from list
  609.                 need_ntx = .T.    && must reset
  610.  
  611.                 IF ch_el[2] = 1
  612.                     * primary index..remove relations where target
  613.                     not_target(M->n, .T.)
  614.  
  615.                 ENDIF
  616.  
  617.                 * select work area n
  618.                 SELECT (M->n)
  619.  
  620.                 * ensure that n_files does not exceed actual open files
  621.                 CLOSE INDEX
  622.  
  623.                 * remove the filename from the list
  624.                 array_del(M->ch_ntx,ch_el[2])
  625.  
  626.                 * decrement global file counter
  627.                 n_files = M->n_files - 1
  628.  
  629.                 IF ch_cur_row[2] < row_x[2]
  630.                     * scroll up to remove filename from screen
  631.                     scroll(ch_cur_row[2],column[M->n] + 1,;
  632.                                 row_x[2],column[M->n] + 9,1)
  633.  
  634.                 ENDIF
  635.  
  636.                 * fill in blank row at bottom of window
  637.                 @ row_x[2],column[M->n] + 2;
  638.                 SAY pad(name(ch_ntx[ch_el[2] + row_x[2] - ch_cur_row[2]]), 8)
  639.  
  640.                 IF afull(M->ch_ntx) - ch_el[2] = row_x[2] - ch_cur_row[2]
  641.                     * remove the "more_down" indicator from the screen
  642.                     @ row_x[2],column[M->n] + 11 SAY " "
  643.  
  644.                 ENDIF
  645.  
  646.             CASE M->page = 3 .AND. .NOT. EMPTY(ch_field_n[ch_el[3]])
  647.                 * delete a fieldname from the current list
  648.                 need_field = .T.    && must reset
  649.  
  650.                 * remove the fieldname from the list
  651.                 array_del(M->ch_field_n,ch_el[3])
  652.  
  653.                 IF ch_cur_row[3] < row_x[3]
  654.                     * scroll up to remove fieldname from screen
  655.                     scroll(ch_cur_row[3],column[M->n] + 1,;
  656.                                 row_x[3],column[M->n] + 10,1)
  657.  
  658.                 ENDIF
  659.  
  660.                 * fill in blank row at bottom of window
  661.                 @ row_x[3],column[M->n] + 1;
  662.                 SAY pad(ch_field_n[ch_el[3] + row_x[3] - ch_cur_row[3]], 10)
  663.  
  664.                 IF afull(M->ch_field_n) - ch_el[3] = row_x[3] - ch_cur_row[3]
  665.                     * remove the "more_down" indicator from the screen
  666.                     @ row_x[3],column[M->n] + 11 SAY " "
  667.  
  668.                 ENDIF
  669.         ENDCASE
  670. ENDCASE
  671.  
  672. SetColor(saveColor)
  673. RETURN 0
  674.  
  675.  
  676. ******
  677. *    bar_menu()
  678. *
  679. *    verticle light bar selection menu for the main View screen
  680. *
  681. *    note: this routine is expected to return a value in "keystroke"
  682. *          to be processed by "set_view"
  683. ******
  684. FUNCTION bar_menu
  685.  
  686. PARAMETERS l, r, array
  687. local saveColor
  688. PRIVATE num_d, num_full, cur_el, rel_row, x, t, b
  689.  
  690. * look ahead at next keystroke
  691. keystroke = NEXTKEY()
  692.  
  693. IF CHR(M->keystroke) $ M->horiz_keys
  694.     * improve performance of horizontal cursor movement with quick return
  695.     INKEY()        && remove character from typeahead buffer
  696.     RETURN 0
  697.  
  698. ENDIF
  699.  
  700. * avoid costly array access by getting top and bottom of window to "t" and "b"
  701. t = row_a[M->page]
  702. b = row_x[M->page]
  703.  
  704. * get the number of active elements
  705. num_full = afull(M->array)
  706.  
  707. * and the number of displayable elements
  708. num_d = M->num_full
  709.  
  710. IF M->num_d < LEN(M->array)
  711.     * first empty element is included
  712.     num_d = M->num_d + 1
  713.  
  714.     * achoice() won't display a null string
  715.     array[M->num_d] = " "
  716.  
  717. ENDIF
  718.  
  719. * determine column offset to put "more_up" and "more_down" indicators
  720. x = IF(M->r - M->l > 7, 1, 2)
  721.  
  722. * it's all relative to achoice()
  723. rel_row = &cur_row[M->page] - M->t
  724.  
  725. * discard returned value
  726. saveColor := SetColor(M->color4)
  727. achoice(M->t, M->l, M->b, M->r, M->array, .T.,;
  728.         "bar_func", &el[M->page], M->rel_row)
  729. SetColor(saveColor)
  730.  
  731. * change back to absolute
  732. &cur_row[M->page] = M->rel_row + M->t
  733.  
  734. IF array[M->num_d] == " "
  735.     * kill the dummy
  736.     array[M->num_d] = ""
  737.  
  738. ENDIF
  739.  
  740. * check for menu request
  741. sysmenu()
  742.  
  743. RETURN 0
  744.  
  745.  
  746. ******
  747. *    bar_func()
  748. *
  749. *    function to be called from achoice() specifically for bar_menu()
  750. ******
  751. FUNCTION bar_func
  752.  
  753. PARAMETERS mode, bar_el, row
  754. PRIVATE ret_code
  755.  
  756. * get keystroke
  757. keystroke = LASTKEY()
  758.  
  759. * assume continue
  760. ret_code = 2
  761.  
  762. * maintain variables from above
  763. &el[M->page] = M->bar_el
  764. rel_row = M->row
  765.  
  766. IF M->error_on
  767.     * erase error message
  768.     error_off()
  769.  
  770. ENDIF
  771.  
  772. DO CASE
  773.  
  774.     CASE M->mode = 0
  775.         * idle..maintain correct "more_up" and "more_down" indicators
  776.         @ M->t, M->r + M->x SAY IF(M->bar_el > M->row + 1, M->more_up, " ")
  777.         @ M->b, M->r + M->x SAY IF(M->num_full >;
  778.                                    (M->bar_el + M->b - M->t - M->row),;
  779.                                 M->more_down, " ")
  780.  
  781.     CASE M->mode = 1 .OR. M->mode = 2
  782.         * attempt to cursor past top or end of list
  783.         ret_code = 0
  784.  
  785.     CASE M->mode = 3
  786.         * keystroke exception
  787.  
  788.         DO CASE
  789.  
  790.             CASE CHR(M->keystroke) $ M->horiz_keys
  791.                 * horizontal cursor key
  792.                 ret_code = 0
  793.  
  794.             CASE M->keystroke = 27
  795.                 * abort selection
  796.                 ret_code = 0
  797.  
  798.             CASE M->keystroke = 13
  799.                 * replace a View item
  800.                 ret_code = 1
  801.  
  802.             CASE isdata(M->keystroke)
  803.                 * character key...entry in place
  804.                 ret_code = 1
  805.  
  806.             CASE M->keystroke = 22 .OR. M->keystroke = 7
  807.                 * ins, del
  808.                 ret_code = 1
  809.  
  810.             CASE menu_key() <> 0
  811.                 * menu request
  812.                 ret_code = 0
  813.  
  814.         ENDCASE
  815.  
  816.     CASE M->mode = 4
  817.         * nothing selectable
  818.         ret_code = 0
  819.  
  820. ENDCASE
  821.  
  822. RETURN M->ret_code
  823.  
  824.  
  825. ******
  826. *    list_array()
  827. *
  828. *    list array elements vertically in window
  829. ******
  830. FUNCTION list_array
  831.  
  832. PARAMETERS t, l, b, r, array, top_el
  833. local saveColor
  834. PRIVATE bottom_el, num_full, x
  835.  
  836. saveColor := SetColor(M->color4)
  837. IF .NOT. EMPTY(array[M->top_el])
  838.     * something to list..calculate number of last element in window
  839.     bottom_el = M->top_el + M->b - M->t
  840.  
  841.     * get number of non-empty elements
  842.     num_full = afull(M->array)
  843.  
  844.     * determine column offset of "more_up" and "more_down" indicators
  845.     x = IF(M->r - M->l > 7, 1, 2)
  846.  
  847.     IF M->top_el > 1 .AND. M->bottom_el = M->num_full + 1
  848.         * prevent achoice() from making adjustments
  849.         array[M->bottom_el] = " "
  850.  
  851.     ENDIF
  852.  
  853.     * display only and return without waiting for a keystroke
  854.     achoice(M->t, M->l, M->b, M->r, M->array, .F., "", M->top_el)
  855.     SetColor(M->color1)
  856.  
  857.     * update status of "more_up" and "more_down" indicators
  858.     @ M->t, M->r + M->x SAY IF(M->top_el > 1, M->more_up, " ")
  859.     @ M->b, M->r + M->x SAY IF(M->bottom_el < M->num_full, M->more_down, " ")
  860.  
  861.     IF array[M->bottom_el] == " "
  862.         * restore to null string
  863.         array[M->bottom_el] = ""
  864.  
  865.     ENDIF
  866. ENDIF
  867.  
  868. SetColor(saveColor)
  869. RETURN 0
  870.  
  871.  
  872. ******
  873. *    set_deflt()
  874. *
  875. *    set defaults for open and create pull-down menus
  876. ******
  877. FUNCTION set_deflt
  878.  
  879. IF M->page = 2
  880.     * cursor in index file list..default to open index and create index
  881.     STORE 2 TO menu_deflt[2], menu_deflt[3]
  882.  
  883. ELSE
  884.     * default to open database and create database
  885.     STORE 1 TO menu_deflt[2], menu_deflt[3]
  886.  
  887. ENDIF
  888.  
  889. RETURN 0
  890.  
  891.  
  892. ******
  893. *    bline()
  894. *
  895. *    build a new bar line for the main View screen
  896. ******
  897. FUNCTION bline
  898.  
  899. PARAMETERS num_slots
  900. PRIVATE i, k
  901.  
  902. IF num_slots < 6
  903.     * add one empty slot
  904.     num_slots = num_slots + 1
  905.  
  906. ENDIF
  907.  
  908. * the first slot is diferent than the rest
  909. bar_line = "════════════"
  910. empty_line = ""
  911.  
  912. k = 1
  913.  
  914. DO WHILE M->k < M->num_slots
  915.     * each new slot separated from previous by a vertical line
  916.     bar_line = M->bar_line + "╤════════════"
  917.     empty_line = M->empty_line + SPACE(12) + "│"
  918.  
  919.     * next
  920.     k = M->k + 1
  921.  
  922. ENDDO
  923.  
  924. * calculate value to center the entire View screen
  925. i = INT((80 - LEN(M->bar_line)) / 2)
  926.  
  927. FOR k = 1 TO M->num_slots
  928.     * establish screen columns for all active slots
  929.     column[M->k] = M->i + (13 * (M->k - 1))
  930.  
  931. NEXT
  932.  
  933. RETURN 0
  934.  
  935.  
  936. ******
  937. *    draw_view()
  938. *
  939. *    fill the main View screen
  940. *
  941. *    note: the parameter indicates which channel is to be the
  942. *          dummy for operations in progress, zero for no dummy
  943. ******
  944. FUNCTION draw_view
  945.  
  946. PARAMETERS blank_area
  947. PRIVATE i, j, ntx, field_n, el, cur_row, strnum
  948.  
  949. * get number of active work areas
  950. i = afull(M->dbf)
  951.  
  952. IF M->i < 6 .AND. blank_area <> 0
  953.     * add one for the dummy
  954.     i = M->i + 1
  955.  
  956. ENDIF
  957.  
  958. * build the bar_line and empty_line strings
  959. bline(M->i)
  960.  
  961. * clear the deck and draw a blank template
  962. @ 4,0 CLEAR
  963.  
  964. * page 1..names of data files
  965. @ row_a[1] - 2,37 SAY "Files"
  966. @ row_a[1] - 1,column[1] SAY M->bar_line
  967. @ row_a[1],column[1] SAY M->empty_line
  968.  
  969. * page 2..names of index files
  970. @ row_a[2] - 2,36 SAY "Indexes"
  971. @ row_a[2] - 1,column[1] SAY M->bar_line
  972. @ row_a[2],column[1] SAY M->empty_line
  973. @ row_a[2] + 1,column[1] SAY M->empty_line
  974. @ row_a[2] + 2,column[1] SAY M->empty_line
  975.  
  976. * page 3..active fields lists
  977. @ row_a[3] - 2,37 SAY "Fields"
  978. @ row_a[3] - 1,column[1] SAY M->bar_line
  979.  
  980. FOR i = row_a[3] TO row_x[3]
  981.     * complete the blank template
  982.     @ M->i,column[1] SAY M->empty_line
  983.  
  984. NEXT
  985.  
  986. i = 1
  987. j = 1
  988.  
  989. DO WHILE M->j <= 6
  990.  
  991.     IF EMPTY(dbf[M->i])
  992.         * no more active work areas
  993.         EXIT
  994.  
  995.     ENDIF
  996.  
  997.     IF M->j <> M->blank_area
  998.         * channel needs filling
  999.         strnum = SUBSTR("123456", M->i, 1)
  1000.  
  1001.         * set to channel "i"
  1002.         ntx = "ntx" + strnum
  1003.         field_n = "field_n" + strnum
  1004.       el = "_el" + strnum
  1005.       cur_row = "_cr" + strnum
  1006.  
  1007.         * fill the channel
  1008.         ch_draw = .T.
  1009.         channel(&ntx, &field_n, &el, &cur_row, M->j, M->i)
  1010.  
  1011.         * next real channel
  1012.         i = M->i + 1
  1013.  
  1014.     ENDIF
  1015.  
  1016.     * next display channel
  1017.     j = M->j + 1
  1018.  
  1019. ENDDO
  1020.  
  1021. RETURN 0
  1022.  
  1023.  
  1024. ******
  1025. *    d_copy()
  1026. *
  1027. *    create a filename only array (no paths or extensions)
  1028. ******
  1029. FUNCTION d_copy
  1030.  
  1031. PARAMETERS array
  1032. PRIVATE i
  1033.  
  1034. * clear the dedicated array
  1035. afill(M->d_array, "")
  1036.  
  1037. i = 1
  1038.  
  1039. DO WHILE M->i <= LEN(M->array)
  1040.  
  1041.     IF EMPTY(array[M->i])
  1042.         * end of active list
  1043.         EXIT
  1044.  
  1045.     ENDIF
  1046.  
  1047.     * assign the extracted name
  1048.     d_array[M->i] = name(array[M->i])
  1049.  
  1050.     * next
  1051.     i = M->i + 1
  1052.  
  1053. ENDDO
  1054.  
  1055. RETURN 0
  1056.  
  1057.  
  1058. ******
  1059. *    open_dbf()
  1060. *
  1061. *    open data file in the specified work area
  1062. ******
  1063. FUNCTION open_dbf
  1064.  
  1065. PARAMETERS is_insert, not_view
  1066. PRIVATE shift, filename, a_temp, f_row, d_col, ret_val, old_help
  1067.  
  1068. IF M->n_files >= 14
  1069.     error_msg("Too many files open")
  1070.     RETURN .F.
  1071.  
  1072. ENDIF
  1073.  
  1074. * save old and set new help codes
  1075. old_help = M->help_code
  1076. help_code = 6
  1077.  
  1078. * initialize private variables
  1079. filename = ""
  1080.  
  1081. * coordinate of filename on View screen
  1082. f_row = _cr1[1]
  1083. d_col = column[M->cur_area] + 2
  1084.  
  1085. * shift = 1 for major insertion
  1086. shift = IF(M->is_insert, 1, 0)
  1087.  
  1088. * select the current work area
  1089. SELECT (M->cur_area)
  1090.  
  1091. IF M->not_view
  1092.     * not called from "set_view"
  1093.     filename = M->cur_dbf
  1094.     ret_val = do_opendbf()
  1095.  
  1096. ELSE
  1097.     * assume file not opened
  1098.     ret_val = .F.
  1099.  
  1100.     IF isdata(M->keystroke)
  1101.         * forward the data character to the GET system
  1102.         KEYBOARD CHR(M->keystroke)
  1103.  
  1104.         * entry in place
  1105.         filename = enter_rc(dbf[M->cur_area],M->f_row,M->d_col,64,"@K!S8",;
  1106.                             M->color1)
  1107.  
  1108.         IF .NOT. EMPTY(M->filename)
  1109.             * something entered
  1110.  
  1111.             IF .NOT. (RAT(".", M->filename) > RAT("\", M->filename))
  1112.                 * no extension entered..provide default
  1113.                 filename = M->filename + ".DBF"
  1114.  
  1115.             ENDIF
  1116.  
  1117.             * try to open the file
  1118.             ret_val = do_opendbf()
  1119.  
  1120.             IF .NOT. M->ret_val
  1121.                 * failed..restore the screen
  1122.                 @ M->f_row, M->d_col SAY pad(name(M->cur_dbf), 8)
  1123.  
  1124.             ENDIF
  1125.  
  1126.         ELSE
  1127.             * aborted entry..restore the screen
  1128.             @ M->f_row, M->d_col SAY pad(name(M->cur_dbf), 8)
  1129.  
  1130.         ENDIF
  1131.  
  1132.         IF menu_key() <> 0
  1133.             * forward menu key to "set_view"
  1134.             KEYBOARD CHR(M->keystroke)
  1135.  
  1136.         ELSE
  1137.             * avoid confusion
  1138.             keystroke = 0
  1139.  
  1140.         ENDIF
  1141.  
  1142.     ELSE
  1143.         * insert or enter or menu selection..use filebox
  1144.         ret_val = filebox(".DBF", "dbf_list", "dopen_titl",;
  1145.                           "do_opendbf", .F., 8) <> 0
  1146.  
  1147.     ENDIF
  1148. ENDIF
  1149.  
  1150. IF M->ret_val
  1151.     * default field arrays to all fields
  1152.     a_temp = "field_n" + SUBSTR("123456", M->cur_area, 1)
  1153.    all_fields(M->cur_area, &a_temp)
  1154.  
  1155.     * re-set current row for indexes and fields
  1156.    a_temp = "_cr" + SUBSTR("123456", M->cur_area, 1)
  1157.    &a_temp[2] = row_a[2]
  1158.    &a_temp[3] = row_a[3]
  1159.  
  1160.     * re-set current elements
  1161.    a_temp = "_el" + SUBSTR("123456", M->cur_area, 1)
  1162.    afill(&a_temp, 1)
  1163.  
  1164. ENDIF
  1165.  
  1166. * restore help code
  1167. help_code = M->old_help
  1168.  
  1169. RETURN M->ret_val
  1170.  
  1171.  
  1172. ******
  1173. *    dopen_titl()
  1174. *
  1175. *    display title for data file to open
  1176. ******
  1177. FUNCTION dopen_titl
  1178.  
  1179. PARAMETERS sysparam
  1180.  
  1181. RETURN box_title(M->sysparam, "Open data file...")
  1182.  
  1183.  
  1184. ******
  1185. *    do_opendbf()
  1186. *
  1187. *    set up and open a data file
  1188. ******
  1189. FUNCTION do_opendbf
  1190.  
  1191. PRIVATE done
  1192.  
  1193. DO CASE
  1194.  
  1195.     CASE EMPTY(M->filename)
  1196.         error_msg("Data file not selected")
  1197.         done = .F.
  1198.  
  1199.     CASE .NOT. FILE(M->filename)
  1200.         error_msg("Can't open " + M->filename)
  1201.         done = .F.
  1202.  
  1203.     CASE aseek(M->dbf, M->filename) > 0 .AND.;
  1204.          .NOT. (dbf[M->cur_area] == M->filename .AND. M->shift = 0)
  1205.         error_msg("Data file would be open in two areas")
  1206.         done = .F.
  1207.  
  1208.     OTHERWISE
  1209.         stat_msg("Opening File")
  1210.  
  1211.         IF .NOT. EMPTY(dbf[M->cur_area])
  1212.             * clear the current work area
  1213.             clear_dbf(M->cur_area, M->shift)
  1214.  
  1215.         ENDIF
  1216.  
  1217.         * open the file in the current area
  1218.         SELECT (M->cur_area)
  1219.  
  1220.       IF NetUse( filename )
  1221.  
  1222.          * adjust global variable
  1223.          n_files = M->n_files + 1
  1224.  
  1225.          * assign the filename to global array
  1226.          dbf[M->cur_area] = M->filename
  1227.  
  1228.          done = .T.
  1229.  
  1230.       ELSE
  1231.  
  1232.          done := .F.
  1233.  
  1234.       ENDIF
  1235.  
  1236.       * clear the message
  1237.       stat_msg("")
  1238.  
  1239. ENDCASE
  1240.  
  1241. RETURN M->done
  1242.  
  1243.  
  1244. ******
  1245. *    get_ntx()
  1246. *
  1247. *    select index files for the current work area
  1248. ******
  1249. FUNCTION get_ntx
  1250.  
  1251. PARAMETERS d_row, d_col, org_file, is_ins
  1252. PRIVATE filename, old_help
  1253.  
  1254. IF M->n_files >= 14
  1255.     error_msg("Too many files open")
  1256.     RETURN ""
  1257.  
  1258. ENDIF
  1259.  
  1260. * save old and set new help codes
  1261. old_help = M->help_code
  1262. help_code = 8
  1263.  
  1264. * initialize private variable
  1265. filename = ""
  1266.  
  1267. IF isdata(M->keystroke)
  1268.     * forward data keystroke to GET system
  1269.     KEYBOARD CHR(M->keystroke)
  1270.  
  1271.     * entry in place
  1272.     filename = enter_rc(M->org_file,M->d_row,M->d_col,64,"@K!S8",M->color1)
  1273.  
  1274.     IF .NOT. EMPTY(M->filename)
  1275.         * something entered
  1276.  
  1277.         IF .NOT. (RAT(".", M->filename) > RAT("\", M->filename))
  1278.             * extension not entered..provide default
  1279.             filename = filename + INDEXEXT()
  1280.  
  1281.         ENDIF
  1282.  
  1283.         IF .NOT. do_openntx()
  1284.             * failed..return null string
  1285.             filename = ""
  1286.  
  1287.         ENDIF
  1288.     ENDIF
  1289.  
  1290.     IF menu_key() <> 0
  1291.         * forward menu request to "set_view"
  1292.         KEYBOARD CHR(M->keystroke)
  1293.  
  1294.     ELSE
  1295.         * avoid confusion
  1296.         keystroke = 0
  1297.  
  1298.     ENDIF
  1299.  
  1300. ELSE
  1301.  
  1302.     IF filebox(INDEXEXT(),"ntx_list","xopen_titl","do_openntx",.F.,13) = 0
  1303.         * no selection..return null string
  1304.         filename = ""
  1305.  
  1306.     ENDIF
  1307. ENDIF
  1308.  
  1309. * restore help code
  1310. help_code = M->old_help
  1311.  
  1312. RETURN M->filename
  1313.  
  1314.  
  1315. ******
  1316. *    xopen_titl()
  1317. *
  1318. *    display title for index file to open
  1319. ******
  1320. FUNCTION xopen_titl
  1321.  
  1322. PARAMETERS sysparam
  1323.  
  1324. RETURN box_title(M->sysparam, "Open index file...")
  1325.  
  1326.  
  1327. ******
  1328. *    do_openntx()
  1329. *
  1330. *    verify the selectability of an index file
  1331. ******
  1332. FUNCTION do_openntx
  1333.  
  1334. PRIVATE done
  1335.  
  1336. DO CASE
  1337.  
  1338.     CASE EMPTY(M->filename)
  1339.         error_msg("Index file not selected")
  1340.         done = .F.
  1341.  
  1342.     CASE .NOT. FILE(M->filename)
  1343.         error_msg("Can't open " + M->filename)
  1344.         done = .F.
  1345.  
  1346.     CASE dup_ntx(M->filename) <> 0 .AND.;
  1347.          (M->is_ins .OR. .NOT. M->filename == M->org_file)
  1348.         error_msg("Index file already open")
  1349.         done = .F.
  1350.  
  1351.     OTHERWISE
  1352.         * filename may be selected
  1353.  
  1354.         IF EMPTY(M->org_file) .OR. M->is_ins
  1355.             * adjust global variable
  1356.             n_files = M->n_files + 1
  1357.  
  1358.         ENDIF
  1359.  
  1360.         done = .T.
  1361.  
  1362. ENDCASE
  1363.  
  1364. RETURN M->done
  1365.  
  1366.  
  1367. ******
  1368. *    get_field()
  1369. *
  1370. *    add a field to an individual field list
  1371. ******
  1372. FUNCTION get_field
  1373.  
  1374. PARAMETERS f_row, d_col, work_area, org_field
  1375. PRIVATE field_mvar, rel_row, cur_el, okee_dokee, fi_disp, old_help
  1376.  
  1377. * save old and set new help codes
  1378. old_help = M->help_code
  1379. help_code = 2
  1380.  
  1381. * initialize variable to contain fieldname
  1382. field_mvar = ""
  1383.  
  1384. * select the specified work area
  1385. SELECT (M->work_area)
  1386.  
  1387. * get master field list into local array for selection
  1388. DECLARE field_m[FCOUNT()]
  1389. all_fields(M->work_area, M->field_m)
  1390.  
  1391. IF isdata(M->keystroke)
  1392.     * forward the data keystroke to the GET system
  1393.     KEYBOARD CHR(M->keystroke)
  1394.  
  1395.     * entry in place
  1396.     field_mvar = enter_rc(M->org_field,M->f_row,M->d_col,10,"@K!",M->color1)
  1397.  
  1398.     IF .NOT. EMPTY(M->field_mvar)
  1399.         * something entered
  1400.  
  1401.         IF .NOT. do_fsel()
  1402.             * failed..return null string
  1403.             field_mvar = ""
  1404.  
  1405.         ENDIF
  1406.  
  1407.     ENDIF
  1408.  
  1409.     IF menu_key() <> 0
  1410.         * forward the menu request to "set_view"
  1411.         KEYBOARD CHR(M->keystroke)
  1412.  
  1413.     ELSE
  1414.         * avoid confusion
  1415.         keystroke = 0
  1416.  
  1417.     ENDIF
  1418.  
  1419. ELSE
  1420.     * establish arrays for multibox
  1421.     DECLARE boxarray[5]
  1422.  
  1423.     boxarray[1] = "fsel_title(sysparam)"
  1424.     boxarray[2] = "getfield(sysparam)"
  1425.     boxarray[3] = "ok_button(sysparam)"
  1426.     boxarray[4] = "can_button(sysparam)"
  1427.     boxarray[5] = "fieldlist(sysparam)"
  1428.  
  1429.     * initialize private variables
  1430.     cur_el = 1
  1431.     rel_row = 0
  1432.  
  1433.     * where the action is
  1434.     okee_dokee = "do_fsel()"
  1435.     fi_disp = "getfield(3)"
  1436.  
  1437.     IF multibox(7, 17, 5, 5, M->boxarray) = 0
  1438.         * failed or aborted..return null string
  1439.         field_mvar = ""
  1440.  
  1441.     ENDIF
  1442. ENDIF
  1443.  
  1444. * restore help code
  1445. help_code = M->old_help
  1446.  
  1447. RETURN M->field_mvar
  1448.  
  1449.  
  1450. ******
  1451. *    getfield()
  1452. *
  1453. *    process fieldname entry blank (called from multibox)
  1454. ******
  1455. FUNCTION getfield
  1456.  
  1457. PARAMETERS sysparam
  1458.  
  1459. RETURN genfield(M->sysparam, .F.)
  1460.  
  1461.  
  1462. ******
  1463. *    fsel_title()
  1464. *
  1465. *    display title for field selection
  1466. ******
  1467. FUNCTION fsel_title
  1468.  
  1469. PARAMETERS sysparam
  1470.  
  1471. RETURN box_title(M->sysparam, "Select field...")
  1472.  
  1473.  
  1474. ******
  1475. *    do_fsel()
  1476. *
  1477. *    validate field selection
  1478. ******
  1479. FUNCTION do_fsel
  1480.  
  1481. PRIVATE done
  1482.  
  1483. DO CASE
  1484.  
  1485.     CASE EMPTY(M->field_mvar)
  1486.         error_msg("Field name not selected")
  1487.         done = .F.
  1488.  
  1489.     CASE aseek(M->field_m, M->field_mvar) = 0
  1490.         * needed for entry in place
  1491.         error_msg(M->field_mvar + " does not exist")
  1492.         done = .F.
  1493.  
  1494.     OTHERWISE
  1495.         * field exists..no problem
  1496.         done = .T.
  1497.  
  1498. ENDCASE
  1499.  
  1500. RETURN M->done
  1501.  
  1502.  
  1503. ******
  1504. *    set_relation()
  1505. *
  1506. *    interface for editing the list of relations
  1507. *
  1508. *    note: the relations window can display a maximum
  1509. *          of six (6) relationships at one time
  1510. ******
  1511. FUNCTION set_relation
  1512. local saveColor
  1513. PRIVATE c_row, c_el, rel_buff, pos_r, width, old_help, k, n_area, ls, lk, lt,;
  1514.         cNorm, cHilite
  1515.  
  1516. cNorm := color7
  1517. cHilite:= color2
  1518. saveColor := SetColor(M->cNorm)
  1519.  
  1520. * save old and set new help codes
  1521. old_help = M->help_code
  1522. help_code = 9
  1523.  
  1524. * prevent certain menu selections with multibox mechanism
  1525. box_open = .T.
  1526.  
  1527. IF EMPTY(M->bar_line)
  1528.     * need bar line for vertical reference
  1529.     bline(afull(M->dbf))
  1530.  
  1531. ENDIF
  1532.  
  1533. * window has variable width
  1534. width = LEN(M->bar_line) - 1
  1535.  
  1536. * establish easy reference to right most column
  1537. pos_r = column[1] + M->width
  1538.  
  1539. * save the window
  1540. rel_buff = SAVESCREEN(8, column[1] - 1, 23, M->pos_r + 1)
  1541.  
  1542. * clear and frame the window
  1543. scroll(8, column[1] - 1, 23, M->pos_r + 1, 0)
  1544. @ 8, column[1] - 1, 23, M->pos_r + 1 BOX M->frame
  1545.  
  1546. * display the heading and bar line
  1547. @ 9,35 SAY "Relations"
  1548. @ 10,column[1] SAY M->bar_line
  1549.  
  1550. * initialize current row and element
  1551. c_row = 11
  1552. c_el = 1
  1553.  
  1554. * initial window fill
  1555. draw_relat(1)
  1556.  
  1557. * global key value..zero is convenient for branch to "otherwise" case below
  1558. keystroke = 0
  1559.  
  1560. DO WHILE .NOT. q_check()
  1561.     * one big switch..exit condition determined elsewhere
  1562.  
  1563.     DO CASE
  1564.  
  1565.         CASE M->keystroke = 18
  1566.             * PgUp
  1567.  
  1568.             IF M->c_el > ((M->c_row - 11) / 2) + 1
  1569.                 * elements off screen..move up one page
  1570.                 c_el = M->c_el - 5
  1571.  
  1572.                 IF M->c_el < ((M->c_row - 11) / 2) + 1
  1573.                     * minimum element for this row
  1574.                     c_el = ((M->c_row - 11) / 2) + 1
  1575.  
  1576.                 ENDIF
  1577.  
  1578.                 * re-write relations window
  1579.                 draw_relat(M->c_el - ((M->c_row - 11) / 2))
  1580.  
  1581.             ELSE
  1582.                 * first element is on screen
  1583.  
  1584.                 IF M->c_el > 1
  1585.                     * move to top of list
  1586.                     c_el = 1
  1587.                     c_row = 11
  1588.  
  1589.                 ENDIF
  1590.             ENDIF
  1591.  
  1592.             keystroke = 0
  1593.  
  1594.         CASE M->keystroke = 3
  1595.             * PgDn..determine maximum allowable cursor element
  1596.             k = afull(M->k_relate)
  1597.  
  1598.             IF M->k < LEN(M->k_relate)
  1599.                 * first empty element is allowed
  1600.                 k = M->k + 1
  1601.  
  1602.             ENDIF
  1603.  
  1604.             IF M->c_el < M->k - ((21 - M->c_row) / 2)
  1605.                 * elements off screen..down one page
  1606.                 c_el = M->c_el + 5
  1607.  
  1608.                 IF M->c_el > M->k - ((21 - M->c_row) / 2)
  1609.                     * maximum element for this row
  1610.                     c_el = M->k - ((21 - M->c_row) / 2)
  1611.  
  1612.                 ENDIF
  1613.  
  1614.                 * re-write relations window
  1615.                 draw_relat(M->c_el - ((M->c_row - 11) / 2))
  1616.  
  1617.             ELSE
  1618.                 * last allowable element is on screen
  1619.  
  1620.                 IF M->c_el < M->k
  1621.                     * move to bottom of list
  1622.                     c_row = M->c_row + ((M->k - M->c_el) * 2)
  1623.                     c_el = M->k
  1624.  
  1625.                 ENDIF
  1626.             ENDIF
  1627.  
  1628.             keystroke = 0
  1629.  
  1630.         CASE M->keystroke = 22 .OR. isdata(M->keystroke)
  1631.             * insert or character key..insert a relation
  1632.  
  1633.             * k = number of first relation off screen
  1634.             k = M->c_el + ((21 - M->c_row) / 2 ) + 1
  1635.  
  1636.             * save the last relationship
  1637.             ls = s_relate[LEN(M->s_relate)]
  1638.             lk = k_relate[LEN(M->k_relate)]
  1639.             lt = t_relate[LEN(M->t_relate)]
  1640.  
  1641.             * do the insert..assume relation will be entered
  1642.             array_ins(M->s_relate, M->c_el)
  1643.             array_ins(M->k_relate, M->c_el)
  1644.             array_ins(M->t_relate, M->c_el)
  1645.  
  1646.             IF M->c_row < 21
  1647.                 * make room on screen..scroll down 2 lines
  1648.                 scroll(M->c_row, column[1], 22, M->pos_r - 1, -2)
  1649.  
  1650.             ELSE
  1651.                 * clear the last row
  1652.                 @ M->c_row + 1,column[1] SAY SPACE(M->width)
  1653.  
  1654.             ENDIF
  1655.  
  1656.             IF M->k <= LEN(M->k_relate)
  1657.                 * k is within subscript range
  1658.  
  1659.                 IF .NOT. EMPTY(k_relate[M->k])
  1660.                     * off-screen element is active
  1661.                     @ 22, M->pos_r SAY M->more_down
  1662.  
  1663.                 ENDIF
  1664.             ENDIF
  1665.  
  1666.             * accept input of new relation
  1667.             get_relation(M->c_row, M->c_el)
  1668.  
  1669.             IF .NOT. EMPTY(k_relate[M->c_el])
  1670.                 * relation has been entered..show it
  1671.                 disp_relation(M->c_row, M->c_el, color7)
  1672.  
  1673.             ELSE
  1674.                 * relation not entered..cannot delete a null string
  1675.                 STORE "x" TO s_relate[M->c_el],;
  1676.                              k_relate[M->c_el], t_relate[M->c_el]
  1677.  
  1678.                 * restore arrays
  1679.                 array_del(M->s_relate, M->c_el)
  1680.                 array_del(M->k_relate, M->c_el)
  1681.                 array_del(M->t_relate, M->c_el)
  1682.  
  1683.                 * restore last relationship
  1684.                 s_relate[LEN(M->s_relate)] = M->ls
  1685.                 k_relate[LEN(M->k_relate)] = M->lk
  1686.                 t_relate[LEN(M->t_relate)] = M->lt
  1687.  
  1688.                 IF M->c_row < 21
  1689.                     * close the gap on the screen..scroll up 2 lines
  1690.                     scroll(M->c_row, column[1], 22, M->pos_r - 1, 2)
  1691.  
  1692.                 ELSE
  1693.                     * erase the deleted relation from screen
  1694.                     @ 21,column[1] SAY SPACE(M->width)
  1695.                     @ 22,column[1] SAY SPACE(M->width)
  1696.  
  1697.                 ENDIF
  1698.  
  1699.                 * fill in the last relation on screen
  1700.                 disp_relation(21,M->c_el+((21-M->c_row)/2),color7)
  1701.  
  1702.             ENDIF
  1703.  
  1704.             IF M->k <= LEN(M->k_relate)
  1705.                 * k is within subscript range
  1706.  
  1707.                 IF EMPTY(k_relate[M->k])
  1708.                     * off-screen element not active
  1709.                     @ 22, M->pos_r SAY " "
  1710.  
  1711.                 ENDIF
  1712.             ENDIF
  1713.  
  1714.             keystroke = 0
  1715.  
  1716.         CASE M->keystroke = 13
  1717.             * enter key..change a relationship
  1718.             get_relation(M->c_row, M->c_el)
  1719.  
  1720.             * display the change
  1721.             disp_relation(M->c_row, M->c_el, color7)
  1722.  
  1723.             keystroke = 0
  1724.  
  1725.         CASE M->keystroke = 7 .AND. .NOT. EMPTY(k_relate[M->c_el])
  1726.             * remove a relation from the list
  1727.             need_relat = .T.    && will need to reset
  1728.  
  1729.             * select the source work area
  1730.             n_area = ASC(s_relate[M->c_el]) - ASC("A") + 1
  1731.             SELECT (M->n_area)
  1732.  
  1733.             * turn off relations from this work area
  1734.             SET RELATION TO
  1735.  
  1736.             * remove the relation from list
  1737.             array_del(M->s_relate, M->c_el)
  1738.             array_del(M->k_relate, M->c_el)
  1739.             array_del(M->t_relate, M->c_el)
  1740.  
  1741.             IF M->c_row < 21
  1742.                 * close the gap on the screen
  1743.                 scroll(M->c_row, column[1], 22, M->pos_r - 1, 2)
  1744.  
  1745.             ELSE
  1746.                 * last row erase the deleted relation from screen
  1747.                 @ 21,column[1] SAY SPACE(M->width)
  1748.                 @ 22,column[1] SAY SPACE(M->width)
  1749.  
  1750.             ENDIF
  1751.  
  1752.             * fill in the last relation on screen
  1753.             disp_relation(21, M->c_el + ((21 - M->c_row) / 2), color7)
  1754.  
  1755.             IF M->c_el < LEN(M->k_relate) - ((21 - M->c_row) / 2)
  1756.                 * off-screen element is within subscript range
  1757.  
  1758.                 IF EMPTY(k_relate[M->c_el + ((21 - M->c_row) / 2) + 1])
  1759.                     * remove "more_down" indicator from screen
  1760.                     @ 22, M->pos_r SAY " "
  1761.  
  1762.                 ENDIF
  1763.             ENDIF
  1764.  
  1765.             keystroke = 0
  1766.  
  1767.         CASE M->keystroke = 5 .AND. M->c_el > 1
  1768.             * up arrow..move up one element
  1769.             c_el = M->c_el - 1
  1770.  
  1771.             IF M->c_row > 11
  1772.                 * room to move up on screen
  1773.                 c_row = M->c_row - 2
  1774.  
  1775.             ELSE
  1776.                 * scroll entire window down 2 lines
  1777.                 scroll(11, column[1], 22, M->pos_r - 1, -2)
  1778.  
  1779.                 * fill in the top row
  1780.                 disp_relation(11, M->c_el, color7)
  1781.  
  1782.                 IF M->c_el <= LEN(M->k_relate) - 6
  1783.                     * off-screen element within subscript range
  1784.  
  1785.                     IF .NOT. EMPTY(k_relate[M->c_el + 6])
  1786.                         * off-screen element is active
  1787.                         @ 22, M->pos_r SAY M->more_down
  1788.  
  1789.                     ENDIF
  1790.                 ENDIF
  1791.  
  1792.                 IF M->c_el = 1
  1793.                     * first element brought onto screen..no "more_up"
  1794.                     @ 11,M->pos_r SAY " "
  1795.  
  1796.                 ENDIF
  1797.             ENDIF
  1798.  
  1799.             keystroke = 0
  1800.  
  1801.         CASE M->keystroke = 24 .AND. .NOT.;
  1802.              (EMPTY(k_relate[M->c_el]) .OR. M->c_el = LEN(M->k_relate))
  1803.             * down arrow..move down one element
  1804.             c_el = M->c_el + 1
  1805.  
  1806.             IF c_row < 22 - 2
  1807.                 * room to move down on screen
  1808.                 c_row = M->c_row + 2
  1809.  
  1810.             ELSE
  1811.                 * scroll entire window up 2 lines
  1812.                 scroll(11, column[1], 22, M->pos_r - 1, 2)
  1813.  
  1814.                 * definitely more up
  1815.                 @ 11,M->pos_r SAY M->more_up
  1816.  
  1817.                 IF .NOT. EMPTY(k_relate[M->c_el])
  1818.                     * fill in the bottom row
  1819.                     disp_relation(21, M->c_el, color7)
  1820.  
  1821.                 ENDIF
  1822.  
  1823.                 IF M->c_el < LEN(M->k_relate)
  1824.                     * off-screen element within subscript range
  1825.  
  1826.                     IF EMPTY(k_relate[M->c_el + 1])
  1827.                         * erase "more_down" indicator from screen
  1828.                         @ 22,M->pos_r SAY " "
  1829.  
  1830.                     ENDIF
  1831.  
  1832.                 ELSE
  1833.                     * no off-screen element..erase "more_down" indicator
  1834.                     @ 22,M->pos_r SAY " "
  1835.  
  1836.                 ENDIF
  1837.             ENDIF
  1838.  
  1839.             keystroke = 0
  1840.  
  1841.         CASE M->local_func = 1
  1842.             * "help" selected from pull-down menu
  1843.             DO syshelp
  1844.             keystroke = 0
  1845.  
  1846.         OTHERWISE
  1847.             * get new keystroke
  1848.  
  1849.             IF .NOT. key_ready()
  1850.                 * no key pending..hilite the current item
  1851.                 disp_relation(M->c_row, M->c_el, cHilite)
  1852.  
  1853.                 * display a blob of light if element empty
  1854.                 SetColor(M->cHilite)
  1855.                 @ M->c_row,column[1] + 2;
  1856.                 SAY IF(EMPTY(k_relate[M->c_el]), " ", "")
  1857.                 SetColor(M->cNorm)
  1858.  
  1859.                 * wait for keystroke
  1860.                 read_key()
  1861.  
  1862.                 * re-write the current item as normal
  1863.                 disp_relation(M->c_row, M->c_el, cNorm)
  1864.  
  1865.                 @ M->c_row, column[1] + 2 SAY ""
  1866.  
  1867.             ENDIF
  1868.     ENDCASE
  1869. ENDDO
  1870.  
  1871. * restore the window
  1872. RESTSCREEN(8, column[1] - 1, 23, M->pos_r + 1, M->rel_buff)
  1873.  
  1874. * restore the help code
  1875. help_code = M->old_help
  1876.  
  1877. * restore access to menu options
  1878. box_open = .F.
  1879.  
  1880. * avoid confusion
  1881. keystroke = 0
  1882. SetColor(saveColor)
  1883. RETURN 0
  1884.  
  1885.  
  1886. ******
  1887. *    draw_relat()
  1888. *
  1889. *    fill the relations window
  1890. ******
  1891. FUNCTION draw_relat
  1892.  
  1893. PARAMETERS start_el
  1894. PRIVATE i
  1895.  
  1896. * clear the window
  1897. scroll(11, column[1], 22, M->pos_r, 0)
  1898.  
  1899. i = 0
  1900.  
  1901. DO WHILE M->i < 6 .AND. M->start_el + M->i <= LEN(M->k_relate)
  1902.  
  1903.     IF EMPTY(k_relate[M->start_el + M->i])
  1904.         * end of active list
  1905.         EXIT
  1906.  
  1907.     ENDIF
  1908.  
  1909.     * display one relation
  1910.     disp_relation(11 + (2 * M->i), M->start_el + M->i, color7)
  1911.  
  1912.     * next
  1913.     i = M->i + 1
  1914.  
  1915. ENDDO
  1916.  
  1917. IF M->start_el > 1
  1918.     * indicate active elements above window
  1919.     @ 11, M->pos_r SAY M->more_up
  1920.  
  1921. ENDIF
  1922.  
  1923. IF M->start_el + M->i <= LEN(M->k_relate)
  1924.     * off-screen element within subscript range
  1925.  
  1926.     IF .NOT. EMPTY(k_relate[M->start_el + M->i])
  1927.         * indicate active elements below window
  1928.         @ 22, M->pos_r SAY M->more_down
  1929.  
  1930.     ENDIF
  1931. ENDIF
  1932.  
  1933. RETURN 0
  1934.  
  1935.  
  1936. ******
  1937. *    get_relation()
  1938. *
  1939. *    accept entry of one relationship
  1940. *
  1941. *    note: a character key may be used to select a file whose
  1942. *          name begins with that letter
  1943. ******
  1944. FUNCTION get_relation
  1945.  
  1946. PARAMETERS row_n, element
  1947.  
  1948. PRIVATE stroke, k_input, k_trim, s_alias, t_alias, i, j, q, pos_c,;
  1949.         ntx_expr, k_type, ok
  1950.  
  1951. IF isdata(M->keystroke)
  1952.     * character key..look for matching filename
  1953.     i = c_search(UPPER(CHR(M->keystroke)), M->dbf, 0, afull(M->dbf))
  1954.  
  1955.     IF SUBSTR(dbf[M->i],1,1) = UPPER(CHR(M->keystroke))
  1956.         * found..make the selection as the source file
  1957.         KEYBOARD CHR(13)
  1958.  
  1959.     ENDIF
  1960.  
  1961. ELSE
  1962.  
  1963.     IF EMPTY(k_relate[M->element])
  1964.         * brand new..start at the beginning
  1965.         i = 1
  1966.  
  1967.     ELSE
  1968.         * relation exists..begin with source file
  1969.         i = ASC(s_relate[M->element]) - ASC("A") + 1
  1970.  
  1971.     ENDIF
  1972. ENDIF
  1973.  
  1974. j = 0
  1975. stroke = 0
  1976.  
  1977. DO WHILE .NOT. (M->j > 0 .AND. M->stroke = 13)
  1978.     * till both source and target files are selected
  1979.  
  1980.     DO CASE
  1981.  
  1982.         CASE M->stroke = 13
  1983.             * enter key..select source
  1984.  
  1985.             IF M->i < 6
  1986.                 * can only select if another file is open to the right
  1987.  
  1988.                 IF .NOT. EMPTY(dbf[M->i + 1])
  1989.  
  1990.                     IF .NOT. EMPTY(k_relate[M->element])
  1991.                         * assume same target for existing relation
  1992.                         j = ASC(t_relate[M->element]) - ASC("A") + 1
  1993.  
  1994.                     ENDIF
  1995.  
  1996.                     IF M->j <= M->i
  1997.                         * target must be to the right of the source
  1998.                         j = M->i + 1
  1999.  
  2000.                     ENDIF
  2001.                 ENDIF
  2002.             ENDIF
  2003.  
  2004.             stroke = 0
  2005.  
  2006.         CASE M->stroke = 4
  2007.             * right arrow
  2008.  
  2009.             IF M->j = 0 .AND. M->i < 6
  2010.                 * source not selected..change source
  2011.  
  2012.                 IF .NOT. EMPTY(dbf[M->i + 1])
  2013.                     * only open files are selectable
  2014.                     i = M->i + 1
  2015.  
  2016.                 ENDIF
  2017.  
  2018.             ELSE
  2019.  
  2020.                 IF M->j > 0 .AND. M->j < 6
  2021.                     * source selected..change target
  2022.  
  2023.                     IF .NOT. EMPTY(dbf[M->j + 1])
  2024.                         * only open files are selectable
  2025.                         j = M->j + 1
  2026.  
  2027.                     ENDIF
  2028.                 ENDIF
  2029.             ENDIF
  2030.  
  2031.             stroke = 0
  2032.  
  2033.         CASE M->stroke = 19
  2034.             * left arrow
  2035.  
  2036.             IF M->j = 0 .AND. M->i > 1
  2037.                 * source not selected..change source
  2038.                 i = M->i - 1
  2039.  
  2040.             ELSE
  2041.  
  2042.                 IF M->j > 0
  2043.                     * source selected..change target
  2044.                     j = M->j - 1
  2045.  
  2046.                     IF M->j = M->i
  2047.                         * target must be to the right
  2048.                         j = 0    && revert to unselected source
  2049.  
  2050.                     ENDIF
  2051.                 ENDIF
  2052.             ENDIF
  2053.  
  2054.             stroke = 0
  2055.  
  2056.         CASE isdata(M->stroke)
  2057.             * character key..perform character search
  2058.             q = c_search(UPPER(CHR(M->stroke)),M->dbf,M->i,afull(M->dbf))
  2059.  
  2060.             IF SUBSTR(dbf[M->q],1,1) = UPPER(CHR(M->stroke))
  2061.                 * found
  2062.  
  2063.                 IF M->j = 0
  2064.                     * source not selected..make selection
  2065.                     i = M->q
  2066.                     KEYBOARD CHR(13)
  2067.  
  2068.                 ELSE
  2069.  
  2070.                     IF M->q > M->i
  2071.                         * found file is acceptable as target..make selection
  2072.                         j = M->q
  2073.                         KEYBOARD CHR(13)
  2074.  
  2075.                     ELSE
  2076.                         * found file cannot be target
  2077.                         j = 0        && revert to unselected source
  2078.                         i = M->q    && found file is current s_alias
  2079.  
  2080.                     ENDIF
  2081.                 ENDIF
  2082.             ENDIF
  2083.  
  2084.             stroke = 0
  2085.  
  2086.         CASE M->stroke = 27
  2087.             * escape..abort
  2088.             @ M->row_n,column[1] SAY SPACE(M->width)
  2089.             RETURN 0
  2090.  
  2091.         CASE M->stroke = 28
  2092.             * "help" selected from pull-down menu
  2093.             DO syshelp
  2094.             stroke = 0
  2095.  
  2096.         OTHERWISE
  2097.             * update screen and get new stroke
  2098.  
  2099.             IF M->j = 0
  2100.                 * source file not selected..clear the row
  2101.                 @ M->row_n,column[1] SAY SPACE(M->width)
  2102.  
  2103.                 * extract the current source alias
  2104.                 s_alias = name(dbf[M->i])
  2105.  
  2106.                 * display it as intense
  2107.                 SetColor(M->color12)
  2108.                 @ M->row_n,column[M->i] + 2 SAY M->s_alias
  2109.                 SetColor(M->cNorm)
  2110.  
  2111.             ELSE
  2112.                 * source selected (do not disturb)..extract target alias
  2113.                 t_alias = name(dbf[M->j])
  2114.  
  2115.                 * calculate column after s_alias
  2116.                 pos_c = column[M->i] + 2 + LEN(M->s_alias)
  2117.  
  2118.                 * clear to right edge of window
  2119.                 @ M->row_n,M->pos_c SAY SPACE(M->pos_r - M->pos_c)
  2120.  
  2121.                 * draw line and arrow pointing to target alias
  2122.                 @ M->row_n,M->pos_c;
  2123.                 SAY REPLICATE("─", column[M->j] - M->pos_c + 1) + CHR(16)
  2124.  
  2125.                 * display target alias as intense
  2126.                 SetColor(M->color12)
  2127.                 ?? t_alias
  2128.                 SetColor(M->cNorm)
  2129.  
  2130.             ENDIF
  2131.  
  2132.             * get new stroke
  2133.             stroke = raw_key()
  2134.  
  2135.     ENDCASE
  2136. ENDDO
  2137.  
  2138. * hilite source and target in reverse video to indicate both selected
  2139. SetColor(M->cHilite)
  2140. @ M->row_n,column[M->i] + 2 SAY M->s_alias
  2141. @ M->row_n,column[M->j] + 2 SAY M->t_alias
  2142. SetColor(M->cNorm)
  2143.  
  2144. * determine correct type for relation expression
  2145. SELECT (M->j)
  2146. ntx_expr = ctrl_key()        && get the controlling index key
  2147.  
  2148. IF EMPTY(M->ntx_expr)
  2149.     * target not indexed..must be numeric or recno()
  2150.     k_type = "N"
  2151.  
  2152. ELSE
  2153.     * same type as target index key
  2154.     k_type = TYPE(M->ntx_expr)
  2155.  
  2156. ENDIF
  2157.  
  2158. * select source work area to test key expression
  2159. SELECT (M->i)
  2160.  
  2161. * start with previous expression
  2162. k_trim = k_relate[M->element]
  2163. ok = .F.
  2164.  
  2165. DO WHILE .NOT. M->ok
  2166.     * accept input of key expression
  2167.     k_trim = enter_rc(M->k_trim, M->row_n + 1, column[M->i] + 2,;
  2168.                       127, "@KS" + LTRIM(STR(M->pos_r - column[M->i] - 2)),;
  2169.                       M->color1)
  2170.  
  2171.     * empty expression will abort, else must be correct type
  2172.     ok = EMPTY(M->k_trim) .OR. TYPE(M->k_trim) = M->k_type
  2173.  
  2174.     IF .NOT. M->ok
  2175.         error_msg("Invalid Expression")
  2176.  
  2177.     ENDIF
  2178. ENDDO
  2179.  
  2180. * clear the expression row
  2181. @ M->row_n + 1,column[1] SAY SPACE(M->width)
  2182.  
  2183. IF EMPTY(M->k_trim)
  2184.     * abort
  2185.     RETURN 0
  2186.  
  2187. ENDIF
  2188.  
  2189. * will need to set relations
  2190. need_relat = .T.
  2191.  
  2192. * store defined relation in global arrays
  2193. k_relate[M->element] = M->k_trim
  2194. s_relate[M->element] = CHR(M->i + ASC("A") - 1) + M->s_alias
  2195. t_relate[M->element] = CHR(M->j + ASC("A") - 1) + M->t_alias
  2196.  
  2197. RETURN 0
  2198.  
  2199.  
  2200. ******
  2201. *    disp_relation()
  2202. *
  2203. *    display the specified relation on the specified row in the specified color
  2204. ******
  2205. FUNCTION disp_relation
  2206.  
  2207. PARAMETERS disp_row, element, cSpecial
  2208. PRIVATE j, k
  2209.  
  2210. IF EMPTY(k_relate[M->element])
  2211.     * clear lines only
  2212.     @ M->disp_row,column[1] SAY SPACE(M->width)
  2213.     @ M->disp_row + 1,column[1] SAY SPACE(M->width)
  2214.     RETURN 0
  2215.  
  2216. ENDIF
  2217.  
  2218. * calculate the work areas of the related files
  2219. j = ASC(s_relate[M->element]) - ASC("A") + 1    && source
  2220. k = ASC(t_relate[M->element]) - ASC("A") + 1    && target
  2221.  
  2222. * display the source alias in the specified color
  2223. SetColor(M->cSpecial)
  2224. @ M->disp_row, column[M->j] + 2 SAY SUBSTR(s_relate[M->element], 2)
  2225. SetColor(M->cNorm)
  2226.  
  2227. * display an arrow (always normal color)
  2228. ?? REPLICATE("─", column[M->k] - COL() + 1) + CHR(16)
  2229.  
  2230. * display the target alias in the specified color
  2231. SetColor(M->cSpecial)
  2232. ?? SUBSTR(t_relate[M->element], 2)
  2233. SetColor(M->cNorm)
  2234.  
  2235. * display the key on the next line (always normal color)
  2236. @ M->disp_row + 1, column[M->j] + 2;
  2237. SAY pad(k_relate[M->element], M->pos_r - column[M->j] - 2)
  2238.  
  2239. RETURN 0
  2240.  
  2241.  
  2242. ******
  2243. *    c_search()
  2244. *
  2245. *    find the next array element with a matching first character
  2246. ******
  2247. FUNCTION c_search
  2248.  
  2249. PARAMETERS c, array, cur_el, num_d
  2250. PRIVATE chr_el
  2251.  
  2252. * begin with next element
  2253. chr_el = M->cur_el + 1
  2254.  
  2255. DO WHILE M->chr_el <= M->num_d
  2256.     * forward search..exit if found
  2257.  
  2258.     IF UPPER(SUBSTR(array[M->chr_el], 1, 1)) = UPPER(M->c)
  2259.         EXIT
  2260.  
  2261.     ENDIF
  2262.  
  2263.     * next
  2264.     chr_el = M->chr_el + 1
  2265.  
  2266. ENDDO
  2267.  
  2268. IF M->chr_el > M->num_d
  2269.     * not found..search from beginning
  2270.     chr_el = 1
  2271.  
  2272.     DO WHILE M->chr_el < M->cur_el .AND.;
  2273.              UPPER(SUBSTR(array[M->chr_el], 1, 1)) <> UPPER(M->c)
  2274.  
  2275.         * next
  2276.         chr_el = M->chr_el + 1
  2277.  
  2278.     ENDDO
  2279. ENDIF
  2280.  
  2281. RETURN M->chr_el
  2282.  
  2283.  
  2284. ******
  2285. *    ctrl_key()
  2286. *
  2287. *    return controlling index key for the current work area
  2288. ******
  2289. FUNCTION ctrl_key
  2290.  
  2291. PRIVATE key, ntx
  2292.  
  2293. IF M->need_ntx
  2294.     * index may be specified but not set
  2295.     ntx = "ntx" + LTRIM(STR(SELECT()))
  2296.  
  2297.     * read key directly from file
  2298.     key = ntx_key(&ntx[1])
  2299.  
  2300. ELSE
  2301.     * get key from system if index already set
  2302.     key = INDEXKEY(0)
  2303.  
  2304. ENDIF
  2305.  
  2306. RETURN M->key
  2307.  
  2308.  
  2309. ******
  2310. *    get_filter()
  2311. *
  2312. *    accept entry of filter expression for the current work area
  2313. ******
  2314. FUNCTION get_filter
  2315.  
  2316. PRIVATE k_filter,k_trim,old_help
  2317.  
  2318. * save old and set new help codes
  2319. old_help = M->help_code
  2320. help_code = 7
  2321.  
  2322. * get the current contents of the filter expression
  2323. k_filter = "kf" + SUBSTR("123456", M->cur_area, 1)
  2324. k_trim = &k_filter
  2325.  
  2326. * select the current work area for testing of filter expression
  2327. SELECT (M->cur_area)
  2328.  
  2329. * hilite the affected data file
  2330. hi_cur()
  2331.  
  2332. * establish array for mulitbox
  2333. DECLARE boxarray[4]
  2334.  
  2335. boxarray[1] = "fltr_title(sysparam)"
  2336. boxarray[2] = "getfilter(sysparam)"
  2337. boxarray[3] = "ok_button(sysparam)"
  2338. boxarray[4] = "can_button(sysparam)"
  2339.  
  2340. * indicate the function that will complete the process
  2341. okee_dokee = "do_filter()"
  2342.  
  2343. * open the box
  2344. multibox(7, 17, 5, 2, M->boxarray)
  2345.  
  2346. * restore help code
  2347. help_code = M->old_help
  2348.  
  2349. * un-hilite the name of the current data file
  2350. dehi_cur()
  2351.  
  2352. RETURN 0
  2353.  
  2354.  
  2355. ******
  2356. *    fltr_title()
  2357. *
  2358. *    display title for filter entry
  2359. ******
  2360. FUNCTION fltr_title
  2361.  
  2362. PARAMETERS sysparam
  2363.  
  2364. * title includes filename.ext but no path
  2365. RETURN box_title(M->sysparam, "Set filter for " +;
  2366.                               SUBSTR(M->cur_dbf, RAT("\", M->cur_dbf) + 1) +;
  2367.                               " to...")
  2368.  
  2369.  
  2370. ******
  2371. *    getfilter()
  2372. *
  2373. *    accept input of filter expression to the temporary variable "k_trim"
  2374. ******
  2375. FUNCTION getfilter
  2376.  
  2377. PARAMETERS sysparam
  2378.  
  2379. RETURN get_k_trim(M->sysparam, "Condition")
  2380.  
  2381.  
  2382. ******
  2383. *    do_filter()
  2384. *
  2385. *    complete the filter entry
  2386. ******
  2387. FUNCTION do_filter
  2388.  
  2389. PRIVATE done, k_sample
  2390.  
  2391. IF EMPTY(M->k_trim)
  2392.     * a confirmed empty expression means eliminate the current filter
  2393.     done = .T.
  2394.  
  2395.     IF .NOT. EMPTY(&k_filter)
  2396.         * cancel any filter that may be active
  2397.         SET FILTER TO
  2398.  
  2399.         * set global filter expression to nul
  2400.         &k_filter = ""
  2401.  
  2402.     ENDIF
  2403.  
  2404. ELSE
  2405.  
  2406.     IF TYPE(M->k_trim) = "L"
  2407.         * expression evaluates ok
  2408.         done = .T.
  2409.  
  2410.         IF .NOT. (&k_filter == M->k_trim)
  2411.             * change in filter expression..set global variables
  2412.             need_filtr = .T.
  2413.             &k_filter = M->k_trim
  2414.  
  2415.         ENDIF
  2416.  
  2417.     ELSE
  2418.         done = .F.
  2419.         error_msg("Filter must be a Logical expression")
  2420.  
  2421.     ENDIF
  2422. ENDIF
  2423.  
  2424. RETURN M->done
  2425.  
  2426.  
  2427. ******
  2428. *    clear_dbf()
  2429. *
  2430. *    clear specified work area..shift higher work areas if requested
  2431. *
  2432. *    shift values:
  2433. *        0  =  no shift
  2434. *        1  =  shift right (insert)
  2435. *        2  =  shift left (delete)
  2436. ******
  2437. FUNCTION clear_dbf
  2438.  
  2439. PARAMETERS work_area, shift
  2440. PRIVATE s_alias,c_area,temp,xtemp,i,file_name,alias_6,n_active
  2441.  
  2442. * determine number of active work areas
  2443. n_active = afull(M->dbf)
  2444.  
  2445. * extract alias of specified work area
  2446. s_alias = name(dbf[M->work_area])
  2447.  
  2448. * area 6 could be affected if shifting due to insert
  2449. alias_6 = ""
  2450.  
  2451. * access the list of index files for the current area
  2452. temp = "ntx" + SUBSTR("123456", M->work_area, 1)
  2453.  
  2454. DO CASE
  2455.  
  2456.     CASE M->shift = 0
  2457.         * no shift..no problem
  2458.         dbf[M->work_area] = ""
  2459.  
  2460.         * reduce number of open files by no. of index files + 1
  2461.         n_files = M->n_files - afull(&temp) - 1
  2462.  
  2463.     CASE M->shift = 1
  2464.         * shift right..current data file (if any) will remain open
  2465.  
  2466.         IF .NOT. EMPTY(dbf[6])
  2467.             * remember the alias
  2468.             alias_6 = name(dbf[6])
  2469.  
  2470.             * reduce number of open files by no. of index files + 1
  2471.             n_files = M->n_files - afull(M->ntx6) - 1
  2472.  
  2473.         ENDIF
  2474.  
  2475.         * shift may not be needed after all
  2476.         shift = IF(EMPTY(dbf[M->work_area]) .OR. M->work_area = 6, 0, 1)
  2477.  
  2478.         * open an empty element in global array of data files
  2479.         array_ins(M->dbf, M->work_area)
  2480.  
  2481.     CASE M->shift = 2
  2482.         * shift left..current data file will be closed
  2483.         array_del(M->dbf, M->work_area)
  2484.  
  2485.         * shift may not be needed after all
  2486.         shift = IF(EMPTY(dbf[M->work_area]), 0, 2)
  2487.  
  2488.         * reduce number of open files by no. of index files + 1
  2489.         n_files = M->n_files - afull(&temp) - 1
  2490.  
  2491. ENDCASE
  2492.  
  2493. i = 1
  2494.  
  2495. DO WHILE M->i <= M->n_active
  2496.     * select area i
  2497.     c_area = CHR(M->i + ASC("A") - 1)
  2498.     SELECT (M->i)
  2499.  
  2500.     * search filters in all active areas for disappearing aliases
  2501.     temp = "kf" + SUBSTR("123456", M->i, 1)
  2502.  
  2503.     IF (((M->s_alias + "->" $ UPPER(&temp)) .OR.;
  2504.        (M->i = M->work_area .AND. .NOT. EMPTY(&temp)));
  2505.        .AND. M->shift <> 1) .OR. (.NOT. EMPTY(M->alias_6) .AND.;
  2506.        M->alias_6 + "->" $ UPPER(&temp) .AND. M->shift = 1)
  2507.         * data file was part of filter expression or none can exist
  2508.  
  2509.         * turn of the filter
  2510.         SET FILTER TO
  2511.  
  2512.         * will need to reset
  2513.         need_filtr = .T.
  2514.  
  2515.         * set global filter expression to nul
  2516.         &temp = ""
  2517.  
  2518.     ENDIF
  2519.  
  2520.     IF M->i = M->work_area .OR. (M->i > M->work_area .AND. M->shift <> 0)
  2521.         * close all work areas to be shifted or closed
  2522.         USE
  2523.    ENDIF
  2524.  
  2525.     * next
  2526.     i = M->i + 1
  2527.  
  2528. ENDDO
  2529.  
  2530. DO CASE
  2531.  
  2532.     CASE M->shift = 0
  2533.         * clear array of index files
  2534.         temp = "ntx" + SUBSTR("123456", M->work_area, 1)
  2535.         afill(&temp, "")
  2536.  
  2537.         * clear field list
  2538.         temp = "field_n" + SUBSTR("123456", M->work_area, 1)
  2539.         afill(&temp, "")
  2540.  
  2541.         * clear filter
  2542.         temp = "kf" + SUBSTR("123456", M->work_area, 1)
  2543.         &temp = ""
  2544.  
  2545.     CASE M->shift = 1
  2546.         * shift right
  2547.         need_filtr = .T.    && will need to reset
  2548.         need_ntx = .T.        && ditto
  2549.  
  2550.         * count backwards..dbf array may not be contiguous
  2551.         i = 6
  2552.  
  2553.         DO WHILE EMPTY(dbf[M->i])
  2554.             * find highest active area
  2555.             i = M->i - 1
  2556.  
  2557.         ENDDO
  2558.  
  2559.         DO WHILE M->i > M->work_area
  2560.             * shift all higher work areas..list of index files
  2561.             temp = "ntx" + SUBSTR("123456", M->i, 1)
  2562.             xtemp = "ntx" + SUBSTR("123456", M->i - 1, 1)
  2563.             acopy(&xtemp,&temp)
  2564.  
  2565.             * active fields list
  2566.             temp = "field_n" + SUBSTR("123456", M->i, 1)
  2567.             xtemp = "field_n" + SUBSTR("123456", M->i - 1, 1)
  2568.             acopy(&xtemp,&temp)
  2569.  
  2570.             * current rows
  2571.          temp = "_cr" + SUBSTR("123456", M->i, 1)
  2572.          xtemp = "_cr" + SUBSTR("123456", M->i - 1, 1)
  2573.             acopy(&xtemp,&temp)
  2574.  
  2575.             * current elements
  2576.          temp = "_el" + SUBSTR("123456", M->i, 1)
  2577.          xtemp = "_el" + SUBSTR("123456", M->i - 1, 1)
  2578.             acopy(&xtemp,&temp)
  2579.  
  2580.             * filter expressions
  2581.             temp = "kf" + SUBSTR("123456", M->i, 1)
  2582.             xtemp = "kf" + SUBSTR("123456", M->i - 1, 1)
  2583.             &temp = &xtemp
  2584.  
  2585.             * next
  2586.             i = M->i - 1
  2587.  
  2588.         ENDDO
  2589.  
  2590.         * clear the specified work area (i = work_area)
  2591.         xtemp = SUBSTR("123456", M->i, 1)    && str(i) for convenience
  2592.  
  2593.         * clear index files list
  2594.         temp = "ntx" + xtemp
  2595.         afill(&temp, "")
  2596.  
  2597.         * clear active fields list
  2598.         temp = "field_n" + xtemp
  2599.         afill(&temp, "")
  2600.  
  2601.         * clear filter expression
  2602.         temp = "kf" + xtemp
  2603.         &temp = ""
  2604.  
  2605.         * reset current rows
  2606.       temp = "_cr" + xtemp
  2607.         &temp[2] = row_a[2]
  2608.         &temp[3] = row_a[3]
  2609.  
  2610.         * reset current elements
  2611.       temp = "_el" + xtemp
  2612.         afill(&temp, 1)
  2613.  
  2614.     CASE M->shift = 2
  2615.         * shift left
  2616.         need_filtr = .T.    && will need to reset
  2617.         need_ntx = .T.        && ditto
  2618.  
  2619.         i = M->work_area
  2620.  
  2621.         DO WHILE M->i < 6 .AND. .NOT. EMPTY(dbf[M->i])
  2622.             * shift all higher work areas..list of index files
  2623.             temp = "ntx" + SUBSTR("123456", M->i, 1)
  2624.             xtemp = "ntx" + SUBSTR("123456", M->i + 1, 1)
  2625.             acopy(&xtemp,&temp)
  2626.  
  2627.             * active fields list
  2628.             temp = "field_n" + SUBSTR("123456", M->i, 1)
  2629.             xtemp = "field_n" + SUBSTR("123456", M->i + 1, 1)
  2630.             acopy(&xtemp,&temp)
  2631.  
  2632.             * current rows
  2633.          temp = "_cr" + SUBSTR("123456", M->i, 1)
  2634.          xtemp = "_cr" + SUBSTR("123456", M->i + 1, 1)
  2635.             acopy(&xtemp,&temp)
  2636.  
  2637.             * current elements
  2638.          temp = "_el" + SUBSTR("123456", M->i, 1)
  2639.          xtemp = "_el" + SUBSTR("123456", M->i + 1, 1)
  2640.             acopy(&xtemp,&temp)
  2641.  
  2642.             * filter expressions
  2643.             temp = "kf" + SUBSTR("123456", M->i, 1)
  2644.             xtemp = "kf" + SUBSTR("123456", M->i + 1, 1)
  2645.             &temp = &xtemp
  2646.  
  2647.             * next
  2648.             i = M->i + 1
  2649.  
  2650.         ENDDO
  2651.  
  2652.         * clear the last (previously active) work area
  2653.         xtemp = SUBSTR("123456", M->i, 1)    && str(i) for convenience
  2654.  
  2655.         * clear index files list
  2656.         temp = "ntx" + M->xtemp
  2657.         afill(&temp, "")
  2658.  
  2659.         * clear active fields list
  2660.         temp = "field_n" + M->xtemp
  2661.         afill(&temp, "")
  2662.  
  2663.         * clear filter expression
  2664.         temp = "kf" + M->xtemp
  2665.         &temp = ""
  2666.  
  2667.         * reset current rows
  2668.       temp = "_cr" + M->xtemp
  2669.         &temp[2] = row_a[2]
  2670.         &temp[3] = row_a[3]
  2671.  
  2672.         * reset current elements
  2673.       temp = "_el" + M->xtemp
  2674.         afill(&temp, 1)
  2675.  
  2676. ENDCASE
  2677.  
  2678. * will need to reset
  2679. need_field = .T.
  2680.  
  2681. **
  2682. *    note: the source and target of relations are identified
  2683. *          by the letter of the work area + the alias
  2684. **
  2685.  
  2686. * get letter of cleared work area
  2687. c_area = CHR(M->work_area + ASC("A") - 1)
  2688.  
  2689. i = 1
  2690.  
  2691. DO WHILE M->i <= LEN(M->k_relate)
  2692.     * search all active relations
  2693.  
  2694.     IF EMPTY(k_relate[M->i])
  2695.         * no more active relations
  2696.         EXIT
  2697.  
  2698.     ENDIF
  2699.  
  2700.     IF ((SUBSTR(s_relate[M->i], 1, 1) = M->c_area .OR.;
  2701.        SUBSTR(t_relate[M->i], 1, 1) = M->c_area) .AND. M->shift <> 1) .OR.;
  2702.        (M->shift = 1 .AND. SUBSTR(t_relate[M->i], 1, 1) = "F")
  2703.         * relation must be removed from list
  2704.  
  2705.         array_del(M->s_relate, M->i)
  2706.         array_del(M->k_relate, M->i)
  2707.         array_del(M->t_relate, M->i)
  2708.         need_relat = .T.
  2709.  
  2710.     ELSE
  2711.  
  2712.         IF (M->shift = 2 .AND. SUBSTR(s_relate[M->i], 1, 1) > M->c_area) .OR.;
  2713.            (M->shift = 1 .AND. SUBSTR(s_relate[M->i], 1, 1) >= M->c_area)
  2714.             * source work area was shifted..adjust source area
  2715.  
  2716.             s_relate[M->i] = CHR(ASC(SUBSTR(s_relate[M->i], 1, 1)) +;
  2717.                              IF(M->shift = 1, 1, -1)) +;
  2718.                              SUBSTR(s_relate[M->i], 2)
  2719.             need_relat = .T.
  2720.  
  2721.         ENDIF
  2722.  
  2723.         IF (M->shift = 2 .AND. SUBSTR(t_relate[M->i], 1, 1) > M->c_area) .OR.;
  2724.            (M->shift = 1 .AND. SUBSTR(t_relate[M->i], 1, 1) >= M->c_area)
  2725.             * target work area was shifted..adjust target area
  2726.  
  2727.             t_relate[M->i] = CHR(ASC(SUBSTR(t_relate[M->i], 1, 1)) +;
  2728.                              IF(M->shift = 1, 1, -1)) +;
  2729.                              SUBSTR(t_relate[M->i], 2)
  2730.             need_relat = .T.
  2731.  
  2732.         ENDIF
  2733.  
  2734.         * next
  2735.         i = M->i + 1
  2736.  
  2737.     ENDIF
  2738. ENDDO
  2739.  
  2740. IF M->shift <> 0
  2741.     * re-open active data files in new work areas
  2742.     i = 6
  2743.  
  2744.     DO WHILE M->i >= M->work_area
  2745.         * search all shifted work areas
  2746.  
  2747.         IF .NOT. EMPTY(dbf[M->i])
  2748.             * open data file
  2749.             c_area = CHR(M->i + ASC("A") - 1)
  2750.             SELECT (M->i)
  2751.             file_name = dbf[M->i]
  2752.          NetUse( file_name )
  2753.  
  2754.         ENDIF
  2755.  
  2756.         * next
  2757.         i = M->i - 1
  2758.  
  2759.     ENDDO
  2760. ENDIF
  2761.  
  2762. RETURN 0
  2763.  
  2764.  
  2765. ******
  2766. *    save_view()
  2767. *
  2768. *    save the current view in a ".VEW" file
  2769. *
  2770. *    note: - the view file is a data base file with a default extension
  2771. *            of ".VEW" and 2 fields: "item_name" and "contents".
  2772. *          -    the first 2 items are reserved for the global variables
  2773. *            "cur_dir", and "n_files"..then a variable number of
  2774. *            filter expressions..the remaining items are arrays.
  2775. *          -    if the contents of an item will not fit in the contents
  2776. *            field, it will be continued in the next record where
  2777. *            the item_name will be left blank.
  2778. *          -    for arrays, only the identifier is saved..the number of
  2779. *            items is the number of elements to fill
  2780. ******
  2781. FUNCTION save_view
  2782.  
  2783. PRIVATE filename, old_help
  2784.  
  2785. * save old and set new help codes
  2786. old_help = M->help_code
  2787. help_code = 21
  2788.  
  2789. * get user entered file name..will default to primary + ".VEW"
  2790. IF EMPTY(M->view_file) .AND. .NOT. EMPTY(dbf[1])
  2791.     * default to name of primary data file
  2792.     filename = name(dbf[1]) + ".VEW"
  2793.  
  2794. ELSE
  2795.     * whatever the last view was
  2796.     filename = M->view_file
  2797.  
  2798. ENDIF
  2799.  
  2800. * it's better in a box
  2801. filebox(".VEW", "vew_list", "vcrea_titl", "do_creavew", .T., 8)
  2802.  
  2803. * restore help code
  2804. help_code = M->old_help
  2805.  
  2806. RETURN 0
  2807.  
  2808.  
  2809. ******
  2810. *    vcrea_titl()
  2811. *
  2812. *    display title for save view
  2813. ******
  2814. FUNCTION vcrea_titl
  2815.  
  2816. PARAMETERS sysparam
  2817.  
  2818. RETURN box_title(M->sysparam, "Save view as...")
  2819.  
  2820.  
  2821. ******
  2822. *    do_creavew()
  2823. *
  2824. *    save the current view in a .VEW file
  2825. ******
  2826. FUNCTION do_creavew
  2827.  
  2828. LOCAL cAlias
  2829. PRIVATE i, j, k, m_name, l_name, add_name
  2830.  
  2831. IF EMPTY(M->filename)
  2832.     error_msg("View file not selected")
  2833.     RETURN .F.
  2834.  
  2835. ENDIF
  2836.  
  2837. * select system reserved work area
  2838. SELECT 10
  2839.  
  2840. stat_msg("Generating View File")
  2841.  
  2842. * add new .VEW files to vew_list if created in current directory only
  2843. add_name = .NOT. FILE(name(filename) + ".VEW")
  2844.  
  2845. * create structure extended template
  2846. CREATE ddbbuuuu.ext
  2847.  
  2848. * define 2 fields
  2849. APPEND BLANK
  2850. REPLACE field_name WITH "ITEM_NAME",field_type WITH "C",field_len WITH 10
  2851.  
  2852. APPEND BLANK
  2853. REPLACE field_name WITH "CONTENTS",field_type WITH "C",field_len WITH 10
  2854.  
  2855. * create the view file
  2856. USE
  2857. cAlias := MakeAlias( filename )
  2858. CREATE &filename FROM ddbbuuuu.ext ALIAS cAlias
  2859.  
  2860. * set global variable
  2861. view_file = M->filename
  2862.  
  2863. * open view file..avoid alias conflict
  2864. NetUse( view_file, NIL, NIL, "ddbbuuuu" )
  2865.  
  2866. * erase template
  2867. ERASE ddbbuuuu.ext
  2868.  
  2869. * 2 global variables always saved
  2870. APPEND BLANK
  2871. REPLACE item_name WITH "cur_dir"
  2872. put_line(cur_dir)
  2873.  
  2874. APPEND BLANK
  2875. REPLACE item_name WITH "n_files"
  2876. put_line(LTRIM(STR(n_files)))
  2877.  
  2878. i = 1
  2879.  
  2880. DO WHILE i <= 6
  2881.     * filters
  2882.  
  2883.     IF EMPTY(dbf[i])
  2884.         * no more data files
  2885.         EXIT
  2886.  
  2887.     ENDIF
  2888.  
  2889.     * get variable name for macro expansion
  2890.     m_name = "kf" + SUBSTR("123456", i, 1)
  2891.  
  2892.     IF .NOT. EMPTY(&m_name)
  2893.         * only save active filters
  2894.         APPEND BLANK
  2895.         REPLACE item_name WITH m_name
  2896.         put_line(&m_name)
  2897.  
  2898.     ENDIF
  2899.  
  2900.     * next
  2901.     i = i + 1
  2902.  
  2903. ENDDO
  2904.  
  2905. * save arrays..avoid saving empty elements
  2906. i = 1
  2907.  
  2908. DO WHILE i <= 6
  2909.     * data file filespecs
  2910.  
  2911.     IF EMPTY(dbf[i])
  2912.         * no more data files
  2913.         EXIT
  2914.  
  2915.     ENDIF
  2916.  
  2917.     * save one filespec
  2918.     APPEND BLANK
  2919.     REPLACE item_name WITH "dbf"
  2920.     put_line(dbf[i])
  2921.  
  2922.     * next
  2923.     i = i + 1
  2924.  
  2925. ENDDO
  2926.  
  2927. * save index lists and fields lists
  2928. l_name = "ntx"
  2929.  
  2930. FOR k = 1 TO 2
  2931.     * first the indexed, then the fields
  2932.     i = 1
  2933.  
  2934.     DO WHILE i <= 6
  2935.         * index or field list for each data file
  2936.  
  2937.         IF EMPTY(dbf[i])
  2938.             * no more data files
  2939.             EXIT
  2940.  
  2941.         ENDIF
  2942.  
  2943.         * get array identifier for macro expansion
  2944.         m_name = l_name + SUBSTR("123456", i, 1)
  2945.  
  2946.         j = 1
  2947.  
  2948.         DO WHILE j <= LEN(&m_name)
  2949.             * index or field list for one data file
  2950.  
  2951.             IF EMPTY(&m_name[j])
  2952.                 * an early exit saves time and disk space
  2953.                 EXIT
  2954.  
  2955.             ENDIF
  2956.  
  2957.             * save one index filespec or one field name
  2958.             APPEND BLANK
  2959.             REPLACE item_name WITH m_name
  2960.             put_line(&m_name[j])
  2961.  
  2962.             * next element
  2963.             j = j + 1
  2964.  
  2965.         ENDDO
  2966.  
  2967.         * next work area
  2968.         i = i + 1
  2969.  
  2970.     ENDDO
  2971.  
  2972.     * switch to field lists
  2973.     l_name = "field_n"
  2974.  
  2975. NEXT
  2976.  
  2977. i = 1
  2978.  
  2979. DO WHILE i <= 3
  2980.     * relations in 3 arrays..s_relate, k_relate, and t_relate
  2981.     m_name = SUBSTR("skt", i, 1) + "_relate"
  2982.     j = 1
  2983.  
  2984.     DO WHILE j <= LEN(&m_name)
  2985.         * one array
  2986.  
  2987.         IF EMPTY(&m_name[j])
  2988.             * an early exit saves time and disk space
  2989.             EXIT
  2990.  
  2991.         ENDIF
  2992.  
  2993.         * one item
  2994.         APPEND BLANK
  2995.         REPLACE item_name WITH m_name
  2996.         put_line(&m_name[j])
  2997.  
  2998.         * next element
  2999.         j = j + 1
  3000.  
  3001.     ENDDO
  3002.  
  3003.     * next array
  3004.     i = i + 1
  3005.  
  3006. ENDDO
  3007.  
  3008. * close view file
  3009. USE
  3010.  
  3011. * add file name to array of view files
  3012. IF AT(".VEW", filename) = LEN(filename) - 3 .AND.;
  3013.    FILE(name(filename) + ".VEW") .AND. add_name
  3014.     * add only new .VEW files in the current directory
  3015.  
  3016.     * determine number of first empty element
  3017.     i = afull(vew_list) + 1
  3018.  
  3019.     IF i <= LEN(vew_list)
  3020.         * room for one more
  3021.         vew_list[i] = filename
  3022.  
  3023.         * must be alphabetical
  3024.         array_sort(vew_list)
  3025.  
  3026.     ENDIF
  3027. ENDIF
  3028.  
  3029. stat_msg("")
  3030.  
  3031. RETURN .T.
  3032.  
  3033.  
  3034. ******
  3035. *    put_line()
  3036. *
  3037. *    store string in contents field(s) of open view file
  3038. ******
  3039. FUNCTION put_line
  3040.  
  3041. PARAMETERS line
  3042. PRIVATE pos
  3043.  
  3044. * assign contents to the current record
  3045. REPLACE contents WITH line
  3046.  
  3047. * position to begin fragmentation
  3048. pos = LEN(contents) + 1
  3049.  
  3050. DO WHILE pos <= LEN(line)
  3051.     * continue contents in next record
  3052.     APPEND BLANK
  3053.     REPLACE contents WITH SUBSTR(line, pos)
  3054.  
  3055.     * next chunk
  3056.     pos = pos + LEN(contents)
  3057.  
  3058. ENDDO
  3059.  
  3060. RETURN 0
  3061.  
  3062.  
  3063. ******
  3064. *    set_from()
  3065. *
  3066. *    restore View from .VEW file
  3067. ******
  3068. FUNCTION set_from
  3069.  
  3070. PARAMETERS from_view
  3071. PRIVATE filename, old_help
  3072.  
  3073. * save old and set new help codes
  3074. old_help = M->help_code
  3075. help_code = 21
  3076.  
  3077. * default to previous View file if any
  3078. filename = M->view_file
  3079.  
  3080. IF M->from_view
  3081.     * called from set_view
  3082.  
  3083.     IF filebox(".VEW", "vew_list", "vopen_titl", "do_openvew", .F., 8) <> 0
  3084.         * indicate new View has been set
  3085.         keystroke = 13
  3086.  
  3087.     ENDIF
  3088.  
  3089. ELSE
  3090.     * just do it
  3091.     do_openvew()
  3092.  
  3093. ENDIF
  3094.  
  3095. * restore help code
  3096. help_code = M->old_help
  3097.  
  3098. RETURN 0
  3099.  
  3100.  
  3101. ******
  3102. *    vopen_titl()
  3103. *
  3104. *    display title for restore view
  3105. ******
  3106. FUNCTION vopen_titl
  3107.  
  3108. PARAMETERS sysparam
  3109.  
  3110. RETURN box_title(M->sysparam, "Restore view from...")
  3111.  
  3112.  
  3113. ******
  3114. *    do_openvew()
  3115. *
  3116. *    restore view from .VEW file
  3117. *
  3118. *    note: this function is called when the enter key is
  3119. *          pressed while the cursor is on the Ok button
  3120. ******
  3121. FUNCTION do_openvew
  3122.  
  3123. PRIVATE m_name, i, done
  3124.  
  3125. DO CASE
  3126.  
  3127.     CASE EMPTY(M->filename)
  3128.         error_msg("View file not selected")
  3129.         done = .F.
  3130.  
  3131.     CASE .NOT. FILE(M->filename)
  3132.         error_msg("Can't open " + M->filename)
  3133.         done = .F.
  3134.  
  3135.     OTHERWISE
  3136.         * select system reserved work area
  3137.         SELECT 10
  3138.  
  3139.         * open .VEW file..avoid alias conflict
  3140.       NetUse( filename, NIL, NIL, "ddbbuuuu" )
  3141.  
  3142.         IF .NOT. (TYPE("item_name") = "C" .AND. TYPE("contents") = "C")
  3143.             USE
  3144.             error_msg("Invalid view file")
  3145.             RETURN .F.
  3146.  
  3147.         ENDIF
  3148.  
  3149.         * ok to restore View..set global variable
  3150.         view_file = M->filename
  3151.  
  3152.         * entire View will need setup
  3153.         STORE .T. TO need_field,need_ntx,need_relat,need_filtr
  3154.         stat_msg("Restoring view")
  3155.  
  3156.         * clear the current view if any
  3157.         i = 6
  3158.  
  3159.         DO WHILE M->i > 0
  3160.  
  3161.             IF .NOT. EMPTY(dbf[M->i])
  3162.                 * clear one work area
  3163.                 clear_dbf(M->i, 0)
  3164.  
  3165.             ENDIF
  3166.  
  3167.             * next
  3168.             i = M->i - 1
  3169.  
  3170.         ENDDO
  3171.  
  3172.         * select system reserved work area
  3173.         SELECT 10
  3174.  
  3175.         * "cur_dir" and "n_files" always saved first
  3176.         cur_dir = get_line()
  3177.         n_files = VAL(get_line())
  3178.  
  3179.         IF TRIM(item_name) == "k_filter"
  3180.             * continued support for old format
  3181.             REPLACE item_name WITH "kf1"
  3182.             kf1 = get_line()
  3183.  
  3184.         ELSE
  3185.  
  3186.             DO WHILE SUBSTR(item_name, 1, 2) == "kf"
  3187.                 * get one filter expression
  3188.                 m_name = TRIM(item_name)
  3189.  
  3190.                 * assign the expression
  3191.                 &m_name = get_line()
  3192.  
  3193.             ENDDO
  3194.         ENDIF
  3195.  
  3196.         * all remaining information to be stored in global arrays
  3197.         DO WHILE .NOT. EOF()
  3198.             * get next array identifier and initialize subscript
  3199.             m_name = TRIM(item_name)
  3200.             i = 1
  3201.  
  3202.             * fill one array
  3203.             DO WHILE TRIM(item_name) == m_name
  3204.                 * fill one element of array
  3205.                 &m_name[i] = get_line()
  3206.  
  3207.                 * next element
  3208.                 i = i + 1
  3209.  
  3210.             ENDDO
  3211.         ENDDO
  3212.  
  3213.         * close the view file
  3214.         USE
  3215.  
  3216.         * open all data files in their select areas
  3217.         i = 1
  3218.  
  3219.         DO WHILE M->i <= 6
  3220.  
  3221.             IF EMPTY(dbf[M->i])
  3222.                 * no more data files to open
  3223.                 EXIT
  3224.  
  3225.             ENDIF
  3226.  
  3227.             * select the corresponding work area
  3228.             SELECT (M->i)
  3229.  
  3230.             * open the data file
  3231.             filename = dbf[M->i]
  3232.          NetUse( filename )
  3233.  
  3234.             * next work area
  3235.             i = M->i + 1
  3236.  
  3237.         ENDDO
  3238.  
  3239.         stat_msg("")
  3240.         done = .T.
  3241.  
  3242. ENDCASE
  3243.  
  3244. RETURN M->done
  3245.  
  3246.  
  3247. ******
  3248. *    get_line()
  3249. *
  3250. *    assemble contents of variable from .VEW file
  3251. ******
  3252. FUNCTION get_line
  3253.  
  3254. PRIVATE line
  3255.  
  3256. * assign contents from first record
  3257. line = TRIM(contents)
  3258. SKIP
  3259.  
  3260. DO WHILE LEN(TRIM(item_name)) = 0 .AND. .NOT. EOF()
  3261.     * blank name field means contents are continued in next record
  3262.     line = line + TRIM(contents)
  3263.     SKIP
  3264.  
  3265. ENDDO
  3266.  
  3267. RETURN line
  3268.  
  3269.  
  3270. * EOF DBUVIEW.PRG
  3271.