diff --git a/guix.scm b/guix.scm index b5a2949..e30f59f 100644 --- 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+)) diff --git a/hall.scm b/hall.scm index c4a3051..c54c78c 100644 --- 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" ()))))) diff --git a/reflow/ansi.scm b/reflow/ansi.scm new file mode 100644 index 0000000..3929a1a --- /dev/null +++ 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)) diff --git a/reflow/hconfig.scm b/reflow/hconfig.scm index 2da5f6e..87b52ac 100644 --- 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) diff --git a/reflow/ports.scm b/reflow/ports.scm deleted file mode 100644 index 54a35bd..0000000 --- a/reflow/ports.scm +++ /dev/null @@ -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"))