Added initial ansi port which caches ansi codes
for use by upcoming ports
This commit is contained in:
parent
1978455dc4
commit
d3715cb8a1
5 changed files with 191 additions and 147 deletions
83
guix.scm
83
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+))
|
||||
|
||||
|
|
|
|||
69
hall.scm
69
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" ())))))
|
||||
|
|
|
|||
117
reflow/ansi.scm
Normal file
117
reflow/ansi.scm
Normal file
|
|
@ -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))
|
||||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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"))
|
||||
Loading…
Reference in a new issue