home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a009 / 6.ddi / DBU.LIF / DBUINDX.PRG < prev    next >
Encoding:
Text File  |  1991-04-14  |  5.2 KB  |  267 lines
  1. ************
  2. *
  3. *    Program....:  DBU
  4. *    Filename...:  DBUINDX.PRG
  5. *    Author.....:  Dennis L. Dias
  6. *    Date.......:  06/18/86, 06/18/90
  7. *    Purpose....:  Index Read/Write Module
  8. *
  9. *    Copyright (c) 1986-1990 Nantucket Corp., All Rights Reserved.
  10. *
  11. ************
  12.  
  13.  
  14. ******
  15. *    make_ntx
  16. *
  17. *    create index file
  18. *
  19. *    note: see multibox in DBUUTIL.PRG
  20. ******
  21. PROCEDURE make_ntx
  22. local saveColor
  23. PRIVATE filename, files, fi_disp, okee_dokee, cur_el, rel_row, def_ext,;
  24.         bcur, fi_done, el, cr, ntx, k_exp
  25.  
  26. * set local variables to macro reference specific arrays
  27. cr = "cr" + SUBSTR("123456", M->cur_area, 1)
  28. el = "el" + SUBSTR("123456", M->cur_area, 1)
  29. ntx = "ntx" + SUBSTR("123456", M->cur_area, 1)
  30.  
  31. * get name of current index file
  32. filename = &ntx[&el[2]]
  33.  
  34. * hi-lite the current index file..even if empty
  35. saveColor := SetColor(M->color2)
  36. @ &cr[2], column[M->cur_area] + 2 SAY pad(name(M->filename), 8)
  37.  
  38. * temporarily disable any relations and filters that may be active
  39. SELECT (M->cur_area)
  40. SET FILTER TO
  41. CLOSE INDEX
  42. need_filtr = .T.
  43. need_ntx = .T.
  44. not_target(SELECT(), .F.)
  45. SELECT (M->cur_area)
  46.  
  47. * initialize variables for multibox sub-system
  48. cur_el = 1
  49. rel_row = 0
  50. files = "ntx_list"
  51. def_ext = INDEXEXT()
  52.  
  53. IF .NOT. EMPTY(M->filename)
  54.     * set up for quick re-index
  55.     k_exp = ntx_key(M->filename)
  56.     bcur = 4
  57.  
  58. ELSE
  59.     * assume new file to be created
  60.     k_exp = ""
  61.     bcur = 2
  62.  
  63. ENDIF
  64.  
  65. * establish array of functions for multi-box
  66. DECLARE boxarray[6]
  67.  
  68. boxarray[1] = "ntx_title(sysparam)"
  69. boxarray[2] = "ntx_getfil(sysparam)"
  70. boxarray[3] = "ntx_exp(sysparam)"
  71. boxarray[4] = "ok_button(sysparam)"
  72. boxarray[5] = "can_button(sysparam)"
  73. boxarray[6] = "filelist(sysparam)"
  74.  
  75. * define certain sub-processes
  76. fi_disp = "ntx_exist()"
  77. fi_done = "ntx_done()"
  78. okee_dokee = "do_index()"
  79.  
  80. IF multibox(13, 17, 9, M->bcur, M->boxarray) <> 0 .AND.;
  81.    aseek(&ntx, M->filename) = 0
  82.     * index file generated and not open
  83.  
  84.     IF M->n_files < 14 .OR. .NOT. EMPTY(&ntx[&el[2]])
  85.         * room for one more..bring index file into View
  86.  
  87.         IF EMPTY(&ntx[&el[2]])
  88.             * keep track of number of open files
  89.             n_files = M->n_files + 1
  90.  
  91.         ENDIF
  92.  
  93.         * place in global array
  94.         &ntx[&el[2]] = M->filename
  95.  
  96.     ENDIF
  97. ENDIF
  98.  
  99. * re-write index filename as normal
  100. saveColor := SetColor(M->color1)
  101. @ &cr[2], column[M->cur_area] + 2 SAY pad(name(&ntx[&el[2]]), 8)
  102.  
  103. SetColor(saveColor)
  104. RETURN
  105.  
  106.  
  107. *******************************
  108. * support functions for INDEX *
  109. *******************************
  110.  
  111. ******
  112. *    ntx_title()
  113. *
  114. *    display title for "index"
  115. ******
  116. FUNCTION ntx_title
  117.  
  118. PARAMETERS sysparam
  119.  
  120. RETURN box_title(M->sysparam, "Index " +;
  121.                               SUBSTR(M->cur_dbf, RAT("\", M->cur_dbf) + 1) +;
  122.                               " to...")
  123.  
  124.  
  125. ******
  126. *    ntx_getfil()
  127. *
  128. *    get target filename for "index"
  129. ******
  130. FUNCTION ntx_getfil
  131.  
  132. PARAMETERS sysparam
  133.  
  134. RETURN getfile(M->sysparam, 4)
  135.  
  136.  
  137. ******
  138. *    ntx_done()
  139. *
  140. *    preliminary test of filename typed into entry field
  141. ******
  142. FUNCTION ntx_done
  143.  
  144. PRIVATE done_ok
  145.  
  146. done_ok = .NOT. EMPTY(M->filename)
  147.  
  148. IF M->done_ok
  149.     * filename entered
  150.  
  151.     IF FILE(M->filename) .AND. EMPTY(M->k_exp)
  152.         * read and display the key expression from the index file
  153.         k_exp = ntx_key(M->filename)
  154.         ntx_exp(3)
  155.  
  156.     ENDIF
  157.  
  158.     IF EMPTY(M->k_exp)
  159.         * move cursor to expression field
  160.         KEYBOARD CHR(24)
  161.  
  162.     ELSE
  163.         * expression entered..move cursor to the "Ok" button
  164.         to_ok()
  165.  
  166.     ENDIF
  167. ENDIF
  168.  
  169. RETURN M->done_ok
  170.  
  171.  
  172. ******
  173. *    ntx_exp()
  174. *
  175. *    get key expression for "index"
  176. ******
  177. FUNCTION ntx_exp
  178.  
  179. PARAMETERS sysparam
  180.  
  181. RETURN get_exp(M->sysparam, "KEY    ", 6, "k_exp")
  182.  
  183.  
  184. ******
  185. *    ntx_exist()
  186. *
  187. *    display filename selected from list and get key from file
  188. ******
  189. FUNCTION ntx_exist
  190.  
  191. IF EMPTY(M->k_exp)
  192.     * expression not entered..read it from the selected index file
  193.     k_exp = ntx_key(M->filename)
  194.  
  195. ENDIF
  196.  
  197. * display the filename and key
  198. ntx_getfil(3)
  199. ntx_exp(3)
  200.  
  201. RETURN 0
  202.  
  203.  
  204. ******
  205. *    do_index()
  206. *
  207. *    do the index command
  208. *
  209. *    note: this function is called when <enter> is pressed
  210. *          while the cursor is on the "Ok" button
  211. ******
  212. FUNCTION do_index
  213.  
  214. PRIVATE done, n_dup, new_el, add_name
  215.  
  216. * get number of select area using this index if any
  217. n_dup = dup_ntx(M->filename)
  218.  
  219. DO CASE
  220.  
  221.     CASE EMPTY(M->filename)
  222.         error_msg("Index file not selected")
  223.         done = .F.
  224.  
  225.     CASE M->n_dup > 0 .AND. M->n_dup <> SELECT()
  226.         error_msg("Index in use by another data file")
  227.         done = .F.
  228.  
  229.     CASE EMPTY(M->k_exp)
  230.         error_msg("Index key not entered")
  231.         done = .F.
  232.  
  233.     CASE .NOT. TYPE(M->k_exp) $ "CND"
  234.         error_msg("Key expression not valid")
  235.         done = .F.
  236.  
  237.     OTHERWISE
  238.         * ok to generate index
  239.         stat_msg("Generating index file")
  240.         add_name = .NOT. FILE(name(M->filename) + INDEXEXT())
  241.         INDEX ON &k_exp TO &filename
  242.         CLOSE INDEX
  243.  
  244.         IF AT(INDEXEXT(), M->filename) = LEN(M->filename) - 3 .AND.;
  245.            FILE(name(M->filename) + INDEXEXT()) .AND. M->add_name
  246.             * add only .ntx files in the current directory
  247.  
  248.             new_el = afull(M->ntx_list) + 1
  249.  
  250.             IF M->new_el <= LEN(M->ntx_list)
  251.                 * add file to array
  252.                 ntx_list[M->new_el] = M->filename
  253.                 array_sort(M->ntx_list)
  254.  
  255.             ENDIF
  256.         ENDIF
  257.  
  258.         stat_msg("File indexed")
  259.         done = .T.
  260.  
  261. ENDCASE
  262.  
  263. RETURN M->done
  264.  
  265.  
  266. * EOF DBUINDX.PRG
  267.