Added initial ansi port which caches ansi codes

for use by upcoming ports
2024-02-28 16:07:04 -05:00 · 2024-02-28 16:07:04 -05:00 · d3715cb8a1
parent 1978455dc4
commit d3715cb8a1
5 changed files with 191 additions and 147 deletions
--- a/guix.scm
+++ b/guix.scm
@ -1,49 +1,40 @@
-(use-modules (gnu packages)
-             (gnu packages autotools)
-             (gnu packages guile)
-             (gnu packages guile-xyz)
-             (gnu packages pkg-config)
-             (gnu packages texinfo)
-             (guix build-system gnu)
-             (guix download)
-             (guix gexp)
-             ((guix licenses) #:prefix license:)
-             (guix packages)
-             (srfi srfi-1))
+(use-modules
+  (gnu packages)
+  (gnu packages autotools)
+  (gnu packages guile)
+  (gnu packages guile-xyz)
+  (gnu packages pkg-config)
+  (gnu packages texinfo)
+  (guix build-system gnu)
+  (guix download)
+  (guix gexp)
+  ((guix licenses) #:prefix license:)
+  (guix packages)
+  (srfi srfi-1))

 (package
- (name "guile-reflow")
- (version "0.1")
- (source
-  (local-file
-   (dirname (current-filename))
-   #:recursive? #t
-   #:select? (lambda (file stat)
-		           (not (any (lambda (my-string)
-			                     (string-contains file my-string))
-			                   (list ".git" ".dir-locals.el" "guix.scm"))))))
- (build-system gnu-build-system)
- (arguments
-  (list
-   #:make-flags
-   #~(list "GUILE_AUTO_COMPILE=0")
-   #:phases
-   #~(modify-phases %standard-phases
-                    (add-before 'bootstrap 'hall
-                                (lambda _
-	                                (system* "hall" "build" "-x")))
-	                  (replace 'bootstrap
-                             (lambda _
-	                             (system* "autoreconf" "-vif"))))))
- (native-inputs (list autoconf
-		                  automake
-		                  guile-hall
-		                  pkg-config
-		                  texinfo))
- (inputs (list guile-3.0))
- (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+))
+  (name "guile-reflow")
+  (version "0.1")
+  (source
+    (local-file
+      (dirname (current-filename))
+      #:recursive?
+      #t
+      #:select?
+      (lambda (file stat)
+        (not (any (lambda (my-string)
+                    (string-contains file my-string))
+                  (list ".git" ".dir-locals.el" "guix.scm"))))))
+  (build-system gnu-build-system)
+  (arguments `())
+  (native-inputs
+    (list autoconf automake pkg-config texinfo))
+  (inputs (list guile-3.0))
+  (propagated-inputs (list))
+  (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+))

--- a/hall.scm
+++ b/hall.scm
@ -1,35 +1,36 @@
 (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 `())
