From 3fdc053d6c2beadb02cf76c1e2a4803eb8155487 Mon Sep 17 00:00:00 2001
From: Calvin Rose <calsrose@gmail.com>
Date: Mon, 3 Feb 2020 18:14:32 -0600
Subject: [PATCH] Add flush and eflush (#278)

These functions interact with Janet's dynamically scoped
IO functions in a manner that is more useful the file/flush.
We can still redirect to a buffer without changing our code.
---
 src/boot/boot.janet | 17 ++++++++++++-----
 src/core/io.c       | 42 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 54 insertions(+), 5 deletions(-)

diff --git a/src/boot/boot.janet b/src/boot/boot.janet
index fec9fc49..a03440f0 100644
--- a/src/boot/boot.janet
+++ b/src/boot/boot.janet
@@ -1252,7 +1252,8 @@
 (defn pp
   "Pretty print to stdout or (dyn :out)."
   [x]
-  (print (buffer/format @"" (dyn :pretty-format "%q") x)))
+  (printf (dyn :pretty-format "%q") x)
+  (flush))
 
 ###
 ###
@@ -1775,7 +1776,8 @@
     (string col)
     ": "
     (parser/error p)
-    (if ec "\e[0m" "")))
+    (if ec "\e[0m" ""))
+  (eflush))
 
 (defn bad-compile
   "Default handler for a compile error."
@@ -1789,7 +1791,8 @@
       msg
       " while compiling "
       where
-      (if ec "\e[0m" ""))))
+      (if ec "\e[0m" "")))
+  (eflush))
 
 (defn run-context
   "Run a context. This evaluates expressions of janet in an environment,
@@ -2086,7 +2089,7 @@
                   :on-status (fn [f x]
                                (when (not= (fiber/status f) :dead)
                                  (debug/stacktrace f x)
-                                 (if exit-on-error (os/exit 1))))
+                                 (if exit-on-error (os/exit 1) (eflush))))
                   :evaluator evaluator
                   :expander expander
                   :source (if path-is-file "<anonymous>" spath)}))
@@ -2189,14 +2192,17 @@
       (put nextenv :debug-level level)
       (put nextenv :signal x)
       (debug/stacktrace f x)
+      (eflush)
       (defn debugger-chunks [buf p]
         (def status (parser/state p :delimiters))
         (def c ((parser/where p) 0))
         (def prompt (string "debug[" level "]:" c ":" status "> "))
         (getline prompt buf nextenv))
       (print "entering debug[" level "] - (quit) to exit")
+      (flush)
       (repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
       (print "exiting debug[" level "]")
+      (flush)
       (nextenv :resume-value))
 
     (fn [f x]
@@ -2204,7 +2210,7 @@
         (do (pp x) (put e '_ @{:value x}))
         (if (e :debug)
           (enter-debugger f x)
-          (do (debug/stacktrace f x) nil)))))
+          (do (debug/stacktrace f x) (eflush))))))
 
   (run-context {:env env
                 :chunks chunks
@@ -2320,6 +2326,7 @@
   (when (and (not *compile-only*) (or *should-repl* *no-file*))
     (if-not *quiet*
       (print "Janet " janet/version "-" janet/build "  Copyright (C) 2017-2020 Calvin Rose"))
+    (flush)
     (defn noprompt [_] "")
     (defn getprompt [p]
       (def [line] (parser/where p))
diff --git a/src/core/io.c b/src/core/io.c
index 01948ed4..7a8663f2 100644
--- a/src/core/io.c
+++ b/src/core/io.c
@@ -460,6 +460,38 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
     return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
 }
 
+static void janet_flusher(const char *name, FILE *dflt_file) {
+    Janet x = janet_dyn(name);
+    switch (janet_type(x)) {
+        default:
+            break;
+        case JANET_NIL:
+            fflush(dflt_file);
+            break;
+        case JANET_ABSTRACT: {
+            void *abstract = janet_unwrap_abstract(x);
+            if (janet_abstract_type(abstract) != &cfun_io_filetype) break;
+            IOFile *iofile = abstract;
+            fflush(iofile->file);
+            break;
+        }
+    }
+}
+
+static Janet cfun_io_flush(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 0);
+    (void) argv;
+    janet_flusher("out", stdout);
+    return janet_wrap_nil();
+}
+
+static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
+    janet_fixarity(argc, 0);
+    (void) argv;
+    janet_flusher("err", stderr);
+    return janet_wrap_nil();
+}
+
 void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
     va_list args;
     va_start(args, format);
@@ -541,6 +573,16 @@ static const JanetReg io_cfuns[] = {
         JDOC("(eprinf fmt & xs)\n\n"
              "Like eprintf but with no trailing newline.")
     },
+    {
+        "flush", cfun_io_flush,
+        JDOC("(flush)\n\n"
+             "Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
+    },
+    {
+        "eflush", cfun_io_eflush,
+        JDOC("(eflush)\n\n"
+             "Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
+    },
     {
         "file/temp", cfun_io_temp,
         JDOC("(file/temp)\n\n"