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