From d26010c7e1ed05b215e5a0d02e5d32edd8a5cc88 Mon Sep 17 00:00:00 2001 From: Viktor Szakats Date: Fri, 30 Jul 1999 22:33:32 +0000 Subject: [PATCH] *** empty log message *** --- harbour/ChangeLog | 15 +++ harbour/source/rtl/alert.prg | 211 ++++++++++++++++++++++++++--------- harbour/source/rtl/files.c | 3 + 3 files changed, 175 insertions(+), 54 deletions(-) diff --git a/harbour/ChangeLog b/harbour/ChangeLog index acbc483a48..df121096a3 100644 --- a/harbour/ChangeLog +++ b/harbour/ChangeLog @@ -1,3 +1,18 @@ +19990731-00:05 CET Victor Szel + ! source/rtl/files.c - __CYGWIN__ defines changes rolled back, + to fix the new DOS/DJGPP errors. + + source/rtl/alert.prg - Made almost 100% Clipper compatible. + - Parameter list is now compatible. + - Placing of the box is now compatible. + - Sizing of the box is now compatible. + - Console mode added as in Clipper. + - Color handling compatible. + - Parameter error handling compatible. A Clipper bug fixed. + - Hotkey support added as in Clipper. + - Leaves the cursor where it was. + - Optional support logic for undocumented //NOALERT switch. + - Some small cleanups. + 19990730-21:05 CET Victor Szel * source/rtl/files.c - Two __CYGWIN__ branches joined. diff --git a/harbour/source/rtl/alert.prg b/harbour/source/rtl/alert.prg index 760d35b0f1..cfdffd8f05 100644 --- a/harbour/source/rtl/alert.prg +++ b/harbour/source/rtl/alert.prg @@ -5,6 +5,7 @@ Written by Vladimir Kazimirchik http://i.am/kzm + Clipper compatibility additions by Victor Szel Released into public domain. */ @@ -12,90 +13,192 @@ #include "box.ch" #include "inkey.ch" -Function Alert(cMessage, aOptions, nDelay) +// ; Clipper defines a clipped window for Alert() +// ; Clipper handles these buttons { "Ok", "", "Cancel" } in a buggy way. +// This is fixed. +// ; nDelay function is a Harbour addition. - Local nRet := 0 - Local aSay, nPos, nWidth, nOpWidth, nInitRow, nInitCol, iEval, nChoice - Local nKey, aPos, nCurrent - Local nCursor := SetCursor(0) - Local cScreen +FUNCTION Alert(cMessage, aOptions, cColorNorm, nDelay) + LOCAL nChoice + LOCAL aSay, nPos, nWidth, nOpWidth, nInitRow, nInitCol, iEval + LOCAL nKey, aPos, nCurrent, aHotkey, aOptionsOK + LOCAL cColorHigh - If aOptions = Nil - aOptions := { 'Ok' } - End + LOCAL nOldRow + LOCAL nOldCol + LOCAL nOldCursor + LOCAL cOldScreen - If nDelay = Nil + /* TOFIX: Clipper decides at runtime, wether the GT is linked, */ + /* if it is not, the console mode is selected here */ + LOCAL lConsole := .F. + +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY +// IF "//NOALERT" $ /* cCommandLine */ +// QUIT +// ENDIF +#endif + + IF !(ValType(cMessage) == "C") + RETURN NIL + ENDIF + + IF !(ValType(aOptions) == "A") + aOptions := {} + ENDIF + + IF !(ValType(cColorNorm) == "C") + cColorNorm := 'w+/r' + cColorHigh := 'w+/b' + ELSE + cColorHigh := StrTran(iif(At("/", cColorNorm) == 0, "N", SubStr(cColorNorm, At("/", cColorNorm) + 1)) + "/" +; + iif(At("/", cColorNorm) == 0, cColorNorm, Left(cColorNorm, At("/", cColorNorm) - 1)), "+", "") + ENDIF + + IF nDelay == NIL nDelay := 0 - End + ENDIF aSay := {} - While (nPos := At(';', cMessage)) != 0 + DO WHILE (nPos := At(';', cMessage)) != 0 AAdd(aSay, Left(cMessage, nPos - 1)) cMessage := SubStr(cMessage, nPos + 1) - End + ENDDO AAdd(aSay, cMessage) /* The longest line */ nWidth := 0 AEval(aSay, { |x| nWidth := Max(Len(x), nWidth) }) + /* Cleanup the button array */ + aOptionsOK := {} + FOR iEval := 1 TO Len(aOptions) + IF ValType(aOptions[iEval]) == "C" .AND. !Empty(aOptions[iEval]) + AAdd(aOptionsOK, aOptions[iEval]) + ENDIF + NEXT + + IF Len(aOptionsOK) == 0 + aOptionsOK := { 'Ok' } +#ifdef HARBOUR_STRICT_CLIPPER_COMPATIBILITY + // ; Clipper allows only four options + ELSEIF Len(aOptionsOK) > 4 + aSize(aOptionsOK, 4) +#endif + ENDIF + /* Total width of the botton line (the one with choices) */ nOpWidth := 0 - AEval(aOptions, { |x| nOpWidth += Len(x) + 3 }) - nOpWidth += 3 + AEval(aOptionsOK, { |x| nOpWidth += Len(x) + 4 }) /* what's wider ? */ - nWidth := Max(nWidth, nOpWidth) + 2 /* 2 spaces on the edges */ + nWidth := Max(nWidth + 2 + iif(Len(aSay) == 1, 4, 0), nOpWidth + 2) /* box coordinates */ - nInitRow := Int((MaxRow() - (Len(aSay) + 4)) / 2) + 1 - nInitCol := Int((MaxCol() - (nWidth + 4)) / 2) + 1 + nInitRow := Int(((MaxRow() - (Len(aSay) + 4)) / 2) + .5) + nInitCol := Int(((MaxCol() - (nWidth + 2)) / 2) + .5) /* detect prompts positions */ aPos := {} - nCurrent := nInitCol + Int((nWidth - nOpWidth) / 2) + 4 - AEval(aOptions, { |x| AAdd(aPos, nCurrent), nCurrent += Len(x) + 3 }) + aHotkey := {} + nCurrent := nInitCol + Int((nWidth - nOpWidth) / 2) + 2 + AEval(aOptionsOK, { |x| AAdd(aPos, nCurrent), AAdd(aHotKey, Upper(Left(x, 1))), nCurrent += Len(x) + 4 }) + IF lConsole - cScreen = SaveScreen( nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1 ) - /* draw box */ - @ nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1 ; - Box B_SINGLE + ' ' Color 'w+/r' - For iEval := 1 To Len(aSay) - @ nInitRow + iEval, nInitCol + 1 Say PadC(aSay[iEval], nWidth) ; - Color 'w+/r' - Next + FOR iEval := 1 TO Len(aSay) + OutStd(aSay[iEval]) + IF iEval < Len(aSay) + OutStd(Chr(13) + Chr(10)) + ENDIF + NEXT + + OutStd(" (") + FOR iEval := 1 TO Len(aOptionsOK) + OutStd(aOptionsOK[iEval]) + IF iEval < Len(aOptionsOK) + OutStd(", ") + ENDIF + NEXT + OutStd(") ") + + ELSE + + /* save status */ + nOldRow := Row() + nOldCol := Col() + nOldCursor := SetCursor(0) + cScreen := SaveScreen( nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1 ) + + /* draw box */ + @ nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1 ; + BOX B_SINGLE + ' ' COLOR cColorNorm + + FOR iEval := 1 TO Len(aSay) + @ nInitRow + iEval, nInitCol + 1 + Int(((nWidth - Len(aSay[iEval])) / 2) + .5) SAY aSay[iEval] ; + COLOR cColorNorm + NEXT + + ENDIF + + nChoice := 1 - nChoice = 1 /* choice loop */ - While .T. - For iEval := 1 To Len(aOptions) - @ nInitRow + Len(aSay) + 2, aPos[iEval] Say aOptions[iEval] ; - Color If(iEval = nChoice, 'w+/b', 'w+/r') - Next + DO WHILE .T. + + IF !lConsole + FOR iEval := 1 TO Len(aOptionsOK) + @ nInitRow + Len(aSay) + 2, aPos[iEval] SAY " " + aOptionsOK[iEval] + " " ; + COLOR If(iEval == nChoice, cColorHigh, cColorNorm) + NEXT + ENDIF + nKey := Inkey(nDelay) - If nKey = K_ENTER .Or. nKey = 0 - nRet := nChoice - Exit - ElseIf nKey = K_ESC - Exit - ElseIf (nKey = K_LEFT .Or. nKey == K_SH_TAB) .And. Len(aOptions) > 1 - nChoice -- - If nChoice = 0 - nChoice := Len(aOptions) - End - ElseIf (nKey = K_RIGHT .Or. nKey == K_TAB) .And. Len(aOptions) > 1 - nChoice ++ - If nChoice > Len(aOptions) + DO CASE + CASE nKey == K_ENTER .OR. nKey == 0 + + EXIT + + CASE nKey == K_ESC + + nChoice := 0 + EXIT + + CASE (nKey == K_LEFT .OR. nKey == K_SH_TAB) .AND. Len(aOptionsOK) > 1 + + nChoice-- + IF nChoice == 0 + nChoice := Len(aOptionsOK) + ENDIF + + CASE (nKey == K_RIGHT .OR. nKey == K_TAB) .AND. Len(aOptionsOK) > 1 + + nChoice++ + IF nChoice > Len(aOptionsOK) nChoice := 1 - End - End - End + ENDIF - /* Restore screen */ - RestScreen( nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1, cScreen ) - SetCursor(nCursor) + CASE aScan(aHotkey, {|x| x == Upper(Chr(nKey)) }) > 0 -Return nRet + nChoice := aScan(aHotkey, {|x| x == Upper(Chr(nKey)) }) + EXIT + ENDCASE + + ENDDO + + IF lConsole + + OutStd(Chr(nKey)) + + ELSE + + /* Restore screen */ + RestScreen( nInitRow, nInitCol, nInitRow + Len(aSay) + 3, nInitCol + nWidth + 1, cScreen ) + SetCursor(nOldCursor) + SetPos(nOldRow, nOldCol) + + ENDIF + + RETURN nChoice diff --git a/harbour/source/rtl/files.c b/harbour/source/rtl/files.c index 1ec71d8e97..bd75c1edc2 100644 --- a/harbour/source/rtl/files.c +++ b/harbour/source/rtl/files.c @@ -10,6 +10,9 @@ #if defined(__CYGWIN__) #include +#endif + +#if defined(__GNUC__) #include #include #include