- (features
-  ((guix #t)
-   (use-guix-specs-for-dependencies #f)
-   (native-language-support #f)
-   (licensing #f)))
- (files (libraries
-         ((directory "reflow" ())
-          (scheme-file "reflow")))
-        (tests ((directory "tests" ())))
-        (documentation
-         ((org-file "README")
-          (symlink "README" "README.org")
-          (text-file "HACKING")
-          (text-file "COPYING")
-          (directory "doc"
-                     ((texi-file "guile-reflow")))))
-        (programs ())
-        (infrastructure
-         ((scheme-file "guix")
-          (text-file ".gitignore")
-          (scheme-file "hall")
-          (directory "tests" ())))))
+  (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" ())))
+         (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" ())))))
--- a/reflow/ansi.scm
+++ b/reflow/ansi.scm
@ -0,0 +1,117 @@
+(define-module (reflow ansi)
+  #:use-module (rnrs io ports)
+  #:use-module (ice-9 binary-ports)
+  #:export (make-ansi-port-tuple))
+
+(define %MARKER "\x1b")
+(define %MARKER-CHAR #\x1b)
+(define %RESET "[0m")
+
+(define %RESET-SEQ (string-append %MARKER %RESET))
+
+(define (ansi-terminator? char)
+  (let ((c (char->integer char)))
+    (pk c)
+    (or  (and (>= c #x40) (<= c #x5a)) (and (>= c #x61) (<= c #x7a)))))
+
+;; TODO: create helpers that allow the reflow to operate properly.
+(define (make-ansi-port-tuple o-port)
+  ;; The current ansi sequence gets built up over time
+  ;; need to reset this after we write it out
+  (define sequence-port #f)
+  (define sequence-port-get-bv #f)
+  (define (reset-sequence-port!)
+    (pk "Resetting seq port")
+    (define-values (p get)
+      (open-bytevector-output-port))
+    (set! sequence-port p)
+    (set! sequence-port-get-bv get))
+  (reset-sequence-port!)
+
+  ;; The previous ansi sequence also gets built up
+  ;; sequence by sequence
+  (define last-seq-port #f)
+  (define last-seq-port-get-bv #f)
+  (define (reset-last-seq-port!)
+    (pk "Resetting LAST seq port")
+    (define-values (p get)
+      (open-bytevector-output-port))
+    (set! last-seq-port p)
+    (set! last-seq-port-get-bv get)
+    (set! cached-sequence #f))
+  (reset-last-seq-port!)
+
+
+  (define in-escape-sequence? #f)
+  (define sequence? #f)
+  (define cached-sequence #f)
+
+  ;; rune by rune
+  (define (put-char c)
+    (cond
+     ((equal? %MARKER-CHAR c)
+      (pk "start esc seq" c)
+      (set! in-escape-sequence? #t)
+      (set! sequence? #t)
+      (display c sequence-port))
+     (in-escape-sequence?
+      (display c sequence-port)
+      (when (ansi-terminator? c)
+        (pk "terminator found, no longer in esc seq:" c)
+        (set! in-escape-sequence? #f)
+        (let* ((bv (sequence-port-get-bv))
+               (sequence (and bv (bytevector->string bv (native-transcoder)))))
+
+          (unless sequence
+            (error "Terminator found within sequence, but sequence could not be converted to string"))
+
+          (cond
+           ((string-suffix? %RESET sequence)
+            ;; Reset sequence, clear the saved sequence!
+            (pk "reset seq found")
+            (reset-last-seq-port!)
+            (set! sequence? #f))
+           ((equal? c #\m)
+            ;; color code, put the sequence into the last-seq port!
+            (pk "end of color code")
+            (put-bytevector last-seq-port bv)
+            (set! cached-sequence #f)))
+
+          (display sequence o-port)
+          (reset-sequence-port!))))
+     (else
+      (display c o-port))))
+
+  (define port
+    (make-soft-port
+     (vector
+      ;; Char out
+      (λ (c) (put-char c))
+      ;; String out
+      (λ (s) (string-for-each put-char s))
+      ;; Flush
+      (λ () (flush-output-port o-port))
+      ;; Get char
+      (λ () #f)
+      ;; Close port
+      (λ () #f))
+     "w"))
+
+  (define (last-sequence)
+    (and sequence?
+      (or cached-sequence
+          (pk
+           (let ((seq (bytevector->string (last-seq-port-get-bv) (native-transcoder))))
+             (set! cached-sequence seq)
+             seq)))))
+
+  (define (reset-ansi)
+    (when sequence?
+      (display %RESET-SEQ o-port)))
+
+  (define (restore-ansi)
+    (let ((seq (last-sequence)))
+      (when seq
+        (display seq o-port))))
+
+  (values port last-sequence reset-ansi restore-ansi))
--- a/reflow/hconfig.scm
+++ b/reflow/hconfig.scm
@ -15,13 +15,13 @@

 (define %version "0.1")

-(define %author "")
+(define %author "Vivanne Langdon")

 (define %license 'gpl3+)

 (define %copyright '(2024))

-(define %gettext-domain "reflow")
+(define %gettext-domain "guile-reflow")

 (define G_ identity)

--- a/reflow/ports.scm
+++ b/reflow/ports.scm
@ -1,65 +0,0 @@
-(define-module (reflow ports)
-  #:use-module (rnrs io ports)
-  #:export (create-reflowing-output-port))
-
-(define %MARKER "\x1B")
-
-(define (ansi-terminator? char)
-  (let ((c (char->integer char)))
-    (pk c)
-    (or  (and (>= c #x40) (<= c #x5a)) (and (>= c #x61) (<= c #x7a)))))
-
-;; TODO: create helpers that allow the reflow to operate properly.
-
-(define (create-reflowing-output-port o-port)
-  ;; The current ansi sequence gets constructed slowly
-  ;; need to reset this after we write it out
-  (define-values (sequence-port sequence-port-get-bv)
-    (open-bytevector-output-port)) 
-
-  ;; The previous ansi sequence is stored as bytevector
-  (define last-seq #f)
-
-  (define in-escape-sequence? #f)
-  (define sequence-changed? #f)
-
-  ;; rune by rune
-  (define (put-char c)
-    (cond
-     ((equal? %MARKER c)
-      (set! in-escape-sequence? #t)
-      (set! sequence-changed? #t)
-      (display c sequence-port))
-     (in-escape-sequence?
-      (display c sequence-port)
-      (when (ansi-terminator? c)
-        (in-escape-sequence? #f)
-        (let* ((bv (sequence-port-get-bv))
-               (str (bytevector->string bv (native-transcoder))))
-
-          (cond
-           ((string-suffix? "[0m" str)
-            (set! last-seq #f)
-            (set! sequence-changed? #f))
-           ((equal? c #\m)
-            ;; color code
-            (set! last-seq str)))
-
-          ;; need to reset the sequence port and such here
-          (display str o-port))))
-     (else
-      (display c o-port))))
-
-  (make-soft-port
-   (vector
-    ;; Char out
-    (λ (c) (put-char c))
-    ;; String out
-    (λ (s) (string-for-each put-char s))
-    ;; Flush
-    (λ () (flush-output-port o-port))
-    ;; Get char
-    (λ () #f)
-    ;; Close port
-    (λ () #f))
-   "w"))