solarpunk-guile
/
guile-termenv
3
0
Fork 1
Code Issues Pull Requests Releases 1 Activity

Whitespace

This commit is contained in:
Vivianne 2024-02-26 14:34:35 -05:00
parent 6cbbb506e7
commit e6422062f0
4 changed files with 74 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
guix.scm
View File

@ -1,49 +1,49 @@
(use-modules (gnu packages) (use-modules (gnu packages)
(gnu packages autotools) (gnu packages autotools)
(gnu packages guile) (gnu packages guile)
(gnu packages guile-xyz) (gnu packages guile-xyz)
(gnu packages pkg-config) (gnu packages pkg-config)
(gnu packages texinfo) (gnu packages texinfo)
(guix build-system gnu) (guix build-system gnu)
(guix download) (guix download)
(guix gexp) (guix gexp)
((guix licenses) #:prefix license:) ((guix licenses) #:prefix license:)
(guix packages) (guix packages)
(srfi srfi-1)) (srfi srfi-1))
(package (package
(name "guile-termenv") (name "guile-termenv")
(version "0.1") (version "0.1")
(source (source
(local-file (local-file
(dirname (current-filename)) (dirname (current-filename))
#:recursive? #t #:recursive? #t
#:select? (lambda (file stat) #:select? (lambda (file stat)
(not (any (lambda (my-string) (not (any (lambda (my-string)
(string-contains file my-string)) (string-contains file my-string))
(list ".git" ".dir-locals.el" "guix.scm")))))) (list ".git" ".dir-locals.el" "guix.scm"))))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
(list (list
#:make-flags #:make-flags
#~(list "GUILE_AUTO_COMPILE=0") #~(list "GUILE_AUTO_COMPILE=0")
#:phases #:phases
#~(modify-phases %standard-phases #~(modify-phases %standard-phases
(add-before 'bootstrap 'hall (add-before 'bootstrap 'hall
(lambda _ (lambda _
(system* "hall" "build" "-x"))) (system* "hall" "build" "-x")))
(replace 'bootstrap (replace 'bootstrap
(lambda _ (lambda _
(system* "autoreconf" "-vif")))))) (system* "autoreconf" "-vif"))))))
(native-inputs (list autoconf (native-inputs (list autoconf
automake automake
guile-hall guile-hall
pkg-config pkg-config
texinfo)) texinfo))
(inputs (list guile-3.0)) (inputs (list guile-3.0))
(synopsis "Guile port of termenv") (synopsis "Guile port of termenv")
(description (description
"A library to provide easy control of terminals from Guile using terminal control codes.") "A library to provide easy control of terminals from Guile using terminal control codes.")
(home-page "https://git.solarpunk.moe/vv/guile-termenv") (home-page "https://git.solarpunk.moe/vv/guile-termenv")
(license license:gpl3+)) (license license:gpl3+))

22
hall.scm
View File

@ -18,27 +18,27 @@
(licensing #f))) (licensing #f)))
(files (libraries (files (libraries
((directory "termenv" ((directory "termenv"
((scheme-file "style") ((scheme-file "style")
(scheme-file "unix") (scheme-file "unix")
(scheme-file "hyperlink") (scheme-file "hyperlink")
(scheme-file "screen") (scheme-file "screen")
(scheme-file "color") (scheme-file "color")
(scheme-file "hconfig"))) (scheme-file "hconfig")))
(scheme-file "termenv"))) (scheme-file "termenv")))
(tests ((directory "tests" (tests ((directory "tests"
((scheme-file "test-screen") ((scheme-file "test-screen")
(scheme-file "test-style"))))) (scheme-file "test-style")))))
(documentation (documentation
((org-file "README") ((org-file "README")
(symlink "README" "README.org") (symlink "README" "README.org")
(text-file "HACKING") (text-file "HACKING")
(text-file "COPYING") (text-file "COPYING")
(directory "doc" (directory "doc"
((texi-file "guile-termenv"))))) ((texi-file "guile-termenv")))))
(programs ()) (programs ())
(infrastructure (infrastructure
((scheme-file "guix") ((scheme-file "guix")
(text-file ".gitignore") (text-file ".gitignore")
(scheme-file "hall") (scheme-file "hall")
(directory "tests" (directory "tests"
((scheme-file "utils"))))))) ((scheme-file "utils")))))))

20
termenv/color.scm
View File

@ -309,30 +309,30 @@
(define trimmed (define trimmed
(cond (cond
((and (or (= strlen 4) ((and (or (= strlen 4)
(= strlen 7)) (= strlen 7))
(char=? (string-ref hex 0) #\#)) (char=? (string-ref hex 0) #\#))
(substring/copy hex 1)) (substring/copy hex 1))
((and (or (= strlen 5) ((and (or (= strlen 5)
(= strlen 8)) (= strlen 8))
(char=? (string-ref hex 1) #\x)) (char=? (string-ref hex 1) #\x))
(substring/copy hex 2)) (substring/copy hex 2))
((or (= strlen 3) ((or (= strlen 3)
(= strlen 6)) (= strlen 6))
hex) hex)
(else (error "Invalid hex string: incorrect length")))) (else (error "Invalid hex string: incorrect length"))))
(define width (if (= (string-length trimmed) 3) 1 2)) (define width (if (= (string-length trimmed) 3) 1 2))
(define r (locale-string->integer (define r (locale-string->integer
(substring/copy trimmed 0 width) 16)) (substring/copy trimmed 0 width) 16))
(define g (locale-string->integer (define g (locale-string->integer
(substring/copy trimmed width (* 2 width)) 16)) (substring/copy trimmed width (* 2 width)) 16))
(define b (locale-string->integer (define b (locale-string->integer
(substring/copy trimmed (* 2 width) (* 3 width)) 16)) (substring/copy trimmed (* 2 width) (* 3 width)) 16))
(when (= width 1) (when (= width 1)
(let ((double-hex (let ((double-hex
(lambda (v) (lambda (v)
(+ (* v #XF) v)))) (+ (* v #XF) v))))
(set! r (double-hex r)) (set! r (double-hex r))
(set! g (double-hex g)) (set! g (double-hex g))
(set! b (double-hex b)))) (set! b (double-hex b))))

16
termenv/hconfig.scm
View File

@ -4,14 +4,14 @@
(srfi srfi-26) (srfi srfi-26)
#:export #:export
(%version (%version
%author %author
%license %license
%copyright %copyright
%gettext-domain %gettext-domain
G_ G_
N_ N_
init-nls init-nls
init-locale)) init-locale))
(define %version "0.1") (define %version "0.1")