From e6f7f4c60d150c91efd6b9a21c8e757987db5aea Mon Sep 17 00:00:00 2001 From: Vivianne Langdon Date: Tue, 5 Mar 2024 22:53:17 -0500 Subject: [PATCH] Removing hall cruft and adding uniseg properly, and finally, works! --- guix.scm | 5 ++- hall.scm | 36 ------------------ reflow/ansi.scm | 26 +++++++------ reflow/hconfig.scm | 35 ----------------- reflow/wrap.scm | 93 ++++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 110 insertions(+), 85 deletions(-) delete mode 100644 hall.scm delete mode 100644 reflow/hconfig.scm create mode 100644 reflow/wrap.scm diff --git a/guix.scm b/guix.scm index 755abfe..4581327 100644 --- a/guix.scm +++ b/guix.scm @@ -30,11 +30,12 @@ (arguments `()) (native-inputs (list autoconf automake pkg-config texinfo)) - (inputs (list guile-3.0 guile-uniseg)) - (propagated-inputs (list)) + (inputs (list guile-3.0)) + (propagated-inputs (list guile-uniseg)) (synopsis "Guile port of reflow") (description "A library to provide easy text wrapping in consoles that preserves control-code formatting.") (home-page "https://git.solarpunk.moe/vv/guile-reflow") (license license:gpl3+)) + diff --git a/hall.scm b/hall.scm deleted file mode 100644 index b41c966..0000000 --- a/hall.scm +++ /dev/null @@ -1,36 +0,0 @@ -(hall-description - (name "reflow") - (prefix "guile") - (version "0.1") - (author "Vivanne Langdon") - (email "") - (copyright (2024)) - (synopsis "Guile port of reflow") - (description - "A library to provide easy text wrapping in consoles that preserves control-code formatting.") - (home-page - "https://git.solarpunk.moe/vv/guile-reflow") - (license gpl3+) - (dependencies `()) - (skip ()) - (features - ((guix #t) - (use-guix-specs-for-dependencies #f) - (native-language-support #f) - (licensing #f))) - (files (libraries - ((directory "reflow" ((scheme-file "ansi"))) - (scheme-file "reflow"))) - (tests ((directory "tests" ((scheme-file "test-ansi"))))) - (programs ()) - (documentation - ((org-file "README") - (symlink "README" "README.org") - (text-file "HACKING") - (text-file "COPYING") - (directory "doc" ((texi-file "guile-reflow"))))) - (infrastructure - ((scheme-file "guix") - (text-file ".gitignore") - (scheme-file "hall") - (directory "tests" ()))))) diff --git a/reflow/ansi.scm b/reflow/ansi.scm index e42f7c9..a5c4564 100644 --- a/reflow/ansi.scm +++ b/reflow/ansi.scm @@ -1,12 +1,15 @@ (define-module (reflow ansi) #:use-module (rnrs io ports) - #:use-module (ice-9 binary-ports) - #:export (make-ansi-port-tuple)) + #:export (%ansi-marker + %reset + %reset-seq + ansi-terminator? + make-ansi-port-tuple)) -(define %MARKER #\x1b) -(define %RESET "[0m") -(define %RESET-SEQ - (string-append (string %MARKER) %RESET)) +(define %ansi-marker #\x1b) +(define %reset "[0m") +(define %reset-seq + (string-append (string %ansi-marker) %reset)) (define (ansi-terminator? char) (let ((c (char->integer char))) @@ -35,7 +38,7 @@ (define (put-char c) (cond ;; If we see a marker, flag it and begin building the sequence list - ((equal? %MARKER c) + ((equal? %ansi-marker c) (set! in-escape-sequence? #t) (cons! c wip-sequence-list)) (in-escape-sequence? @@ -48,7 +51,7 @@ (let ((sequence (reverse-list->string wip-sequence-list))) (cond ;; Is it a reset sequence? Clear it - ((string-suffix? %RESET sequence) + ((string-suffix? %reset sequence) (set! current-sequence-list '())) ;; Is it a color code? Add it to the sequence! ((equal? c #\m) @@ -66,12 +69,11 @@ (make-soft-port (vector ;; Char out - (λ (c) (put-char c)) + put-char ;; String out, go char by char (λ (s) (string-for-each put-char s)) ;; Flush - ;; (question: do we want to force output work-in-progress sequences on flush? Probably not?) - (λ () (flush-output-port o-port)) + (λ () #f) ;; Get char - write-only, we ignore (λ () #f) ;; Close port - no work to do - we don't take ownership of the child port @@ -92,7 +94,7 @@ (define (reset-ansi) "Reset the current ansi sequence if needed by outputting to the wrapped port." (when (sequence?) - (display %RESET-SEQ o-port))) + (display %reset-seq o-port))) (define (restore-ansi) "Restore the current ansi sequence by outputting to the wrapped port." diff --git a/reflow/hconfig.scm b/reflow/hconfig.scm deleted file mode 100644 index 87b52ac..0000000 --- a/reflow/hconfig.scm +++ /dev/null @@ -1,35 +0,0 @@ -(define-module - (reflow hconfig) - #:use-module - (srfi srfi-26) - #:export - (%version - %author - %license - %copyright - %gettext-domain - G_ - N_ - init-nls - init-locale)) - -(define %version "0.1") - -(define %author "Vivanne Langdon") - -(define %license 'gpl3+) - -(define %copyright '(2024)) - -(define %gettext-domain "guile-reflow") - -(define G_ identity) - -(define N_ identity) - -(define (init-nls) "Dummy as no NLS is used" #t) - -(define (init-locale) - "Dummy as no NLS is used" - #t) - diff --git a/reflow/wrap.scm b/reflow/wrap.scm new file mode 100644 index 0000000..8a7da57 --- /dev/null +++ b/reflow/wrap.scm @@ -0,0 +1,93 @@ +(define-module (reflow wrap) + #:use-module (reflow ansi) + #:use-module (uniseg graphemes) + #:use-module (uniseg graphemes iterator) + #:use-module (ice-9 textual-ports) + #:export (make-wrapping-port-pair)) + +(define* (make-wrapping-port-pair + o-port + max-width + #:key (keep-newlines? #t) + (preserve-space? #f) + (tab-width 4)) + "Return a soft port which wraps the given output port such that text cleanly wraps to a new line if longer than max width." + (define-values (ansi-port current-sequence reset-ansi restore-ansi) + (make-ansi-port-tuple o-port)) + + (define iterator (make-grapheme-iterator)) + (define %cur-width 0) + (define %in-escape-seq? #f) + (define %waiting-for-non-space? #f) + + (define (new-line) + (when (not preserve-space?) + (set! %waiting-for-non-space? #t)) + (put-char ansi-port #\newline)) + + (define (handle-char char) + (cond + ((eq? %ansi-marker char) + (set! %in-escape-seq? #t) + (put-char ansi-port char)) + (%in-escape-seq? + (put-char ansi-port char) + (when (ansi-terminator? char) + (set! %in-escape-seq? #f))) + ((eq? #\newline char) + (when keep-newlines? + (set! %cur-width 0) + (new-line))) + ((and (char-set-contains? char-set:whitespace char) + %waiting-for-non-space?) + #f) + ((eq? #\tab char) + (for-each handle-char (make-list tab-width #\space))) + (else + (set! %waiting-for-non-space? #f) + + (let* ((grapheme (iterator char)) + (new-width (+ %cur-width (grapheme-delta-width grapheme)))) + + (if (> new-width max-width) + (let* ((grapheme-width (grapheme-width grapheme)) + (modification? (grapheme-modification? grapheme)) + (grapheme-str (grapheme-string grapheme))) + ;; If we go over the width, and the grapheme is a modification, + ;; then we need to backspace to before the grapheme before we go to the next line. + (when modification? + (let* ((num-to-delete (- grapheme-width 1)) + (delete-str (list->string (make-list num-to-delete #\backspace)))) + (put-string ansi-port delete-str))) + + ;; Go to next line, restore ansi sequence, then print the entire grapheme! + (new-line) + (restore-ansi) + (put-string ansi-port grapheme-str) + (set! %cur-width grapheme-width)) + (begin + ;; Otherwise we can just output to the ansi port as normal. + (put-char ansi-port char) + (set! %cur-width new-width))))))) + + (define output-port + (make-soft-port + (vector + ;; Char out + handle-char + ;; string out, char by char + (λ (s) (string-for-each handle-char s)) + #f #f #f) + "w")) + + (define (reset) + (set! iterator (make-grapheme-iterator)) + (set! %cur-width 0) + (define-values (p cur reset restore) + (make-ansi-port-tuple o-port)) + (set! ansi-port p) + (set! current-sequence cur) + (set! reset-ansi reset) + (set! restore-ansi restore)) + + (values output-port reset))