Reword terminal output to better modularization.

5 files changed, 51 insertions, 88 deletions

diff --git a/module/vulgar/color.scm b/module/vulgar/color.scm
new file mode 100644
index 00000000..368a823c
--- /dev/null
+++ b/module/vulgar/color.scm
@@ -0,0 +1,24 @@
+(define-module (vulgar color)
+  :export (color-if))
+
+(define-public STR-YELLOW "\x1b[0;33m")
+(define-public STR-RESET "\x1b[m")
+
+(define-syntax-rule (color-if pred color body ...)
+  (let ((pred-value pred))
+    (format #f "~a~a~a"
+            (if pred-value color "")
+            (begin body ...)
+            (if pred-value STR-RESET ""))))
+
+(define-public (color-escape n)
+  (cond ((not n) "")
+        ((char=? #\# (string-ref n 0))
+         (let* ((str (string-drop n 1))
+                (rs (substring str 0 2))
+                (gs (substring str 2 4))
+                (bs (substring str 4 6)))
+           (format #f "\x1b[38;2;~a;~a;~am"
+                   (string->number rs 16)
+                   (string->number gs 16)
+                   (string->number bs 16))))))
diff --git a/module/vulgar/components.scm b/module/vulgar/components.scm
new file mode 100644
index 00000000..507ee08b
--- /dev/null
+++ b/module/vulgar/components.scm
@@ -0,0 +1,18 @@
+(define-module (vulgar components)
+  #:use-module (srfi srfi-19)
+  #:use-module (util)
+  #:export ())
+
+(define-public (display-calendar-header! date)
+  (let* ((day   (number->string (date-day   date)))
+         (month (number->string (date-month date)))
+         (year  (number->string (date-year  date))))
+    ;; BSD cal only supports setting highlighted day explicitly for
+    ;; testing the functionality. This seems to at least give me
+    ;; an (almost) working display, albeit ugly.
+    (if (file-exists? "/usr/bin/ncal")
+        (system*  "ncal" "-3" "-H" (format #f "~a-~a-~a"
+                                          year month day)
+                  month year)
+        (system* "cal" "-3" day month year))))
+
diff --git a/module/vulgar/escape.scm b/module/vulgar/escape.scm
deleted file mode 100644
index 513e66d2..00000000
--- a/module/vulgar/escape.scm
+++ /dev/null
@@ -1,42 +0,0 @@
-;;; Module for terminal (ANSI) escape codes.
-
-(define-module (vulgar escape)
-  #:use-module (srfi srfi-60)
-  #:use-module (vulgar termios)
-  #:use-module (util)
-  #:export (with-vulgar))
-
-(define-public (cls)
-  (display "\x1b[H")                    ; Move cursor to the origin
-  (display "\x1b[J")                    ; Clear everything after cursor
-  )
-
-;;; I don't curse, I'm just vulgar.
-
-(define-syntax with-vulgar
-  (syntax-rules ()
-    ((_ 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))
-           (set! oattr* (copy-termios oattr))
-
-           (let ((bits (bitwise-not (bitwise-ior ECHO ICANON))))
-             (set! (lflag iattr) (bitwise-and (lflag iattr) bits))
-             (set! (lflag oattr) (bitwise-and (lflag oattr) bits)))
-
-           (tcsetattr! iattr ifd)
-           (tcsetattr! oattr ofd))
-         thunk
-         (lambda ()
-           (tcsetattr! iattr* ifd)
-           (tcsetattr! oattr* ofd)))))))
diff --git a/module/vulgar/info.scm b/module/vulgar/info.scm
new file mode 100644
index 00000000..86abf0a0
--- /dev/null
+++ b/module/vulgar/info.scm
@@ -0,0 +1,9 @@
+(define-module (vulgar info)
+  :use-module (util))
+
+(define-public (get-terminal-size)
+ (let* (((rpipe . wpipe) (pipe)))
+   (system (format #f "stty size > /proc/~s/fd/~s"
+                   (getpid) (port->fdes wpipe)))
+   (values (read rpipe)
+           (read rpipe))))
diff --git a/module/vulgar/util.scm b/module/vulgar/util.scm
deleted file mode 100644
index 8be97378..00000000
--- a/module/vulgar/util.scm
+++ /dev/null
@@ -1,46 +0,0 @@
-(define-module (vulgar util)
-  #:use-module (srfi srfi-19)
-  #:use-module (srfi srfi-60)
-  #:use-module (util)
-  #:use-module (ice-9 popen)
-  #:export (line ctrl color-escape))
-
-(define* (line #:optional (width 64))
-  (display (make-string width #\_))
-  (newline))
-
-(define (ctrl char)
-  (integer->char (bitwise-and #b00011111 (char->integer char))))
-
-(define-public (display-calendar-header! date)
-  (let* ((day   (number->string (date-day   date)))
-         (month (number->string (date-month date)))
-         (year  (number->string (date-year  date))))
-    ;; BSD cal only supports setting highlighted day explicitly for
-    ;; testing the functionality. This seems to at least give me
-    ;; an (almost) working display, albeit ugly.
-    (if (file-exists? "/usr/bin/ncal")
-        (system*  "ncal" "-3" "-H" (format #f "~a-~a-~a"
-                                          year month day)
-                  month year)
-        (system* "cal" "-3" day month year))))
-
-(define (color-escape n)
-  (cond ((not n) "")
-        ((char=? #\# (string-ref n 0))
-         (let* ((str (string-drop n 1))
-                (rs (substring str 0 2))
-                (gs (substring str 2 4))
-                (bs (substring str 4 6)))
-           (format #f "\x1b[38;2;~a;~a;~am"
-                   (string->number rs 16)
-                   (string->number gs 16)
-                   (string->number bs 16))))))
-
-
-(define-public (get-terminal-size)
- (let* (((rpipe . wpipe) (pipe)))
-   (system (format #f "stty size > /proc/~s/fd/~s"
-                   (getpid) (port->fdes wpipe)))
-   (values (read rpipe)
-           (read rpipe))))