From b0d552ffe3e336606de907897181a0f0718b3149 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sat, 1 Jun 2019 21:56:52 +0200 Subject: Reword terminal output to better modularization. --- module/output/info.scm | 2 +- module/output/terminal.scm | 8 +++++--- module/vcomponent/output.scm | 14 +------------- module/vulgar.scm | 44 ++++++++++++++++++++++++++++++++++++++++++ module/vulgar/color.scm | 24 +++++++++++++++++++++++ module/vulgar/components.scm | 18 +++++++++++++++++ module/vulgar/escape.scm | 42 ---------------------------------------- module/vulgar/info.scm | 9 +++++++++ module/vulgar/util.scm | 46 -------------------------------------------- 9 files changed, 102 insertions(+), 105 deletions(-) create mode 100644 module/vulgar.scm create mode 100644 module/vulgar/color.scm create mode 100644 module/vulgar/components.scm delete mode 100644 module/vulgar/escape.scm create mode 100644 module/vulgar/info.scm delete mode 100644 module/vulgar/util.scm diff --git a/module/output/info.scm b/module/output/info.scm index cc976472..62600472 100644 --- a/module/output/info.scm +++ b/module/output/info.scm @@ -4,7 +4,7 @@ (use-modules (ice-9 getopt-long) (vcomponent) (vcomponent output) - (vulgar util) + (vulgar color) (srfi srfi-1)) (define-public (info-main calendars events args) diff --git a/module/output/terminal.scm b/module/output/terminal.scm index 1225f335..67548537 100644 --- a/module/output/terminal.scm +++ b/module/output/terminal.scm @@ -8,8 +8,10 @@ #:use-module (srfi srfi-41) #:use-module (srfi srfi-41 util) #:use-module (util) - #:use-module (vulgar escape) - #:use-module (vulgar util) + #:use-module (vulgar) + #:use-module (vulgar info) + #:use-module (vulgar color) + #:use-module (vulgar components) #:use-module (vcomponent output) #:use-module (vcomponent group) @@ -142,7 +144,7 @@ ((#\G) (set! cur-event (1- (length events))))) (when (or (eof-object? char) - (memv char (list #\q (ctrl #\C)))) + (memv char '(#\q))) (break))) )))) diff --git a/module/vcomponent/output.scm b/module/vcomponent/output.scm index db4d4f33..77ca2ffb 100644 --- a/module/vcomponent/output.scm +++ b/module/vcomponent/output.scm @@ -7,19 +7,7 @@ #:use-module (srfi srfi-26) #:use-module (ice-9 format) #:export (print-vcomponent - serialize-vcomponent - color-if - STR-YELLOW STR-RESET)) - -(define STR-YELLOW "\x1b[0;33m") -(define 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 "")))) + serialize-vcomponent)) (define* (print-vcomponent comp #:optional (port #t) #:key (descend? #t) (depth 0)) (let ((kvs (map (lambda (key) (cons key (attr* comp key))) diff --git a/module/vulgar.scm b/module/vulgar.scm new file mode 100644 index 00000000..80bff5f6 --- /dev/null +++ b/module/vulgar.scm @@ -0,0 +1,44 @@ +;;; Commentary: + +;; I don't curse, I'm just vulgar. + +;;; Code: + +(define-module (vulgar) + #: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 + ) + +(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/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)))) -- cgit v1.2.3