diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-04-05 16:35:02 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-04-05 16:56:14 +0200 |
commit | c80aa88d3609d39dfb889aac3301775b14be4b44 (patch) | |
tree | 5815ad4d0a3491e144ba3538e7ff7c0b81fbb937 /module/vulgar | |
parent | Made sidebar date headings sticky. (diff) | |
download | calp-c80aa88d3609d39dfb889aac3301775b14be4b44.tar.gz calp-c80aa88d3609d39dfb889aac3301775b14be4b44.tar.xz |
with-vulgar now uses alternative screen.
Diffstat (limited to '')
-rw-r--r-- | module/vulgar.scm | 68 |
1 files 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)) |