From 9f6651fdb7fc4e9b37a7f3ac1d417e6de95f1f34 Mon Sep 17 00:00:00 2001
From: Tomas Hajny <hajny@freepascal.org>
Date: Sun, 2 May 2021 14:59:21 +0000
Subject: [PATCH]   + added Get/SetTextAutoFlush feature

git-svn-id: trunk@49324 -
---
 rtl/inc/systemh.inc | 21 +++++++++++++++++++++
 rtl/inc/text.inc    | 36 ++++++++++++++++++++++++++++++++++++
 2 files changed, 57 insertions(+)

diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc
index 5bbb541d8e..ff6e402b9b 100644
--- a/rtl/inc/systemh.inc
+++ b/rtl/inc/systemh.inc
@@ -1447,6 +1447,27 @@ procedure SetTextCodePage(var T: Text; CodePage: TSystemCodePage);
 {$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
 Function GetFullName(var T:Text) : UnicodeString;
 {$endif FPC_HAS_FEATURE_UNICODESTRINGS}
+procedure SetTextAutoFlush (var T: Text; AutoFlush: boolean);
+(* By default, output to text files is buffered in case of "regular" files,  *)
+(* i.e. files on regular block devices, and not buffered in case of various  *)
+(* other devices like console or sockets. Calling this procedure right after *)
+(* opening the file (i.e. after Rewrite or Append) allows changing the       *)
+(* default behaviour either to always perform flush after every Write or     *)
+(* WriteLn in case of AutoFlush = true, i.e. disable output buffering for    *)
+(* the given particular open text file even in case of regular files on      *)
+(* block devices, or to enforce output buffering even in case of text files  *)
+(* used for output to other devices like console or sockets in case of       *)
+(* AutoFlush = false. Note that reopening the file resets the behaviour to   *)
+(* the default. Runtime error 103 is triggered if the text file is not open, *)
+(* runtime error 105 if the text file is open strictly for input. The call   *)
+(* is ignored if InOutRes is not 0 before the call.                          *)
+function GetTextAutoFlush (var T: Text): boolean;
+(* Check whether output buffering is enabled for the currently open file, or *)
+(* not - either due to default behaviour for the associated device, or due   *)
+(* a previous call of SetTextAutoFlush. Runtime error 103 is triggered if    *)
+(* the text file is not open, runtime error 105 if the text file is open     *)
+(* strictly for input. The call is ignored if InOutRes is not 0 before the   *)
+(* call.                                                                     *)
 {$endif FPC_HAS_FEATURE_TEXTIO}
 
 {****************************************************************************
diff --git a/rtl/inc/text.inc b/rtl/inc/text.inc
index 8b04d77e5b..a9ad8a6bf9 100644
--- a/rtl/inc/text.inc
+++ b/rtl/inc/text.inc
@@ -614,6 +614,42 @@ begin
 end;
 
 
+procedure SetTextAutoFlush (var T: Text; AutoFlush: boolean);[IOCheck];
+Begin
+  If InOutRes<>0 then
+   exit;
+  if TextRec(T).mode<>fmOutput then
+   begin
+     if TextRec(T).mode=fmInput then
+      InOutRes:=105
+     else
+      InOutRes:=103;
+     exit;
+   end;
+  if AutoFlush then
+   TextRec(T).FlushFunc := TextRec(T).InOutFunc
+  else
+   TextRec(T).FlushFunc := nil;
+End;
+
+
+function GetTextAutoFlush (var T: Text): boolean;[IOCheck];
+Begin
+  GetTextAutoFlush := false;
+  If InOutRes<>0 then
+   exit;
+  if TextRec(t).mode<>fmOutput then
+   begin
+     if TextRec(t).mode=fmInput then
+      InOutRes:=105
+     else
+      InOutRes:=103;
+     exit;
+   end;
+  GetTextAutoFlush := Assigned (TextRec(T).FlushFunc);
+End;
+
+
 Function fpc_get_input:PText;compilerproc;
 begin
   fpc_get_input:=@Input;