home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Database / CLIPR503.W96 / DBUEDIT.PR_ / DBUEDIT.PR
Text File  |  1995-06-26  |  26KB  |  1,108 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 EmptyFile() .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.             if !EmptyFile() .or. lCanAppend
  420.                keyboard Chr(K_RETURN) + Chr(keystroke)
  421.             endif
  422.          else
  423.             /* check for menu request */
  424.             sysmenu()
  425.  
  426.             do case
  427.             case q_check()
  428.                /* exit */
  429.                lMore := .f.
  430.  
  431.             case local_func == 1
  432.                /* help requested */
  433.                DO syshelp
  434.  
  435.             case local_func == 7
  436.                /* move option selected..only the primary can be moved */
  437.                nRec := Recno()
  438.                move_ptr(aMoveExp, cPrimeDbf)
  439.  
  440.                if ( nRec != Recno() )
  441.                   if ( lAppend )
  442.                      /* no more append mode */
  443.                      lKillAppend := .t.
  444.                   else
  445.                      FreshOrder(oB)
  446.                   end
  447.                end
  448.             end
  449.          end
  450.       end
  451.  
  452.       if ( lKillAppend )
  453.          /* turn off append mode */
  454.          lKillAppend := .f.
  455.          lAppend := .f.
  456.  
  457.          /* refresh respecting any change in index order */
  458.          FreshOrder(oB)
  459.          SetCursor(0)
  460.          curs_on := .f.
  461.       end
  462.  
  463.    end
  464.  
  465.    /* restore the screen */
  466.    RestScreen(8, 0, 23, 79, cBrowseBuf)
  467.    SetColor(nColorSave)
  468.    SetCursor(nCType)
  469.    curs_on := (nCType != 0)
  470.    stat_msg("")
  471.  
  472. return
  473.  
  474.  
  475. /***
  476. *   xmemo()
  477. *
  478. *   memoedit user function
  479. */
  480. func xmemo(mmode, line, col)
  481. local nRet
  482. memvar keystroke,local_func
  483.  
  484.    nRet := 0
  485.  
  486.    if mmode <> ME_IDLE
  487.       /* check for menu request */
  488.       keystroke := Lastkey()
  489.       sysmenu()
  490.  
  491.       do case
  492.       case local_func == 1
  493.          /* help requested */
  494.          do syshelp
  495.  
  496.       case keystroke == K_INS
  497.          /* insert key pressed */
  498.          tog_insert()
  499.          nRet := ME_IGNORE
  500.  
  501.       case keystroke == K_ESC
  502.          /* escape key pressed */
  503.          if mmode == ME_UNKEYX
  504.             /* memo has been altered */
  505.             if rsvp("Ok To Lose Changes? (Y/N)") <> "Y"
  506.                /* no exit if not confirmed (32 == ignore) */
  507.                nRet := ME_IGNORE
  508.             end
  509.          end
  510.       end
  511.    end
  512.  
  513. return (nRet)
  514.  
  515.  
  516. /***
  517. *   tog_insert()
  518. *
  519. *   ditto
  520. */
  521. static func tog_insert
  522. local nCType
  523.  
  524.    Readinsert(!Readinsert())
  525.    nCType := SetCursor(0)
  526.    show_insert()
  527.    SetCursor(nCType)
  528.  
  529. return (0)
  530.  
  531.  
  532. /***
  533. *   show_insert()
  534. *
  535. *   display current insert mode
  536. */
  537. static func show_insert
  538. local nColorSave
  539.  
  540.    nColorSave := SetColor(color7)
  541.    @ 9,4 say if(ReadInsert(), "<Insert>", "        ")
  542.    SetColor(nColorSave)
  543.  
  544. return (0)
  545.  
  546.  
  547. /***
  548. *   statline()
  549. *
  550. *   update the status line in the browse window
  551. */
  552. static func statline(oB, lAppend, cAlias)
  553. local cColorSave, cCurrAlias, lNoFilter, nWaSave, nCType
  554.  
  555.    /* preserve current state */
  556.    nCType := SetCursor(0)
  557.  
  558.    nWaSave := Select()
  559.    if ( !Empty(cAlias) )
  560.       Select(cAlias)
  561.    end
  562.  
  563.    cColorSave := SetColor(color7)
  564.  
  565.    /* show current mode */
  566.    show_insert()
  567.  
  568.    /* show filter status */
  569.    lNoFilter := Empty(&("kf" + Substr("123456", Select(), 1)))
  570.    @ 9,16 say if(lNoFilter, "        ", "<Filter>")
  571.  
  572.    /* display record pointer information */
  573.    @ 9,41 say if(Empty(cAlias), space(10), Lpad(cAlias + "->", 10));
  574.             + "Record "
  575.  
  576.    if ( EmptyFile() .and. .not. lAppend )
  577.       /* file is empty */
  578.       @ 9,58 say "<none>               "
  579.    elseif ( Eof() )
  580.       /* no record number if eof */
  581.       @ 9,28 say "         "
  582.       @ 9,58 say "                " + if(lAppend, "<new>", "<eof>")
  583.    else
  584.       /* normal record..display recno()/lastrec() and deleted() */
  585.       @ 9,28 say if(Deleted(), "<Deleted>", "         ")
  586.       @ 9,58 say Pad(Ltrim(Str(Recno())) + "/" + Ltrim(Str(Lastrec())),15)+;
  587.                If(oB:hitTop, " <bof>", if(oB:hitBottom, " <eof>", "      "))
  588.    end
  589.  
  590.    /* restore state */
  591.    SetColor(cColorSave)
  592.    Select(nWaSave)
  593.    SetCursor(nCType)
  594.  
  595. return (0)
  596.  
  597.  
  598. /***
  599. *   move_ptr()
  600. *
  601. *   seek, goto, locate, skip
  602. *
  603. *   the following array is defined and initialized in browse:
  604. *      aMoveExp[1] == the last SEEK expression
  605. *      aMoveExp[2] == the last GOTO value
  606. *      aMoveExp[3] == the last LOCATE expressions
  607. *      aMoveExp[4] == the last SKIP value
  608. */
  609. static func move_ptr(aMoveExp, cPrimeDbf)
  610.  
  611. local nHelpSave,aBox
  612. memvar okee_dokee, k_trim, movp_sel, titl_str, exp_label
  613. memvar help_code,local_sel,ntx_expr
  614. private okee_dokee, k_trim, movp_sel, titl_str, exp_label, ntx_expr
  615.  
  616.    nHelpSave := help_code
  617.  
  618.    /* save function select number */
  619.    movp_sel := local_sel
  620.  
  621.    /* initialize expression to previous value, if any */
  622.    k_trim := aMoveExp[movp_sel]
  623.  
  624.    /* set up for multibox */
  625.    aBox := Array(4)
  626.  
  627.    aBox[1] := "movp_title(sysparam)"
  628.    aBox[2] := "movp_exp(sysparam)"
  629.    aBox[3] := "ok_button(sysparam)"
  630.    aBox[4] := "can_button(sysparam)"
  631.  
  632.    do case
  633.    case movp_sel == 1
  634.       /* seek */
  635.       okee_dokee := "do_seek()"
  636.       titl_str := "Seek in file " + cPrimeDbf + "..."
  637.       exp_label := "Expression"
  638.       ntx_expr := Indexkey(0)
  639.       help_code := 13
  640.  
  641.    case movp_sel == 2
  642.       /* goto */
  643.       okee_dokee := "do_goto()"
  644.       titl_str := "Move pointer in file " + cPrimeDbf + " to..."
  645.       exp_label := "Record#"
  646.       help_code := 14
  647.  
  648.    case movp_sel == 3
  649.       /* locate */
  650.       okee_dokee := "do_locate()"
  651.       titl_str := "Locate in file " + cPrimeDbf + "..."
  652.       exp_label := "Expression"
  653.       help_code := 10
  654.  
  655.    case movp_sel == 4
  656.       /* skip */
  657.       okee_dokee := "do_skip()"
  658.       titl_str := "Skip records in file " + cPrimeDbf + "..."
  659.       exp_label := "Number"
  660.       help_code := 20
  661.    end
  662.  
  663.    /* do it */
  664.    set key K_INS to tog_insert
  665.    multibox(14, 17, 5, 2, aBox)
  666.    set key K_INS to
  667.  
  668.    /* save expression for next time */
  669.    aMoveExp[movp_sel] := k_trim
  670.  
  671.    help_code := nHelpSave
  672.  
  673. return (0)
  674.  
  675.  
  676. /***
  677. *   movp_title()
  678. *
  679. *   display title for move pointer functions
  680. */
  681. func movp_title(sysparam)
  682. memvar titl_str
  683. return (box_title(sysparam, titl_str))
  684.  
  685.  
  686. /***
  687. *   movp_exp()
  688. *
  689. *   get parameter for move pointer
  690. */
  691. func movp_exp(sysparam)
  692. memvar exp_label
  693. return (get_k_trim(sysparam, exp_label))
  694.  
  695.  
  696. /***
  697. *   do_seek()
  698. *
  699. *   seek to expression
  700. */
  701. func do_seek
  702.  
  703. local lDone, nRec, cSeekType
  704. memvar k_trim,ntx_expr
  705.  
  706.    lDone := .F.
  707.  
  708.    if Empty(k_trim)
  709.       error_msg("Expression not entered")
  710.    else
  711.       stat_msg("Searching...")
  712.  
  713.       /* save record number in case no find */
  714.       nRec := Recno()
  715.  
  716.       /* determine type for seek */
  717.       cSeekType := Type(ntx_expr)
  718.  
  719.       /* try it */
  720.       do case
  721.       case cSeekType == "C"
  722.          /* character search */
  723.          seek k_trim
  724.  
  725.       case cSeekType == "N"
  726.          /* numeric search */
  727.          seek Val(k_trim)
  728.  
  729.       case cSeekType == "D"
  730.          /* date search */
  731.          seek Ctod(k_trim)
  732.       end
  733.  
  734.       if Found()
  735.          /* operation complete */
  736.          stat_msg("Found")
  737.          lDone := .T.
  738.       else
  739.          /* consider this an error..start over */
  740.          error_msg("Not found")
  741.          goto nRec
  742.       end
  743.    end
  744.  
  745. return (lDone)
  746.  
  747.  
  748. /***
  749. *   do_goto()
  750. *
  751. *   go to record number
  752. */
  753. func do_goto
  754.  
  755. local lDone, nWhich
  756. memvar k_trim
  757.  
  758.    lDone := .F.
  759.    nWhich := Val(k_trim)      && convert to number
  760.  
  761.    do case
  762.    case Empty(k_trim)
  763.       error_msg("Record number not entered")
  764.  
  765.    case .not. Substr(Ltrim(k_trim), 1, 1) $ "-+1234567890"
  766.       error_msg("Record number not numeric")
  767.  
  768.    case nWhich <= 0 .or. nWhich > Lastrec()
  769.       error_msg("Record out of range")
  770.  
  771.    otherwise
  772.       /* operation complete */
  773.       goto nWhich
  774.       lDone := .T.
  775.  
  776.    end
  777.  
  778. return (lDone)
  779.  
  780.  
  781. /***
  782. *   do_locate()
  783. *
  784. *   locate expression
  785. */
  786. func do_locate
  787.  
  788. local lDone, nRec
  789. memvar k_trim
  790.  
  791.    lDone := .F.
  792.  
  793.    do case
  794.    case Empty(k_trim)
  795.       error_msg("Expression not entered")
  796.  
  797.    case Type(k_trim) <> "L"
  798.       error_msg("Expression Type must be Logical")
  799.  
  800.    otherwise
  801.       /* save record number in case no find */
  802.       nRec := Recno()
  803.       stat_msg("Searching...")
  804.  
  805.       if &k_trim
  806.          /* current record meets the condition */
  807.          skip
  808.       end
  809.  
  810.       /* search forward to end of file */
  811.       locate for &k_trim while .T.
  812.  
  813.       if Found()
  814.          /* operation complete */
  815.          stat_msg("Found")
  816.          lDone := .T.
  817.  
  818.       else
  819.          /* consider this an error..start over */
  820.          error_msg("Not found")
  821.          goto nRec
  822.       end
  823.    end
  824.  
  825. return (lDone)
  826.  
  827.  
  828. /***
  829. *   do_skip()
  830. *
  831. *   skip number of records
  832. */
  833. func do_skip
  834.  
  835. local lDone, nSkip
  836. memvar k_trim
  837.  
  838.    lDone := .F.
  839.    nSkip := Val(k_trim)      && convert to number
  840.  
  841.    do case
  842.    case Empty(k_trim)
  843.       error_msg("Skip value not entered")
  844.  
  845.    case .not. Substr(Ltrim(k_trim), 1, 1) $ "-+1234567890"
  846.       error_msg("Skip value not numeric")
  847.  
  848.    case nSkip == 0
  849.       error_msg("Skip value zero")
  850.  
  851.    otherwise
  852.       /* no out of range or over-skip error */
  853.       lDone := .T.
  854.  
  855.       skip nSkip
  856.  
  857.       if Eof()
  858.          /* over-skip..clear eof flag */
  859.          go bottom
  860.       end
  861.  
  862.       if Bof()
  863.          /* over-skip..clear bof flag */
  864.          go top
  865.       end
  866.    end
  867.  
  868. return (lDone)
  869.  
  870.  
  871. /***
  872. *   EmptyFile()
  873. */
  874.  
  875. static func EmptyFile()
  876.  
  877.    if (LastRec() == 0 )
  878.       return (.t.)
  879.    end
  880.  
  881.    if ( (Eof() .or. Recno() == LastRec() + 1) .and. Bof() )
  882.       return (.t.)
  883.    end
  884.  
  885. return (.f.)
  886.  
  887.  
  888. /***
  889. *   DoGet()
  890. *
  891. *   Edit the current field
  892. */
  893.  
  894. static func DoGet(oB, lAppend, cAlias)
  895.  
  896. local lExitSave, oCol, oGet, nKey, cExpr, xEval
  897. local lFresh, mGetVar, nWaSave
  898.  
  899.    /* save state */
  900.    lExitSave := Set(_SET_EXIT, .t.)
  901.    nWaSave := Select()
  902.    if ( !Empty(cAlias) )
  903.       Select(cAlias)
  904.    end
  905.  
  906.    /* set insert key to toggle insert mode and cursor */
  907.    set key K_INS to tog_insert
  908.    xkey_clear()
  909.  
  910.    /* get the controlling index key */
  911.    cExpr := IndexKey(0)
  912.    if ( !Empty(cExpr) )
  913.       /* expand key expression for later comparison */
  914.       xEval := &cExpr
  915.    end
  916.  
  917.    /* get column object from browse */
  918.    oCol := oB:getColumn(oB:colPos)
  919.  
  920.    /* use temp for safety */
  921.    mGetVar := Eval(oCol:block)
  922.  
  923.    /* create a corresponding GET with ambiguous set/get block */
  924.    oGet := GetNew(Row(), Col(),                           ;
  925.                {|x| if(PCount() == 0, mGetVar, mGetVar := x)},   ;
  926.                "mGetVar")
  927.  
  928.    /* setup a scrolling GET if it's too long to fit on the screen */
  929.    if oGet:type == "C" .AND. LEN( oGet:varGet() ) > 78
  930.       oGet:picture := "@S78"
  931.    endif
  932.  
  933.    /* refresh flag */
  934.    lFresh := .f.
  935.  
  936.    /* read it */
  937.    BEGIN SEQUENCE
  938.       if ( ReadModal( {oGet} ) )
  939.          /* new data has been entered */
  940.          if ( lAppend .and. Recno() == LastRec() + 1 )
  941.             /* new record confirmed */
  942.             IF !NetAppBlank()
  943.                BREAK    // Let's bail out, we couldn't APPEND BLANK
  944.             ENDIF
  945.          end
  946.  
  947.          IF NetRLock()
  948.             Eval(oCol:block, mGetVar)  // Replace with new data
  949.          ELSE
  950.             BREAK                      // Abort change, we couldn't RLOCK()
  951.          ENDIF
  952.  
  953.          // We appended and/or locked successfully, so now we commit and unlock
  954.          COMMIT
  955.          UNLOCK
  956.  
  957.          /* test for change in index order */
  958.          if ( !Empty(cExpr) .and. !lAppend )
  959.             if ( xEval != &cExpr )
  960.                /* change in index key eval */
  961.                lFresh := .t.
  962.             end
  963.          end
  964.       end
  965.    END SEQUENCE
  966.  
  967.    Select(nWaSave)
  968.    if ( lFresh )
  969.       /* record in new indexed order */
  970.       FreshOrder(oB)
  971.  
  972.       /* no other action */
  973.       nKey := 0
  974.    else
  975.       /* refresh the current row only */
  976.       oB:refreshCurrent()
  977.  
  978.       /* certain keys move cursor after edit if no refresh */
  979.       nKey := ExitKey(lAppend)
  980.    end
  981.  
  982.    /* restore state */
  983.    Set(_SET_EXIT, lExitSave)
  984.    set key K_INS to
  985.    xkey_norm()
  986.  
  987. return (nKey)
  988.  
  989.  
  990. /***
  991. *   ExitKey()
  992. *
  993. *   Determine the follow-up action after editing a field
  994. */
  995.  
  996. static func ExitKey(lAppend)
  997.  
  998. memvar keystroke
  999.  
  1000.    keystroke := LastKey()
  1001.    if ( keystroke == K_PGDN )
  1002.       /* move down if not append mode */
  1003.       if ( lAppend )
  1004.          keystroke := 0
  1005.       else
  1006.          keystroke := K_DOWN
  1007.       end
  1008.  
  1009.    elseif ( keystroke == K_PGUP )
  1010.       /* move up if not append mode */
  1011.       if ( lAppend )
  1012.          keystroke := 0
  1013.       else
  1014.          keystroke := K_UP
  1015.       end
  1016.  
  1017.    elseif ( keystroke == K_RETURN .or. isdata(keystroke) )
  1018.       /* return key or type out..move right */
  1019.       keystroke := K_RIGHT
  1020.  
  1021.    elseif (keystroke != K_UP .and. keystroke != K_DOWN .and. menu_key() == 0)
  1022.       /* no other action */
  1023.       keystroke := 0
  1024.    end
  1025.  
  1026. return (keystroke)
  1027.  
  1028.  
  1029. /***
  1030. *   FreshOrder()
  1031. *
  1032. *   Refresh respecting any change in index order
  1033. */
  1034.  
  1035. static func FreshOrder(oB)
  1036.  
  1037. local nRec
  1038.  
  1039.    nRec := Recno()
  1040.    oB:refreshAll()
  1041.  
  1042.    /* stabilize to see if TBrowse moves the record pointer */
  1043.    oB:forceStable()
  1044.  
  1045.    if ( nRec != LastRec() + 1 )
  1046.       /* record pointer may move if bof is on screen */
  1047.       while ( Recno() != nRec .and. !ob:hitTop )
  1048.          /* falls through unless record is closer to bof than before */
  1049.          oB:up():forceStable()
  1050.       end
  1051.    end
  1052.  
  1053. return (NIL)
  1054.  
  1055.  
  1056. /***
  1057. *   Skipped(n)
  1058. *
  1059. *   Skip thru database and return the
  1060. *   actual number of records skipped
  1061. */
  1062.  
  1063. static func Skipped(nRequest, lAppend)
  1064.  
  1065. local nCount
  1066.  
  1067.    nCount := 0
  1068.    if ( LastRec() != 0 )
  1069.       if ( nRequest == 0 )
  1070.          skip 0
  1071.  
  1072.       elseif ( nRequest > 0 .and. Recno() != LastRec() + 1 )
  1073.          /* forward */
  1074.          while ( nCount < nRequest )
  1075.             skip 1
  1076.             if ( Eof() )
  1077.                if ( lAppend )
  1078.                   /* eof record allowed if append mode */
  1079.                   nCount++
  1080.                else
  1081.                   /* back to last actual record */
  1082.                   skip -1
  1083.                end
  1084.  
  1085.                exit
  1086.             end
  1087.  
  1088.             nCount++
  1089.          end
  1090.  
  1091.       elseif ( nRequest < 0 )
  1092.          /* backward */
  1093.          while ( nCount > nRequest )
  1094.             skip -1
  1095.             if ( Bof() )
  1096.                exit
  1097.             end
  1098.  
  1099.             nCount--
  1100.          end
  1101.       end
  1102.    end
  1103.  
  1104. return (nCount)
  1105.  
  1106.  
  1107. /* eof dbuedit.prg */
  1108.