From c80aa88d3609d39dfb889aac3301775b14be4b44 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Tue, 5 Apr 2022 16:35:02 +0200
Subject: with-vulgar now uses alternative screen.

---
 module/vulgar.scm | 68 +++++++++++++++++++++++++++++--------------------------
 1 file changed, 36 insertions(+), 32 deletions(-)

diff --git a/module/vulgar.scm b/module/vulgar.scm
index 5ddea738..20b93164 100644
--- a/module/vulgar.scm
+++ b/module/vulgar.scm
@@ -19,35 +19,39 @@
           (1+ y) (1+ x)))
 
 
-(define-syntax with-vulgar
-  (syntax-rules ()
-    ((_ thunk)
-     (with-vulgar (bitwise-not (bitwise-ior ECHO ICANON))
-                  thunk))
-    ((_ bits thunk)
-     (let* ((ifd (current-input-port))
-            (ofd (current-output-port))
-            (iattr (make-termios))
-            (oattr (make-termios))
-            iattr* oattr*)
-       (dynamic-wind
-         (lambda ()
-           (tcgetattr! iattr ifd)
-           (tcgetattr! oattr ofd)
-
-           ;; Store current settings to enable resetting the terminal later
-           (set! iattr* (copy-termios iattr)
-                 oattr* (copy-termios oattr)
-
-                 (lflag iattr) (bitwise-and bits (lflag iattr))
-                 (lflag oattr) (bitwise-and bits (lflag oattr)))
-
-           (tcsetattr! iattr ifd)
-           (tcsetattr! oattr ofd)
-           (system "tput civis"))
-         thunk
-         (lambda ()
-           (tcsetattr! iattr* ifd)
-           (tcsetattr! oattr* ofd)
-           (system "tput cnorm")
-           ))))))
+(define (with-vulgar . args)
+  (apply
+   (case-lambda
+     ((thunk)
+      (with-vulgar (bitwise-not (bitwise-ior ECHO ICANON))
+                   thunk))
+     ((bits thunk)
+      (let* ((ifd (current-input-port))
+             (ofd (current-output-port))
+             (iattr (make-termios))
+             (oattr (make-termios))
+             iattr* oattr*)
+        (dynamic-wind
+          (lambda ()
+            (tcgetattr! iattr ifd)
+            (tcgetattr! oattr ofd)
+
+            ;; Store current settings to enable resetting the terminal later
+            (set! iattr* (copy-termios iattr)
+                  oattr* (copy-termios oattr)
+
+                  (lflag iattr) (bitwise-and bits (lflag iattr))
+                  (lflag oattr) (bitwise-and bits (lflag oattr)))
+
+            (tcsetattr! iattr ifd)
+            (tcsetattr! oattr ofd)
+            (format #t "\x1b[?1049h")
+            (system "tput civis"))
+          thunk
+          (lambda ()
+            (tcsetattr! iattr* ifd)
+            (tcsetattr! oattr* ofd)
+            (format #t "\x1b[?1049l")
+            (system "tput cnorm")
+            )))))
+   args))
-- 
cgit v1.2.3