home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR502.DOS / SOURCE / DBU / DBUEDIT.PRG < prev    next >
Encoding:
Text File  |  1993-02-15  |  21.9 KB  |  1,106 lines
  1. /***
  2. *
  3. *  Dbuedit.prg
  4. *
  5. *  DBU Data File Editing Module
  6. *
  7. *  Copyright (c) 1990-1993, Computer Associates International, Inc.
  8. *  All rights reserved.
  9. *
  10. */
  11.  
  12. #include "inkey.ch"
  13. #include "memoedit.ch"
  14.  
  15. #define TB_REFRESH_RATE    5     // Wait 5 seconds between tbrowse refreshes
  16.  
  17.  
  18. /***
  19. *    browse
  20. *
  21. *    browse one file or the entire View
  22. */
  23. proc browse
  24.  
  25. local i,j,nHelpSave,cNtx,cFieldArray,cFieldName,nWa,cMemo,oB,nRec,;
  26.     cBrowseBuf,nPrimeArea,nHsepRow,cEditField,bAlias,cAlias,nCType,;
  27.     cHead,lMore,lCanAppend,cMemoBuff,aMoveExp,cPrimeDbf,;
  28.    nColorSave,lAppend,lGotKey,lKillAppend,bColBlock
  29.  
  30. /*
  31.  nRefreshTimer forces refresh of browse every TB_REFRESH_RATE seconds
  32.  This serves the purpose of keeping the browse up to date in case we're
  33.  running on a network.
  34. */
  35. local nRefreshTimer  := SECONDS()
  36. local anCursPos[2]
  37.  
  38. memvar keystroke,help_code,func_sel,cur_area,cur_dbf,field_list,frame,;
  39.     curs_on,cur_ntx,ntx1,dbf,local_func,box_open,;
  40.     color1,color7,color8,color9
  41.  
  42.     /* turn off cursor */
  43.     nCType := SetCursor(0)
  44.     curs_on := .f.
  45.  
  46.     /* save prev help code */
  47.     nHelpSave := help_code
  48.  
  49.     /* save, clear, and frame the window */
  50.     cBrowseBuf := SaveScreen(8, 0, 23, 79)
  51.  
  52.     /* array to save move_ptr expressions */
  53.     aMoveExp := Array(4)
  54.     AFill(aMoveExp, "")
  55.  
  56.     /* heading separator row if only one database */
  57.     nHsepRow := 11
  58.  
  59.     /* determine what to browse */
  60.     if ( func_sel == 1 )
  61.         /* browse one file */
  62.         nPrimeArea := cur_area
  63.         cFieldArray := "field_n" + Substr("123456", cur_area, 1)
  64.         cNtx := "ntx" + Substr("123456", cur_area, 1)
  65.         cur_ntx := &cNtx[1]
  66.         cPrimeDbf := Substr(cur_dbf, Rat("\", cur_dbf) + 1)
  67.         lCanAppend := .T.
  68.     else
  69.         /* browse the entire view */
  70.         nPrimeArea := 1
  71.         cFieldArray := "field_list"
  72.         cur_ntx := ntx1[1]
  73.         cPrimeDbf := Substr(dbf[1], Rat("\", dbf[1]) + 1)
  74.         lCanAppend := .F.
  75.  
  76.         if ( "->" $ field_list[afull(field_list)] )
  77.             nHsepRow := 12
  78.         end
  79.     end
  80.  
  81.     /* block to extract alias from alias->field */
  82.     bAlias := &("{|i| if('->' $" + cFieldArray + "[i], Substr(" +;
  83.                 cFieldArray + "[i], 1, At('->'," + cFieldArray +;
  84.                 "[i]) - 1), '')}")
  85.  
  86.     Select(nPrimeArea)
  87.     if ( Eof() )
  88.         /* end of file not allowed */
  89.         go top
  90.     end
  91.  
  92.     /* misc */
  93.     lAppend := .F.
  94.     nRec := 0
  95.  
  96.     /* create TBrowse object */
  97.     nColorSave := SetColor(color7)
  98.     oB := TBrowseDB(10, 1, 23, 78)
  99.  
  100.     oB:headSep := "═╤═"
  101.     oB:colSep  := " │ "
  102.     oB:footSep := "═╧═"
  103.     oB:skipBlock := {|x| Skipped(x, lAppend)}
  104.  
  105.     /* put columns into browse */
  106.     j := Len(&cFieldArray)
  107.     for i := 1 TO j
  108.         if ( Empty(&cFieldArray[i]) )
  109.             EXIT
  110.         end
  111.  
  112.         /* determine workarea/alias stuff */
  113.         cEditField := &cFieldArray[i]
  114.         if ( "->" $ cEditField )
  115.             cAlias := Substr(cEditField, 1, At("->", cEditField) + 1)
  116.             cFieldName := Substr(cEditField, At("->", cEditField) + 2)
  117.             cHead := cAlias + ";" + cFieldName
  118.             nWa := Select(cAlias)
  119.         else
  120.             cAlias := ""
  121.             cFieldName := cHead := cEditField
  122.             nWa := Select()
  123.         end
  124.  
  125.         /* memos are handled differently */
  126.         if ( ValType(&cEditField) == "M" )
  127.             bColBlock := &("{|| '  <Memo>  '}")
  128.         else
  129.             bColBlock := FieldWBlock(cFieldName, nWa)
  130.         end
  131.  
  132.         /* add one column */
  133.         oB:addColumn(TBColumnNew(cHead, bColBlock))
  134.     next
  135.  
  136.     /* initialize parts of screen not handled by TBrowse */
  137.     stat_msg("")
  138.     scroll(8, 0, 23, 79, 0)
  139.     @ 8, 0, 23, 79 BOX frame
  140.     @ nHsepRow, 0 SAY "╞"
  141.     @ nHsepRow, 79 SAY "╡"
  142.  
  143.     /* init rest of locals */
  144.     cAlias := ""
  145.     lKillAppend := .f.
  146.     if ( (LastRec() == 0) .and. lCanAppend )
  147.         /* empty file..force append mode */
  148.         keystroke := K_DOWN
  149.         lGotKey := .t.
  150.     else
  151.         lGotKey := .f.
  152.     end
  153.  
  154.     lMore := .t.
  155.     while (lMore)
  156.       
  157.         if ( !lGotKey )
  158.             /* keystroke will interrupt stabilize */
  159.             while ( !oB:stabilize() )
  160.                 if ( (keystroke := Inkey()) != 0 )
  161.                     lGotKey := .t.
  162.                     exit
  163.                 end
  164.             end
  165.         end
  166.  
  167.         if ( !lGotKey )
  168.             if ( oB:hitBottom .and. lCanAppend )
  169.                 /* turn on or continue append mode */
  170.                 if ( !lAppend .or. Recno() != LastRec() + 1 )
  171.                     if ( lAppend )
  172.                         /* continue append mode */
  173.                   oB:refreshCurrent():forceStable()
  174.                         go bottom
  175.                     else
  176.                         /* first append */
  177.                         lAppend := .t.
  178.                         SetCursor(1)
  179.                         curs_on := .t.
  180.                     end
  181.  
  182.                     /* move down and stabilize to set rowPos */
  183.                oB:down():forceStable()
  184.                 end
  185.             end
  186.  
  187.             /* display status */
  188.             cAlias := Eval(bAlias, oB:colPos)
  189.             statline(oB, lAppend, cAlias)
  190.  
  191.             /* stabilize again for correct cursor pos */
  192.          WHILE !oB:stabilize() ; END
  193.  
  194.          // If TB_REFRESH_RATE seconds has elapsed, refresh the browse
  195.          // This is neccessary on a network environment to insure updated
  196.          // browses for each user
  197.          WHILE (( keystroke := INKEY()) == 0 )
  198.             IF (( nRefreshTimer + TB_REFRESH_RATE ) < SECONDS() )
  199.                DISPBEGIN()
  200.                anCursPos := { ROW(), COL() }
  201.                FreshOrder( oB )
  202.                StatLine( oB, lAppend, cAlias )
  203.                SETPOS( anCursPos[1], anCursPos[2] )
  204.                DISPEND()
  205.                nRefreshTimer := SECONDS()
  206.             ENDIF
  207.          END
  208.  
  209.         else
  210.             /* reset for next loop */
  211.             lGotKey := .f.
  212.         end
  213.  
  214.         do case
  215.         case keystroke == K_DOWN
  216.             if ( lAppend )
  217.                 oB:hitBottom := .t.
  218.             else
  219.                 oB:down()
  220.             end
  221.  
  222.         case keystroke == K_UP
  223.             if ( lAppend )
  224.                 lKillAppend := .t.
  225.             else
  226.                 oB:up()
  227.             end
  228.  
  229.         case keystroke == K_PGDN
  230.             if ( lAppend )
  231.                 oB:hitBottom := .t.
  232.             else
  233.                 oB:pageDown()
  234.             end
  235.  
  236.         case keystroke == K_PGUP
  237.             if ( lAppend )
  238.                 lKillAppend := .t.
  239.             else
  240.                 oB:pageUp()
  241.             end
  242.  
  243.         case keystroke == K_CTRL_PGUP
  244.             if ( lAppend )
  245.                 lKillAppend := .t.
  246.             else
  247.                 oB:goTop()
  248.             end
  249.  
  250.         case keystroke == K_CTRL_PGDN
  251.             if ( lAppend )
  252.                 lKillAppend := .t.
  253.             else
  254.                 oB:goBottom()
  255.             end
  256.  
  257.         case keystroke == K_RIGHT
  258.             oB:right()
  259.  
  260.         case keystroke == K_LEFT
  261.             oB:left()
  262.  
  263.         case keystroke == K_HOME
  264.             oB:home()
  265.  
  266.         case keystroke == K_END
  267.             oB:end()
  268.  
  269.         case keystroke == K_CTRL_LEFT
  270.             oB:panLeft()
  271.  
  272.         case keystroke == K_CTRL_RIGHT
  273.             oB:panRight()
  274.  
  275.         case keystroke == K_CTRL_HOME
  276.             oB:panHome()
  277.  
  278.         case keystroke == K_CTRL_END
  279.             oB:panEnd()
  280.  
  281.         case keystroke == K_DEL
  282.             /* toggle deleted() flag */
  283.          oB:forceStable()
  284.             cAlias := Eval(bAlias, oB:colPos)
  285.             if ( !Empty(cAlias) )
  286.                 Select(cAlias)
  287.             end
  288.  
  289.             if ( Recno() != Lastrec() + 1 )
  290.             IF NetRLock()
  291.                
  292.                // We've got a lock...
  293.                // If the record is deleted, recall it, and vice-versa
  294.                IF DELETED()
  295.                   RECALL
  296.                ELSE
  297.                   DELETE
  298.                END
  299.  
  300.                COMMIT
  301.                UNLOCK
  302.  
  303.             ENDIF
  304.             end
  305.  
  306.             Select(nPrimeArea)
  307.  
  308.         case keystroke == K_INS
  309.             /*toggle insert mode */
  310.             tog_insert()
  311.  
  312.         case keystroke == K_RETURN
  313.             /* edit the current field */
  314.  
  315.          if bof() .and. eof() .and. !lAppend
  316.             keyboard chr( K_DOWN ) + chr( nextkey() )
  317.             loop
  318.          endif
  319.  
  320.          oB:forceStable()
  321.  
  322.             cAlias := Eval(bAlias, oB:colPos)
  323.  
  324.             if ( !Empty(cAlias) )
  325.                 Select(cAlias)
  326.             end
  327.  
  328.              if ( !lAppend .and. (Recno() == LastRec() + 1) )
  329.                 Select(nPrimeArea)
  330.                 loop    /* NOTE */
  331.             end
  332.  
  333.             Select(nPrimeArea)
  334.  
  335.             /* make sure the display is correct */
  336.             oB:hitTop := .f.
  337.             Statline(oB, lAppend, cAlias)
  338.          WHILE !oB:stabilize() ; END
  339.  
  340.             cEditField := &cFieldArray[oB:colPos]
  341.  
  342.             /* turn the cursor on */
  343.             SetCursor(1)
  344.             curs_on := .t.
  345.  
  346.             if ( Type(cEditField) == "M" )
  347.                 /* edit memo field */
  348.                 help_code := 19
  349.                 box_open := .t.
  350.  
  351.                 /* save, clear, and frame window for memoedit */
  352.                 cMemoBuff := SaveScreen(10, 10, 22, 69)
  353.  
  354.                 SetColor(color8)
  355.                 Scroll(10, 10, 22, 69, 0)
  356.                 @ 10, 10, 22, 69 BOX frame
  357.  
  358.                 /* use fieldspec for title */
  359.                 SetColor(color9)
  360.                 @ 10,((76 - Len(cEditField)) / 2) SAY "  " + cEditField + "  "
  361.  
  362.                 /* edit the memo field */
  363.                 SetColor(color8)
  364.                 cMemo := MemoEdit(&cEditField, 11, 11, 21, 68,.T.,"xmemo")
  365.  
  366.                 if Lastkey() == K_CTRL_END
  367.                     /* ^W..new memo confirmed */
  368.  
  369.                BEGIN SEQUENCE
  370.                   IF ( lAppend .and. Eof() )
  371.                      /* First data in new record */
  372.                      IF !NetAppBlank()
  373.                         BREAK    // Abort since we couldn't append
  374.                      ENDIF
  375.                   ELSE
  376.                      /* Just editing... */
  377.                      IF !NetRLock()
  378.                         BREAK    // Abort since we couldn't lock it
  379.                      ENDIF
  380.                   END
  381.  
  382.                   REPLACE &cEditField WITH cMemo
  383.                   COMMIT
  384.                   UNLOCK
  385.  
  386.                END SEQUENCE
  387.  
  388.                     /* move to next field */
  389.                     keystroke := K_RIGHT
  390.                     lGotKey := .t.
  391.                 else
  392.                     keystroke := 0
  393.                 end
  394.  
  395.                 /* restore the window */
  396.                 RestScreen(10, 10, 22, 69, cMemoBuff)
  397.                 box_open := .F.
  398.             else
  399.                 /* regular data entry */
  400.                 SetColor(color1)
  401.                 keystroke := DoGet(oB, lAppend, cAlias)
  402.                 lGotKey := ( keystroke != 0 )
  403.             end
  404.  
  405.          lKillAppend := .T.
  406.  
  407.             /* turn off the cursor unless append mode */
  408.             if ( !lAppend )
  409.                 SetCursor(0)
  410.                 curs_on := .f.
  411.             end
  412.  
  413.             help_code := nHelpSave
  414.             SetColor(color7)
  415.  
  416.         otherwise
  417.             if ( isdata(keystroke) )
  418.                 /* forward data keystroke to GET system */
  419.                 keyboard Chr(K_RETURN) + Chr(keystroke)
  420.             else
  421.                 /* check for menu request */
  422.                 sysmenu()
  423.  
  424.                 do case
  425.                 case q_check()
  426.                     /* exit */
  427.                     lMore := .f.
  428.  
  429.                 case local_func == 1
  430.                     /* help requested */
  431.                     DO syshelp
  432.  
  433.                 case local_func == 7
  434.                     /* move option selected..only the primary can be moved */
  435.                     nRec := Recno()
  436.                     move_ptr(aMoveExp, cPrimeDbf)
  437.  
  438.                     if ( nRec != Recno() )
  439.                         if ( lAppend )
  440.                             /* no more append mode */
  441.                             lKillAppend := .t.
  442.                         else
  443.                             FreshOrder(oB)
  444.                         end
  445.                     end
  446.                 end
  447.             end
  448.         end
  449.  
  450.         if ( lKillAppend )
  451.             /* turn off append mode */
  452.             lKillAppend := .f.
  453.             lAppend := .f.
  454.  
  455.             /* refresh respecting any change in index order */
  456.             FreshOrder(oB)
  457.             SetCursor(0)
  458.             curs_on := .f.
  459.       end
  460.  
  461.     end
  462.  
  463.     /* restore the screen */
  464.     RestScreen(8, 0, 23, 79, cBrowseBuf)
  465.     SetColor(nColorSave)
  466.     SetCursor(nCType)
  467.     curs_on := (nCType != 0)
  468.     stat_msg("")
  469.  
  470. return
  471.  
  472.  
  473. /***
  474. *    xmemo()
  475. *
  476. *    memoedit user function
  477. */
  478. func xmemo(mmode, line, col)
  479. local nRet
  480. memvar keystroke,local_func
  481.  
  482.     nRet := 0
  483.  
  484.     if mmode <> ME_IDLE
  485.         /* check for menu request */
  486.         keystroke := Lastkey()
  487.         sysmenu()
  488.  
  489.         do case
  490.         case local_func == 1
  491.             /* help requested */
  492.             do syshelp
  493.  
  494.         case keystroke == K_INS
  495.             /* insert key pressed */
  496.             tog_insert()
  497.             nRet := ME_IGNORE
  498.  
  499.         case keystroke == K_ESC
  500.             /* escape key pressed */
  501.             if mmode == ME_UNKEYX
  502.                 /* memo has been altered */
  503.                 if rsvp("Ok To Lose Changes? (Y/N)") <> "Y"
  504.                     /* no exit if not confirmed (32 == ignore) */
  505.                     nRet := ME_IGNORE
  506.                 end
  507.             end
  508.         end
  509.     end
  510.  
  511. return (nRet)
  512.  
  513.  
  514. /***
  515. *    tog_insert()
  516. *
  517. *    ditto
  518. */
  519. static func tog_insert
  520. local nCType
  521.  
  522.     Readinsert(!Readinsert())
  523.     nCType := SetCursor(0)
  524.     show_insert()
  525.     SetCursor(nCType)
  526.  
  527. return (0)
  528.  
  529.  
  530. /***
  531. *    show_insert()
  532. *
  533. *    display current insert mode
  534. */
  535. static func show_insert
  536. local nColorSave
  537.  
  538.     nColorSave := SetColor(color7)
  539.     @ 9,4 say if(ReadInsert(), "<Insert>", "        ")
  540.     SetColor(nColorSave)
  541.  
  542. return (0)
  543.  
  544.  
  545. /***
  546. *    statline()
  547. *
  548. *    update the status line in the browse window
  549. */
  550. static func statline(oB, lAppend, cAlias)
  551. local cColorSave, cCurrAlias, lNoFilter, nWaSave, nCType
  552.  
  553.     /* preserve current state */
  554.     nCType := SetCursor(0)
  555.  
  556.     nWaSave := Select()
  557.     if ( !Empty(cAlias) )
  558.         Select(cAlias)
  559.     end
  560.  
  561.     cColorSave := SetColor(color7)
  562.  
  563.     /* show current mode */
  564.     show_insert()
  565.  
  566.     /* show filter status */
  567.     lNoFilter := Empty(&("kf" + Substr("123456", Select(), 1)))
  568.     @ 9,16 say if(lNoFilter, "        ", "<Filter>")
  569.  
  570.     /* display record pointer information */
  571.     @ 9,41 say if(Empty(cAlias), space(10), Lpad(cAlias + "->", 10));
  572.                + "Record "
  573.  
  574.     if ( EmptyFile() .and. .not. lAppend )
  575.         /* file is empty */
  576.         @ 9,58 say "<none>               "
  577.     elseif ( Eof() )
  578.         /* no record number if eof */
  579.         @ 9,28 say "         "
  580.         @ 9,58 say "                " + if(lAppend, "<new>", "<eof>")
  581.     else
  582.         /* normal record..display recno()/lastrec() and deleted() */
  583.         @ 9,28 say if(Deleted(), "<Deleted>", "         ")
  584.         @ 9,58 say Pad(Ltrim(Str(Recno())) + "/" + Ltrim(Str(Lastrec())),15)+;
  585.                    If(oB:hitTop, " <bof>", if(oB:hitBottom, " <eof>", "      "))
  586.     end
  587.  
  588.     /* restore state */
  589.     SetColor(cColorSave)
  590.     Select(nWaSave)
  591.     SetCursor(nCType)
  592.  
  593. return (0)
  594.  
  595.  
  596. /***
  597. *    move_ptr()
  598. *
  599. *    seek, goto, locate, skip
  600. *
  601. *    the following array is defined and initialized in browse:
  602. *        aMoveExp[1] == the last SEEK expression
  603. *        aMoveExp[2] == the last GOTO value
  604. *        aMoveExp[3] == the last LOCATE expressions
  605. *        aMoveExp[4] == the last SKIP value
  606. */
  607. static func move_ptr(aMoveExp, cPrimeDbf)
  608.  
  609. local nHelpSave,aBox
  610. memvar okee_dokee, k_trim, movp_sel, titl_str, exp_label
  611. memvar help_code,local_sel,ntx_expr
  612. private okee_dokee, k_trim, movp_sel, titl_str, exp_label, ntx_expr
  613.  
  614.     nHelpSave := help_code
  615.  
  616.     /* save function select number */
  617.     movp_sel := local_sel
  618.  
  619.     /* initialize expression to previous value, if any */
  620.     k_trim := aMoveExp[movp_sel]
  621.  
  622.     /* set up for multibox */
  623.     aBox := Array(4)
  624.  
  625.     aBox[1] := "movp_title(sysparam)"
  626.     aBox[2] := "movp_exp(sysparam)"
  627.     aBox[3] := "ok_button(sysparam)"
  628.     aBox[4] := "can_button(sysparam)"
  629.  
  630.     do case
  631.     case movp_sel == 1
  632.         /* seek */
  633.         okee_dokee := "do_seek()"
  634.         titl_str := "Seek in file " + cPrimeDbf + "..."
  635.         exp_label := "Expression"
  636.         ntx_expr := Indexkey(0)
  637.         help_code := 13
  638.  
  639.     case movp_sel == 2
  640.         /* goto */
  641.         okee_dokee := "do_goto()"
  642.         titl_str := "Move pointer in file " + cPrimeDbf + " to..."
  643.         exp_label := "Record#"
  644.         help_code := 14
  645.  
  646.     case movp_sel == 3
  647.         /* locate */
  648.         okee_dokee := "do_locate()"
  649.         titl_str := "Locate in file " + cPrimeDbf + "..."
  650.         exp_label := "Expression"
  651.         help_code := 10
  652.  
  653.     case movp_sel == 4
  654.         /* skip */
  655.         okee_dokee := "do_skip()"
  656.         titl_str := "Skip records in file " + cPrimeDbf + "..."
  657.         exp_label := "Number"
  658.         help_code := 20
  659.     end
  660.  
  661.     /* do it */
  662.     set key K_INS to tog_insert
  663.     multibox(14, 17, 5, 2, aBox)
  664.     set key K_INS to
  665.  
  666.     /* save expression for next time */
  667.     aMoveExp[movp_sel] := k_trim
  668.  
  669.     help_code := nHelpSave
  670.  
  671. return (0)
  672.  
  673.  
  674. /***
  675. *    movp_title()
  676. *
  677. *    display title for move pointer functions
  678. */
  679. func movp_title(sysparam)
  680. memvar titl_str
  681. return (box_title(sysparam, titl_str))
  682.  
  683.  
  684. /***
  685. *    movp_exp()
  686. *
  687. *    get parameter for move pointer
  688. */
  689. func movp_exp(sysparam)
  690. memvar exp_label
  691. return (get_k_trim(sysparam, exp_label))
  692.  
  693.  
  694. /***
  695. *    do_seek()
  696. *
  697. *    seek to expression
  698. */
  699. func do_seek
  700.  
  701. local lDone, nRec, cSeekType
  702. memvar k_trim,ntx_expr
  703.  
  704.     lDone := .F.
  705.  
  706.     if Empty(k_trim)
  707.         error_msg("Expression not entered")
  708.     else
  709.         stat_msg("Searching...")
  710.  
  711.         /* save record number in case no find */
  712.         nRec := Recno()
  713.  
  714.         /* determine type for seek */
  715.         cSeekType := Type(ntx_expr)
  716.  
  717.         /* try it */
  718.         do case
  719.         case cSeekType == "C"
  720.             /* character search */
  721.             seek k_trim
  722.  
  723.         case cSeekType == "N"
  724.             /* numeric search */
  725.             seek Val(k_trim)
  726.  
  727.         case cSeekType == "D"
  728.             /* date search */
  729.             seek Ctod(k_trim)
  730.         end
  731.  
  732.         if Found()
  733.             /* operation complete */
  734.             stat_msg("Found")
  735.             lDone := .T.
  736.         else
  737.             /* consider this an error..start over */
  738.             error_msg("Not found")
  739.             goto nRec
  740.         end
  741.     end
  742.  
  743. return (lDone)
  744.  
  745.  
  746. /***
  747. *    do_goto()
  748. *
  749. *    go to record number
  750. */
  751. func do_goto
  752.  
  753. local lDone, nWhich
  754. memvar k_trim
  755.  
  756.     lDone := .F.
  757.     nWhich := Val(k_trim)        && convert to number
  758.  
  759.     do case
  760.     case Empty(k_trim)
  761.         error_msg("Record number not entered")
  762.  
  763.     case .not. Substr(Ltrim(k_trim), 1, 1) $ "-+1234567890"
  764.         error_msg("Record number not numeric")
  765.  
  766.     case nWhich <= 0 .or. nWhich > Lastrec()
  767.         error_msg("Record out of range")
  768.  
  769.     otherwise
  770.         /* operation complete */
  771.         goto nWhich
  772.         lDone := .T.
  773.  
  774.     end
  775.  
  776. return (lDone)
  777.  
  778.  
  779. /***
  780. *    do_locate()
  781. *
  782. *    locate expression
  783. */
  784. func do_locate
  785.  
  786. local lDone, nRec
  787. memvar k_trim
  788.  
  789.     lDone := .F.
  790.  
  791.     do case
  792.     case Empty(k_trim)
  793.         error_msg("Expression not entered")
  794.  
  795.     case Type(k_trim) <> "L"
  796.         error_msg("Expression Type must be Logical")
  797.  
  798.     otherwise
  799.         /* save record number in case no find */
  800.         nRec := Recno()
  801.         stat_msg("Searching...")
  802.  
  803.         if &k_trim
  804.             /* current record meets the condition */
  805.             skip
  806.         end
  807.  
  808.         /* search forward to end of file */
  809.         locate for &k_trim while .T.
  810.  
  811.         if Found()
  812.             /* operation complete */
  813.             stat_msg("Found")
  814.             lDone := .T.
  815.  
  816.         else
  817.             /* consider this an error..start over */
  818.             error_msg("Not found")
  819.             goto nRec
  820.         end
  821.     end
  822.  
  823. return (lDone)
  824.  
  825.  
  826. /***
  827. *    do_skip()
  828. *
  829. *    skip number of records
  830. */
  831. func do_skip
  832.  
  833. local lDone, nSkip
  834. memvar k_trim
  835.  
  836.     lDone := .F.
  837.     nSkip := Val(k_trim)        && convert to number
  838.  
  839.     do case
  840.     case Empty(k_trim)
  841.         error_msg("Skip value not entered")
  842.  
  843.     case .not. Substr(Ltrim(k_trim), 1, 1) $ "-+1234567890"
  844.         error_msg("Skip value not numeric")
  845.  
  846.     case nSkip == 0
  847.         error_msg("Skip value zero")
  848.  
  849.     otherwise
  850.         /* no out of range or over-skip error */
  851.         lDone := .T.
  852.  
  853.         skip nSkip
  854.  
  855.         if Eof()
  856.             /* over-skip..clear eof flag */
  857.             go bottom
  858.         end
  859.  
  860.         if Bof()
  861.             /* over-skip..clear bof flag */
  862.             go top
  863.         end
  864.     end
  865.  
  866. return (lDone)
  867.  
  868.  
  869. /***
  870. *    EmptyFile()
  871. */
  872.  
  873. static func EmptyFile()
  874.  
  875.     if (LastRec() == 0 )
  876.         return (.t.)
  877.     end
  878.  
  879.     if ( (Eof() .or. Recno() == LastRec() + 1) .and. Bof() ) 
  880.         return (.t.)
  881.     end
  882.  
  883. return (.f.)
  884.  
  885.  
  886. /***
  887. *    DoGet()
  888. *
  889. *    Edit the current field
  890. */
  891.  
  892. static func DoGet(oB, lAppend, cAlias)
  893.  
  894. local lExitSave, oCol, oGet, nKey, cExpr, xEval
  895. local lFresh, mGetVar, nWaSave
  896.  
  897.     /* save state */
  898.     lExitSave := Set(_SET_EXIT, .t.)
  899.     nWaSave := Select()
  900.     if ( !Empty(cAlias) )
  901.         Select(cAlias)
  902.     end
  903.  
  904.     /* set insert key to toggle insert mode and cursor */
  905.     set key K_INS to tog_insert
  906.     xkey_clear()
  907.  
  908.     /* get the controlling index key */
  909.     cExpr := IndexKey(0)
  910.     if ( !Empty(cExpr) )
  911.         /* expand key expression for later comparison */
  912.         xEval := &cExpr
  913.     end
  914.  
  915.     /* get column object from browse */
  916.     oCol := oB:getColumn(oB:colPos)
  917.  
  918.     /* use temp for safety */
  919.     mGetVar := Eval(oCol:block)
  920.  
  921.     /* create a corresponding GET with ambiguous set/get block */
  922.     oGet := GetNew(Row(), Col(),                                    ;
  923.                    {|x| if(PCount() == 0, mGetVar, mGetVar := x)},    ;
  924.                    "mGetVar")
  925.  
  926.    /* setup a scrolling GET if it's too long to fit on the screen */
  927.    if oGet:type == "C" .AND. LEN( oGet:varGet() ) > 78
  928.       oGet:picture := "@S78"
  929.    endif
  930.  
  931.     /* refresh flag */
  932.     lFresh := .f.
  933.  
  934.     /* read it */
  935.    BEGIN SEQUENCE
  936.       if ( ReadModal( {oGet} ) )
  937.          /* new data has been entered */
  938.          if ( lAppend .and. Recno() == LastRec() + 1 )
  939.             /* new record confirmed */
  940.             IF !NetAppBlank()
  941.                BREAK    // Let's bail out, we couldn't APPEND BLANK
  942.             ENDIF
  943.          end
  944.  
  945.          IF NetRLock()
  946.             Eval(oCol:block, mGetVar)  // Replace with new data
  947.          ELSE
  948.             BREAK                      // Abort change, we couldn't RLOCK()
  949.          ENDIF
  950.  
  951.          // We appended and/or locked successfully, so now we commit and unlock
  952.          COMMIT
  953.          UNLOCK
  954.  
  955.          /* test for change in index order */
  956.          if ( !Empty(cExpr) .and. !lAppend )
  957.             if ( xEval != &cExpr )
  958.                /* change in index key eval */
  959.                lFresh := .t.
  960.             end
  961.          end
  962.       end
  963.    END SEQUENCE
  964.  
  965.     Select(nWaSave)
  966.     if ( lFresh )
  967.         /* record in new indexed order */
  968.         FreshOrder(oB)
  969.  
  970.         /* no other action */
  971.         nKey := 0
  972.     else
  973.         /* refresh the current row only */
  974.         oB:refreshCurrent()
  975.  
  976.         /* certain keys move cursor after edit if no refresh */
  977.         nKey := ExitKey(lAppend)
  978.     end
  979.  
  980.     /* restore state */
  981.     Set(_SET_EXIT, lExitSave)
  982.     set key K_INS to
  983.     xkey_norm()
  984.  
  985. return (nKey)
  986.  
  987.  
  988. /***
  989. *    ExitKey()
  990. *
  991. *    Determine the follow-up action after editing a field
  992. */
  993.  
  994. static func ExitKey(lAppend)
  995.  
  996. memvar keystroke
  997.  
  998.     keystroke := LastKey()
  999.     if ( keystroke == K_PGDN )
  1000.         /* move down if not append mode */
  1001.         if ( lAppend )
  1002.             keystroke := 0
  1003.         else
  1004.             keystroke := K_DOWN
  1005.         end
  1006.  
  1007.     elseif ( keystroke == K_PGUP )
  1008.         /* move up if not append mode */
  1009.         if ( lAppend )
  1010.             keystroke := 0
  1011.         else
  1012.             keystroke := K_UP
  1013.         end
  1014.  
  1015.     elseif ( keystroke == K_RETURN .or. isdata(keystroke) )
  1016.         /* return key or type out..move right */
  1017.         keystroke := K_RIGHT
  1018.  
  1019.     elseif (keystroke != K_UP .and. keystroke != K_DOWN .and. menu_key() == 0)
  1020.         /* no other action */
  1021.         keystroke := 0
  1022.     end
  1023.  
  1024. return (keystroke)
  1025.  
  1026.  
  1027. /***
  1028. *    FreshOrder()
  1029. *
  1030. *    Refresh respecting any change in index order
  1031. */
  1032.  
  1033. static func FreshOrder(oB)
  1034.  
  1035. local nRec
  1036.  
  1037.     nRec := Recno()
  1038.     oB:refreshAll()
  1039.  
  1040.     /* stabilize to see if TBrowse moves the record pointer */
  1041.    oB:forceStable()
  1042.  
  1043.     if ( nRec != LastRec() + 1 )
  1044.         /* record pointer may move if bof is on screen */
  1045.         while ( Recno() != nRec )
  1046.             /* falls through unless record is closer to bof than before */
  1047.          oB:up():forceStable()
  1048.         end
  1049.     end
  1050.  
  1051. return (NIL)
  1052.  
  1053.  
  1054. /***
  1055. *    Skipped(n)
  1056. *
  1057. *    Skip thru database and return the
  1058. *    actual number of records skipped
  1059. */
  1060.  
  1061. static func Skipped(nRequest, lAppend)
  1062.  
  1063. local nCount
  1064.  
  1065.     nCount := 0
  1066.     if ( LastRec() != 0 )
  1067.         if ( nRequest == 0 )
  1068.             skip 0
  1069.  
  1070.         elseif ( nRequest > 0 .and. Recno() != LastRec() + 1 )
  1071.             /* forward */
  1072.             while ( nCount < nRequest )
  1073.                 skip 1
  1074.                 if ( Eof() )
  1075.                     if ( lAppend )
  1076.                         /* eof record allowed if append mode */
  1077.                         nCount++
  1078.                     else
  1079.                         /* back to last actual record */
  1080.                         skip -1
  1081.                     end
  1082.  
  1083.                     exit
  1084.                 end
  1085.  
  1086.                 nCount++
  1087.             end
  1088.  
  1089.         elseif ( nRequest < 0 )
  1090.             /* backward */
  1091.             while ( nCount > nRequest )
  1092.                 skip -1
  1093.                 if ( Bof() )
  1094.                     exit
  1095.                 end
  1096.  
  1097.                 nCount--
  1098.             end
  1099.         end
  1100.     end
  1101.  
  1102. return (nCount)
  1103.  
  1104.  
  1105. /* eof dbuedit.prg */
  1106.