/* file dbedit.prg 
 *  Purpose: provide alternate (traditional) edit mode 
 * 
 *  Copyright (c) 1990-1993, Computer Associates International Inc. 
 *  All rights reserved. 
 * 
 >  Root program (c) 1992, 1993 (c) Computer Associates 
 >  Reference:   (\clipper\source\sample\tbdemo.prg) 
 > 
 >  Function db_Help (c) 1993, 1994 Mickey R. Burnette, unpublished original work 
 >                   (c) 1993, 1994 SofKinetics, Inc., all rights reserved 
 > 
 >  History: 04/04/93 Initial release 
 >           01/05/94 Added comments to function in prep to upload to CompuServe 
 >           01/05/94 db_Help() placed in the public domain by author. Enjoy. 
 */ 
  
 #include "Inkey.ch" 
 #include "directry.ch" 
 #include "Setcurs.ch" 
 #include "Error.ch" 
 #include "box.ch" 
 #include "achoice.ch" 
  
 // These #defines use the browse's "cargo" slot to hold the append mode flag 
 #define TURN_ON_APPEND_MODE(b)      (b:cargo := .T.) 
 #define TURN_OFF_APPEND_MODE(b)     (b:cargo := .F.) 
 #define IS_APPEND_MODE(b)           (b:cargo) 
 #define MY_HEADSEP      "НСН" 
 #define MY_COLSEP       " і " 
  
 FUNCTION dbedit( cFile, cIndex ) 
     LOCAL cScreen, aDirectory := {}, aNames := {}, pitem 
     LOCAL bSaveHandler, error 
     local nRow := row(), nCol := col(), cOldColor 
  
     cScreen := SAVESCREEN() 
  
     if ( IsColor() ) 
 	cOldColor := SetColor("w+/b, b/w, b") 
     else 
 	cOldColor := SetColor("w/n, n/w") 
     end 
  
     Set(_SET_BELL, .f.) 
     Set(_SET_SCOREBOARD, .f.) 
  
     if empty ( cfile ) 
 	clear screen 
 	aDirectory := directory("*.DBF") 
 	asort( aDirectory,,, { | x, y | x[1] < y[1] } ) 
 	aeval(aDirectory, { | File | aadd( aNames, File[F_NAME] ) } ) 
  
 	@ 7, 64 to 18, 77 DOUBLE 
 	pitem := achoice(8, 65, 17, 76, aNames) 
  
 	if pitem > 0 
 		cFile := aNames[pitem] 
 	else 
 		cFile := "" 
 	endif 
  
     endif 
  
     if empty(cfile) 
 	alert("No file chosen!;-OR-;No files to choose!") 
 	SetColor(cOldColor) 
 	SetPos(nRow, nCol) 
 	RESTSCREEN(,,,,cScreen) 
 	QUIT 
     endif 
  
     RESTSCREEN(,,,,cScreen) 
  
     // Lazy man's error checking 
     bSaveHandler := ERRORBLOCK( {|x| BREAK(x)} ) 
  
     BEGIN SEQUENCE 
 	USE ( cFile ) index ( cIndex ) NEW 
  
     RECOVER USING error 
 	IF error:genCode == EG_OPEN 
 	    alert("Error opening file!;Aborting...") 
 	    SetColor(cOldColor) 
 	    SetPos(nRow, nCol) 
 	    RESTSCREEN(,,,,cScreen) 
 	    RETURN NIL 
 	ELSE 
 	    // Assume it was a problem with the params 
 	    alert("Error!;Aborting...") 
 	    SetColor(cOldColor) 
 	    SetPos(nRow, nCol) 
 	    RESTSCREEN(,,,,cScreen) 
 	    RETURN NIL 
 	ENDIF 
  
 	QUIT 
     END 
  
     // Restore the default error handler 
     ERRORBLOCK(bSaveHandler) 
  
     // Save screen, set color, etc. 
     SETCOLOR("N/BG") 
     CLEAR SCREEN 
     @ 0, 19 SAY "DbEdit Utility by SofKinetics, Incorporated" 
     @ 1, 0 to 1, 79 
     @ 24, 4 SAY "Press ESC to exit editor.  Press ENTER, ALT-F3 for alternate edit mode." 
  
     Set Key K_ALT_F3 to db_Help 
  
     //MyBrowse(3, 6, MAXROW() - 2, MAXCOL() - 6) 
     MyBrowse(3, 0, MAXROW() - 2, MAXCOL() ) 
  
     // Put things back 
     SET COLOR TO 
     SetColor(cOldColor) 
     SetPos(nRow, nCol) 
     RESTSCREEN(,,,,cScreen) 
  
     RETURN NIL 
  
  
 FUNCTION MyBrowse(nTop, nLeft, nBottom, nRight) 
     LOCAL browse                        // The TBrowse object 
     LOCAL cColorSave, nCursSave         // State preservers 
     LOCAL nKey                          // Keystroke 
     LOCAL lMore                         // Loop control 
  
     // Make a "stock" Tbrowse object for the current workarea 
     browse := StockBrowseNew(nTop, nLeft, nBottom, nRight) 
  
     // This demo uses the browse's "cargo" slot to hold a logical 
     // value of true (.T.) when the browse is in "append mode", 
     // otherwise false (.F.) (see #defines at top). 
     TURN_OFF_APPEND_MODE(browse) 
  
     // Use a custom 'skipper' to handle append mode (see below) 
     browse:skipBlock := { |x| Skipper(x, browse) } 
  
  
     // Change the heading and column separators 
     browse:headSep := MY_HEADSEP 
     browse:colSep := MY_COLSEP 
  
     // Play with the colors 
     FancyColors(browse) 
  
     // Insert a column at the left for "Rec #" and freeze it 
     AddRecno(browse) 
  
  
     // Save cursor shape, turn the cursor off while browsing 
     nCursSave := SetCursor(SC_NONE) 
  
     // Scooby DOO WHILE 
     lMore := .T. 
     DO WHILE lMore 
  
 	// Don't let the cursor move into frozen columns 
 	IF browse:colPos <= browse:freeze 
 	    browse:colPos := browse:freeze + 1 
 	ENDIF 
  
 	// Stabilize the display until it's stable or a key is pressed 
 	nKey := 0 
 	DO WHILE nKey == 0 .AND. .NOT. browse:stable 
  
 	    browse:stabilize() 
 	    nKey := InKey() 
  
 	ENDDO 
  
 	IF browse:stable 
  
 	    IF browse:hitBottom .AND. .NOT. IS_APPEND_MODE(browse) 
 		// Banged against EOF; go into append mode 
 		TURN_ON_APPEND_MODE(browse) 
 		nKey := K_DOWN 
  
 	    ELSE 
 		IF browse:hitTop .OR. browse:hitBottom 
 		    TONE(125, 0) 
 		ENDIF 
  
 		// Make sure that the current record is showing 
 		// up-to-date data in case we are on a network. 
 		browse:refreshCurrent() 
 		ForceStable(browse) 
  
 		// Everything's done -- just wait for a key 
 		nKey := InKey(0) 
  
 	    ENDIF 
  
 	ENDIF 
  
 	IF nKey == K_ESC 
 	    // Esc means leave 
 	    lMore := .F. 
  
 	ELSE 
 	    // Apply the key to the browse 
 	    ApplyKey(browse, nKey) 
  
 	ENDIF 
  
     ENDDO 
  
     SETCURSOR(nCursSave) 
  
     RETURN NIL 
  
  
 FUNCTION Skipper(n, browse) 
     LOCAL lAppend 
     LOCAL i 
  
     lAppend := IS_APPEND_MODE(browse)           // see #defines at top 
     i := 0 
  
     IF n == 0 .OR. LASTREC() == 0 
  
 	// Skip 0 (significant on a network) 
 	SKIP 0 
  
     ELSEIF n > 0 .and. RECNO() != LASTREC() + 1 
  
 	// Skip forward 
 	DO WHILE i < n 
 	    SKIP 1 
 	    IF ( EOF() ) 
 		IF ( lAppend ) 
 		    i++ 
 		ELSE 
 		    SKIP -1 
 		ENDIF 
  
 		EXIT 
 	    ENDIF 
  
 	    i++ 
 	ENDDO 
  
     ELSEIF n < 0 
  
 	// Skip backward 
 	DO WHILE i > n 
 	    SKIP -1 
 	    IF ( BOF() ) 
 		EXIT 
 	    ENDIF 
  
 	    i-- 
 	ENDDO 
  
     ENDIF 
  
     RETURN i 
  
 function ApplyKey(browse, nKey) 
  
     DO CASE 
     CASE nKey == K_DOWN 
 	browse:down() 
  
     CASE nKey == K_PGDN 
 	browse:pageDown() 
  
     CASE nKey == K_CTRL_PGDN 
 	browse:goBottom() 
 	TURN_OFF_APPEND_MODE(browse) 
  
     CASE nKey == K_UP 
 	browse:up() 
  
 	IF IS_APPEND_MODE(browse) 
 	    TURN_OFF_APPEND_MODE(browse) 
 	    browse:refreshAll() 
 	ENDIF 
  
     CASE nKey == K_PGUP 
 	browse:pageUp() 
  
 	IF IS_APPEND_MODE(browse) 
 	    TURN_OFF_APPEND_MODE(browse) 
 	    browse:refreshAll() 
 	ENDIF 
  
     CASE nKey == K_CTRL_PGUP 
 	browse:goTop() 
 	TURN_OFF_APPEND_MODE(browse) 
  
     CASE nKey == K_RIGHT 
 	browse:right() 
  
     CASE nKey == K_LEFT 
 	browse:left() 
  
     CASE nKey == K_HOME 
 	browse:home() 
  
     CASE nKey == K_END 
 	browse:end() 
  
     CASE nKey == K_CTRL_LEFT 
 	browse:panLeft() 
  
     CASE nKey == K_CTRL_RIGHT 
 	browse:panRight() 
  
     CASE nKey == K_CTRL_HOME 
 	browse:panHome() 
  
     CASE nKey == K_CTRL_END 
 	browse:panEnd() 
  
     CASE nKey == K_RETURN 
 	DoGet(browse) 
  
     OTHERWISE 
  
 	KEYBOARD CHR(nKey) 
 	DoGet(browse) 
  
     ENDCASE 
  
     RETURN NIL 
  
  
 Function DoGet(browse) 
     LOCAL bIns, lScore, lExit 
     LOCAL col, get, nKey 
     LOCAL lAppend, xOldKey, xNewKey 
  
     // Make sure screen is fully updated, dbf position is correct, etc. 
     ForceStable(browse) 
  
     // If confirming a new record, do the physical append 
     lAppend := IS_APPEND_MODE(browse) 
     IF lAppend .AND. RECNO() == LASTREC() + 1 
 	APPEND BLANK 
     ENDIF 
  
     // Save the current record's key value (or NIL) 
     // (for an explanation, refer to the rambling note below) 
     xOldKey := IF( EMPTY(INDEXKEY()), NIL, &(INDEXKEY()) ) 
  
     // Save global state 
     lScore := Set(_SET_SCOREBOARD, .F.) 
     lExit := Set(_SET_EXIT, .T.) 
     bIns := SetKey(K_INS) 
  
     // Set insert key to toggle insert mode and cursor shape 
     SetKey( K_INS, {|| InsToggle()} ) 
  
     // Set initial cursor shape 
     SetCursor( IF(ReadInsert(), SC_INSERT, SC_NORMAL) ) 
  
     // Get the current column object from the browse 
     col := browse:getColumn(browse:colPos) 
  
     // Create a corresponding GET 
     get := GetNew(Row(), Col(), col:block, col:heading,, browse:colorSpec) 
  
     // Read it using the standard reader 
     // NOTE: for a shared database, an RLOCK() is required here 
     ReadModal( {get} ) 
  
     // Restore state 
     SetCursor(0) 
     Set(_SET_SCOREBOARD, lScore) 
     Set(_SET_EXIT, lExit) 
     SetKey(K_INS, bIns) 
  
     // Get the record's key value (or NIL) after the GET 
     xNewKey := IF( EMPTY(INDEXKEY()), NIL, &(INDEXKEY()) ) 
  
     // If the key has changed (or if this is a new record) 
     IF .NOT. (xNewKey == xOldKey) .OR. (lAppend .AND. xNewKey != NIL) 
  
 	// Do a complete refresh 
 	browse:refreshAll() 
 	ForceStable(browse) 
  
 	// Make sure we're still on the right record after stabilizing 
 	DO WHILE &(INDEXKEY()) > xNewKey .AND. .NOT. browse:hitTop() 
 	    browse:up() 
 	    ForceStable(browse) 
 	ENDDO 
  
     ENDIF 
  
     // turn append mode off after each new record 
     TURN_OFF_APPEND_MODE(browse) 
  
     // Check exit key from get 
     nKey := LASTKEY() 
     IF nKey == K_UP .OR. nKey == K_DOWN .OR. ; 
 	nKey == K_PGUP .OR. nKey == K_PGDN 
  
 	// Ugh 
 	KEYBOARD( CHR(nKey) ) 
  
     ENDIF 
  
     RETURN NIL 
  
  
 FUNCTION ForceStable(browse) 
  
     DO WHILE .NOT. browse:stabilize() 
     ENDDO 
  
     RETURN NIL 
  
  
 Function InsToggle() 
  
     IF READINSERT() 
 	READINSERT(.F.) 
 	SETCURSOR(SC_NORMAL) 
  
     ELSE 
 	READINSERT(.T.) 
 	SETCURSOR(SC_INSERT) 
  
     ENDIF 
  
     RETURN NIL 
  
  
 FUNCTION StockBrowseNew(nTop, nLeft, nBottom, nRight) 
     LOCAL browse 
     LOCAL n, column, cType 
  
     // Start with a new browse object from TBrowseDB() 
     browse := TBrowseDB(nTop, nLeft, nBottom, nRight) 
  
     // Add a column for each field in the current workarea 
     FOR n := 1 TO FCount() 
  
 	// Make a new column 
 	column := TBColumnNew( FieldName(n), ; 
 		FieldWBlock(FieldName(n), Select()) ) 
  
 	// Add the column to the browse 
 	browse:addColumn(column) 
  
     NEXT 
  
     RETURN browse 
  
  
 function FancyColors(browse) 
     LOCAL n, column 
     LOCAL xValue 
  
     // Set up a list of colors for the browse to use 
     browse:colorSpec := "N/W, N/BG, B/W, B/BG, B/W, B/BG, R/W, B/R" 
  
     // Loop through the columns, choose some colors for each 
     FOR n := 1 TO browse:colCount 
  
 	// Get (a reference to) the column 
 	column := browse:getColumn(n) 
  
 	// Get a sample of the underlying data by evaluating the codeblock 
 	xValue := EVAL(column:block) 
  
 	IF VALTYPE(xValue) != "N" 
 	    // For non-numeric, just use colors 3 and 4 ("B/W" and "B/BG") 
 	    column:defColor := {3, 4} 
  
 	ELSE 
 	    // For numbers, use a color block to highlight negative values 
 	    column:colorBlock := {|x| if( x < 0, {7, 8}, {5, 6} )} 
  
 	    // Set default colors also (controls the heading color) 
 	    column:defColor := {7, 8} 
  
 	ENDIF 
  
     NEXT 
  
     RETURN NIL 
  
  
 function AddRecno(browse) 
     LOCAL column 
  
     // Create the column object 
     column := TBColumnNew( "  Rec #", {|| RECNO()} ) 
  
     // Insert it as the leftmost column 
     browse:insColumn(1, column) 
  
     // Freeze it at the left 
     browse:freeze := 1 
  
     RETURN NIL 
  
  
 static function db_Help()       // cProc, nLine, cVar  are not used 
 	local nBottom := maxrow(), nStart := 1, nOffset := 0 
 	local cScreen := savescreen( 0, 0, nBottom, maxcol() ) 
 	local getlist := {}, cFields := {}, cNames := {}, i,  nFields, nVoff, vLoc 
 	local cOldColor := SetColor( "W+/B, N/W, B" ) 
 	local aMsg := { ; 
 		">> Use Cursor Keys to navigate / PgDn to save / Esc to abort <<", ; 
 		">> More fields to edit: PgDn for next screen <<", ; 
 		">> PgUp for previous screen / PgDn to save / Esc to abort <<" } 
  
 	clear screen 
  
 	/* Since this function was written to slave from within tbrowse, we always know 
 	   that we have an active database selected. To make this more generic, a test 
 	   should be made early to determine if a database is truly open 
 	*/ 
 	nFields := fcount() 
  
 	/* nVoff and following code only used to provide an optional top margin. 
 	   This code could be replaced with an algorithm to provide more control 
 	*/ 
 	nVoff := 0 
 	do case 
 		case nFields < ( nBottom * 0.66 ) 
 			nVoff := 5 
  
 		case nFields > ( nBottom * 0.33 ) .and. nFields < ( nBottom * .66 ) 
 			nVoff := 2 
 	end case 
  
 	/* Build the necessary arrays by looping... A more sophisticated routine 
 	   could use an external database or array to look up the fieldnames and 
 	   translate to phrases to be used in the @says. Optional information in 
 	   this database could contain picture information, ranges, validate 
 	   functions, expressions to macro expand to code blocks, etc. 
 	*/ 
 	for  i = 1 to nFields 
 		aadd( cNames, padr(fieldname( i ), 10 ) )       // @ say 
 		aadd( cFields, fieldget( i ) )                  // @ get 
 	next 
  
 	/* Use of the 'Begin Sequence' construct can be enhanced to handle a custom 
 	   Error handler ,etc. Very flexible. 
 	*/ 
 	BEGIN SEQUENCE 
  
 	DO WHILE nOffset <= nFields     // the main loop 
 		clear typeahead ; clear screen 
 		vLoc := 0 
 		for  i = ( nStart + nOffset ) to min( nBottom + nOffset, nFields ) 
 			@ nVoff + vLoc++, 0 say padr(str(i,2),3) + cNames get cFields 
 		next 
 		@ nBottom, 0 say padc( iif( nFields > nBottom, ; 
 					  iif( nOffset > nBottom, aMsg[3], aMsg[2] ), ; 
 					  aMsg[1] ), 80 ) 
  
 		read    // remember that {getlist} is set to null after 'read' 
  
 		// user abort? 
 		if lastkey() == K_ESC 
 			BREAK 
 		endif 
  
 		/* Control keys increment or decrement nOffset.  Note that 
 		   a PdDn or CursorDown out-of-bounds on last display screen 
 		   will set nOffset == nFields, the 'Do' loop will restart but 
 		   the 'for' loop will not execute and {getlist} will be null 
 		   upon entry to READ and remodal will fall thru.  The logic will 
 		   then see nOffset == nFields and increment nOffset by 1, thus 
 		   causing the Do Loop to terminate.  Link with /b and use CLD to 
 		   view this if you question the logic. 
 		*/ 
 		if lastkey() == K_PGUP .or. lastkey() == K_UP 
 			nOffset := max( 0, nOffset - nBottom ) 
 		else 
 			iif( nOffset == nFields, ; 
 				nOffset++, ; 
 				nOffset := min(nOffset + nBottom, nFields) ) 
 		endif 
  
 	ENDDO 
  
 	END SEQUENCE 
  
 	/* Update database is user did not abort using escape. If needed, a commit() 
 	   could be used after the update to force a hard write to disk 
 	*/ 
 	if lastkey() != K_ESC 
 		for i = 1 to nFields 
 			fieldput( i, cFields ) 
 		next 
 	else 
 		tone(300,3) 
 		alert("ESC pressed! Update aborted...", ; 
 			{"Press ENTER"} ) 
 	endif 
  
  
 	/* This routine was entered by interrupting a tbrowse edit, DoGet(). 
 	   Stuff an ENTER into the keyboard buffer to terminate the edit 
 	   condition and update the tbrowse display to reflect any changes to 
 	   the current record. If the routine is to be used outside of a tbrowse, 
 	   then this probably should be removed from the function... 
 	*/ 
 	clear typeahead ; keyboard chr( K_ENTER ) 
 	SetColor( cOldColor ) 
 	restscreen(0, 0, nBottom, maxcol(), cScreen ) 
  
 	Return NIL