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

Merge pull request 'Add documentation, make minor code modifications, cleanup build infrastructure' (#1) from juliana/guile-termenv:documentation into main 

Reviewed-on: vv/guile-termenv#1
This commit is contained in:
Vivianne 2024-02-26 19:03:26 +00:00
parent 09083afe11 b0fc09e3ad
commit 6cbbb506e7
12 changed files with 686 additions and 338 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
AUTHORS
View File

@ -1,3 +0,0 @@
Contributors to Guile-Termenv 0.1:
<>

1
ChangeLog
View File

@ -1 +0,0 @@
For a complete log, please see the Git commit log at </PATH/TO/LOG>.

14
NEWS
View File

@ -1,14 +0,0 @@
# -*- mode: org; coding: utf-8; -*-
#+TITLE: Guile-Termenv NEWS – history of user-visible changes
#+STARTUP: content hidestars
Copyright © (2024) <>
Copying and distribution of this file, with or without modification,
are permitted in any medium without royalty provided the copyright
notice and this notice are preserved.
Please send Guile-Termenv bug reports to .
* Publication at 0.1

40
README.org
View File

@ -2,3 +2,43 @@
#+TITLE: README for Guile-Termenv
~guile-termenv~ is a port of [[https://github.com/muesli/termenv][termenv]] to Guile. It provides a convenient
interface to ANSI control sequences so you can color and style output without
need to bother with arcane symbols, all to the height of your terminal's
capabilities.
While ~guile-termenv~ is not a 1:1 port of ~termenv~, it does provide much of
the same functionality, and it aims to fill the same niche in the Guile
ecosystem that ~termenv~ does in the Go ecosystem.
* Building
~guile-termenv~ is developed using [[https://guix.gnu.org][Guix]] and the simplest way to build it is with
Guix. Running ~guix build -f guix.scm~ will build and test the project, placing
it in the store. Instead using ~guix shell -f guix.scm~ will create an
environment with the project, and ~guix profile -if guix.scm~ will install it.
If you wish to use a more manual build methodology, you can replicate the build
steps like so:
#+BEGIN_SRC shell
guix shell -Df guix.scm
hall build -x
autoreconf -vif
./configure
make -j
#+END_SRC
Note that it is not advised to install the project this way.
If you don't have or don't want to use Guix, ~guile-termenv~ requires the
following dependencies to build:
- autoconf
- automake
- guile-hall
- pkg-config
- texinfo
With those dependencies installed, the same build commands as above will work,
although the ~guix~ command becomes redundant.

5
bootstrap
View File

@ -1,5 +0,0 @@
#!/usr/bin/env bash
autoreconf -vif
./configure
make

179
build-aux/test-driver.scm
View File

@ -1,179 +0,0 @@
;;;; test-driver.scm - Guile test driver for Automake testsuite harness
(define script-version "2019-01-15.13") ;UTC
;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
;;; Copyright © 2019 Alex Sassmannshausen <alex@pompo.co>
;;;
;;; This program is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; This program is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;;; Commentary:
;;;
;;; This script provides a Guile test driver using the SRFI-64 Scheme API for
;;; test suites. SRFI-64 is distributed with Guile since version 2.0.9.
;;;
;;; This script is a lightly modified version of the orignal written by
;;; Matthieu Lirzin. The changes make it suitable for use as part of the
;;; guile-hall infrastructure.
;;;
;;;; Code:
(use-modules (ice-9 getopt-long)
(ice-9 pretty-print)
(srfi srfi-26)
(srfi srfi-64))
(define (show-help)
(display "Usage:
test-driver --test-name=NAME --log-file=PATH --trs-file=PATH
[--expect-failure={yes|no}] [--color-tests={yes|no}]
[--enable-hard-errors={yes|no}] [--brief={yes|no}}] [--]
TEST-SCRIPT [TEST-SCRIPT-ARGUMENTS]
The '--test-name', '--log-file' and '--trs-file' options are mandatory.
"))
(define %options
'((test-name (value #t))
(log-file (value #t))
(trs-file (value #t))
(color-tests (value #t))
(expect-failure (value #t)) ;XXX: not implemented yet
(enable-hard-errors (value #t)) ;not implemented in SRFI-64
(brief (value #t))
(help (single-char #\h) (value #f))
(version (single-char #\V) (value #f))))
(define (option->boolean options key)
"Return #t if the value associated with KEY in OPTIONS is 'yes'."
(and=> (option-ref options key #f) (cut string=? <> "yes")))
(define* (test-display field value #:optional (port (current-output-port))
#:key pretty?)
"Display 'FIELD: VALUE\n' on PORT."
(if pretty?
(begin
(format port "~A:~%" field)
(pretty-print value port #:per-line-prefix "+ "))
(format port "~A: ~S~%" field value)))
(define* (result->string symbol #:key colorize?)
"Return SYMBOL as an upper case string. Use colors when COLORIZE is #t."
(let ((result (string-upcase (symbol->string symbol))))
(if colorize?
(string-append (case symbol
((pass) "") ;green
((xfail) "") ;light green
((skip) "") ;blue
((fail xpass) "") ;red
((error) "")) ;magenta
result
"") ;no color
result)))
(define* (test-runner-gnu test-name #:key color? brief? out-port trs-port)
"Return an custom SRFI-64 test runner. TEST-NAME is a string specifying the
file name of the current the test. COLOR? specifies whether to use colors,
and BRIEF?, well, you know. OUT-PORT and TRS-PORT must be output ports. The
current output port is supposed to be redirected to a '.log' file."
(define (test-on-test-begin-gnu runner)
;; Procedure called at the start of an individual test case, before the
;; test expression (and expected value) are evaluated.
(let ((result (cute assq-ref (test-result-alist runner) <>)))
(format #t "test-name: ~A~%" (result 'test-name))
(format #t "location: ~A~%"
(string-append (result 'source-file) ":"
(number->string (result 'source-line))))
(test-display "source" (result 'source-form) #:pretty? #t)))
(define (test-on-test-end-gnu runner)
;; Procedure called at the end of an individual test case, when the result
;; of the test is available.
(let* ((results (test-result-alist runner))
(result? (cut assq <> results))
(result (cut assq-ref results <>)))
(unless brief?
;; Display the result of each test case on the console.
(format out-port "~A: ~A - ~A~%"
(result->string (test-result-kind runner) #:colorize? color?)
test-name (test-runner-test-name runner)))
(when (result? 'expected-value)
(test-display "expected-value" (result 'expected-value)))
(when (result? 'expected-error)
(test-display "expected-error" (result 'expected-error) #:pretty? #t))
(when (result? 'actual-value)
(test-display "actual-value" (result 'actual-value)))
(when (result? 'actual-error)
(test-display "actual-error" (result 'actual-error) #:pretty? #t))
(format #t "result: ~a~%" (result->string (result 'result-kind)))
(newline)
(format trs-port ":test-result: ~A ~A~%"
(result->string (test-result-kind runner))
(test-runner-test-name runner))))
(define (test-on-group-end-gnu runner)
;; Procedure called by a 'test-end', including at the end of a test-group.
(let ((fail (or (positive? (test-runner-fail-count runner))
(positive? (test-runner-xpass-count runner))))
(skip (or (positive? (test-runner-skip-count runner))
(positive? (test-runner-xfail-count runner)))))
;; XXX: The global results need some refinements for XPASS.
(format trs-port ":global-test-result: ~A~%"
(if fail "FAIL" (if skip "SKIP" "PASS")))
(format trs-port ":recheck: ~A~%"
(if fail "yes" "no"))
(format trs-port ":copy-in-global-log: ~A~%"
(if (or fail skip) "yes" "no"))
(when brief?
;; Display the global test group result on the console.
(format out-port "~A: ~A~%"
(result->string (if fail 'fail (if skip 'skip 'pass))
#:colorize? color?)
test-name))
#f))
(let ((runner (test-runner-null)))
(test-runner-on-test-begin! runner test-on-test-begin-gnu)
(test-runner-on-test-end! runner test-on-test-end-gnu)
(test-runner-on-group-end! runner test-on-group-end-gnu)
(test-runner-on-bad-end-name! runner test-on-bad-end-name-simple)
runner))
;;;
;;; Entry point.
;;;
(define (main . args)
(let* ((opts (getopt-long (command-line) %options))
(option (cut option-ref opts <> <>)))
(cond
((option 'help #f) (show-help))
((option 'version #f) (format #t "test-driver.scm ~A" script-version))
(else
(let ((log (open-file (option 'log-file "") "w0"))
(trs (open-file (option 'trs-file "") "wl"))
(out (duplicate-port (current-output-port) "wl")))
(redirect-port log (current-output-port))
(redirect-port log (current-warning-port))
(redirect-port log (current-error-port))
(test-with-runner
(test-runner-gnu (option 'test-name #f)
#:color? (option->boolean opts 'color-tests)
#:brief? (option->boolean opts 'brief)
#:out-port out #:trs-port trs)
(load-from-path (option 'test-name #f)))
(close-port log)
(close-port trs)
(close-port out))))
(exit 0)))

536
doc/guile-termenv.texi
View File

@ -3,14 +3,17 @@
@c %**start of header
@setfilename guile-termenv.info
@documentencoding UTF-8
@settitle Guile-Termenv Reference Manual
@documentencoding UTF-8
@documentlanguage en
@syncodeindex vr fn
@syncodeindex tp fn
@c %**end of header
@include version.texi
@copying
Copyright @copyright{} 2024
Copyright @copyright{} 2024 Vivianne Langdon
Permission is granted to copy, distribute and/or modify this document
under the terms of the GNU Free Documentation License, Version 1.3 or
@ -22,12 +25,13 @@ Documentation License''.
@dircategory The Algorithmic Language Scheme
@direntry
* Guile-Termenv: (guile-termenv).
* Guile-Termenv: (guile-termenv). ANSI style and color support for
terminal applications.
@end direntry
@titlepage
@title The Guile-Termenv Manual
@author
@author Juliana Rat
@page
@vskip 0pt plus 1filll
@ -44,17 +48,531 @@ Edition @value{EDITION} @*
@top Guile-Termenv
This document describes Guile-Termenv version @value{VERSION}.
Guile-Termenv is a Guile port of the Go library
@url{https://github.com/muesli/termenv,termenv}. It analyzes
information about a terminal's ANSI and color support, then uses this
to provide a convenient interface for coloring and styling output. It
is incredibly powerful, and also surprisingly simple. This manual
provides a brief illustrative tutorial followed by API documentation.
@menu
* Introduction:: Why Guile-Termenv?
* Tutorial:: An illustrative tutorial
* API:: Documentation for public procedures
@end menu
@c *********************************************************************
@node Introduction
@chapter Introduction
@node Tutorial
@chapter Tutorial
INTRODUCTION HERE
TODO
This documentation is a stub.
@c *********************************************************************
@node API
@chapter API
The @code{guile-termenv} API aims to be simple and approachable while
allowing functional patterns and composition.
@menu
* Color:: Procedures to colorize text
* Hyperlink:: Procedures to convert text to hyperlinks
* Screen:: Procedures for manipulating the terminal screen
* Style:: Procedures for styling text
* Unix:: A procedure to determine a terminal's best color profile
@end menu
@node Color
@section Color
The @code{(termenv color)} module provides a record type representing
colors, and a set of procedures for creating and using that record.
Several color-related procedures accept what this documentation refers
to as a @dfn{hexcode}. Hexcodes are hexadecimal representations of
binary data associated with color values. Typically, a hexcode
consists of six hexadecimal digits split into three pairs. The first
pair represents the red value, the second pair represents the green
value, and the third pair represents the blue value. It is also
possible to use a single digit for each value if both digits are the
same. In this case, only one digit may be used per color.
@code{termenv} accepts hexcodes as strings or as numbers, and it
recommends numbers. If using numbers, it is further recommended to use
Guile's base formatting prefix @code{#X} before the value for clarity.
If using strings, prefixes of any kind are optional and may be either
@code{#} or @code{0x}.
@deftp {Record} color r g b type
Record representing a color. This record serves as the central data
type of this module. It has four fields:
@itemize
@item
@code{r}: Number in the range 0 to 255 representing the red value of
the color.
@item
@code{g}: Number in the range 0 to 255 representing the green value of
the color.
@item
@code{b}: Number in the range 0 to 255 representing the blue value of
the color.
@item
@code{type}: Either @code{'foreground} or @code{'background}.
@end itemize
@end deftp
@deffn {Procedure} color-r color
Accessor for the @code{r} field of the record @var{color},
representing its red value.
@end deffn
@deffn {Procedure} color-g color
Accessor for the @code{g} field of the record @var{color},
representing its green value.
@end deffn
@deffn {Procedure} color-b color
Accessor the @code{b} field of the record @var{color}, representing
its blue value.
@end deffn
@deffn {Procedure} color? arg
Predicate for whether or not @var{arg} is a @code{color}.
@end deffn
@deffn {Procedure} make-background hex
Create a background @code{color} from the hexcode @var{hex}.
@end deffn
@deffn {Procedure} make-foreground hex
Create a foreground @code{color} from the hexcode @var{hex}.
@end deffn
@deffn {Procedure} hex->color hex [type]
Return a @code{color} representing the hexcode @var{hex}, optionally
with the given @var{type} (@code{'foreground} or @code{'background}).
@end deffn
@defvr {Parameter} current-color-profile
Symbol representing the color profile of the current output port. The
possible values are:
@itemize
@item
@var{true-color}: Port supports 24-bit ``true color'' representing
about 16 million colors.
@item
@var{ansi256}: Port supports a 256-color palette consisting of 216
colors, 16 ANSI colors, and 24 shades of gray. Color values are
24-bit.
@item
@var{ansi}: Port supports 16 colors, bold, italics, and background
coloration.
@item
@var{ascii}: Port does not support colors or styles. In practice, this
means the output port is not a terminal.
@end itemize
@end defvr
@deffn {Procedure} color->sequence color
Return a string of terminal control codes representing the
@code{color} record @var{color}. Uses @code{current-color-profile}.
@end deffn
@deffn {Procedure} color->ansi color
Convert the 24-bit ``true color'' @var{color} to the nearest ANSI
color equivalent.
@end deffn
@deffn {Procedure} color->ansi256 color
Convert the 24-bit ``true color'' @var{color} to the nearest 256-color
ANSI equivalent.
@end deffn
@node Hyperlink
@section Hyperlink
The @code{(termenv hyperlink)} module provides procedures to create
active hyperlinks in the terminal.
@deffn {Procedure} hyperlink link [name]
Create a terminal control sequence which displays the optional string
@var{name} as a hyperlink to @var{link}. If @var{name} is not
provided, @var{link} is used verbatim.
@end deffn
@deffn {Procedure} format-hyperlink link [name] [port (current-output-port)]
Write the string @var{name} to @var{port}, formatted as a hyperlink to
@var{link}. This is equivalent to:
@lisp
(format port (hyperlink link name))
@end lisp
If @var{name} is not provided, @var{link} is used verbatim. If
@var{port} is not provided, @code{current-output-port} is used.
@end deffn
@node Screen
@section Screen
The @code{(termenv screen)} module provides facilities for controlling
the general state of a terminal.
@deffn {Procedure} reset [port (current-output-port)]
Reset @var{port} to its default state, removing any active styles.
@end deffn
@deffn {Procedure} set-foreground-color hex [port (current-output-port)]
Apply the hexcode @var{hex} as the default foreground color for
@var{port}.
@end deffn
@deffn {Procedure} set-background-color hex [port (current-output-port)]
Apply the hexcode @var{hex} as the default background color for
@var{port}.
@end deffn
@deffn {Procedure} set-cursor-color hex [port (current-output-port)]
Apply the hexcode @var{hex} as the default cursor color for
@var{port}.
@end deffn
@deffn {Procedure} save-screen [port (current-output-port)]
Save the state of @var{port} so that it may be restored later with
@code{restore-screen}.
@end deffn
@deffn {Procedure} restore-screen [port (current-output-port)]
Restore @var{port} to a state previously saved with
@code{save-screen}.
@end deffn
Terminals provide a facility called an @dfn{alternate screen} which
allows a program to write to a blank slate which is wiped away when
the program terminates. The following procedures allow programmers to
emit control codes entering and exiting this screen.
@deffn {Procedure} alt-screen [port (current-output-port)]
Switch @var{port} to the alternate screen buffer.
@end deffn
@deffn {Procedure} exit-alt-screen [port (current-output-port)]
Switch @var{port} from the alternate screen buffer to the main screen
buffer.
@end deffn
@deffn {Procedure} hide-cursor [port (current-output-port)]
Hide the cursor of @var{port}.
@end deffn
@deffn {Procedure} show-cursor [port (current-output-port)]
Show the cursor of @var{port}.
@end deffn
@deffn {Procedure} save-cursor-position [port (current-output-port)]
Save the current position of the cursor of @var{port}.
@end deffn
@deffn {Procedure} restore-cursor-position [port (current-output-port)]
Restore the saved position of the cursor of @var{port}.
@end deffn
Terminals have a concept of a @dfn{scrolling region}. This is the
region of a terminal screen which is actively being controlled, and
according to whose coordinates the cursor is moved. Most of the
following procedures operate on the active scrolling region.
@deffn {Procedure} change-scrolling-region top bottom [port (current-output-port)]
Set the scrolling region of @var{port} to the area from row number
@var{top} to row number @var{bottom}.
@end deffn
@deffn {Procedure} clear-screen [port (current-output-port)]
Clear the scrolling region of @var{port}.
@end deffn
@deffn {Procedure} move-cursor y x [port (current-output-port)]
Move the cursor of @var{port} to row @var{y} and column @var{x}. Note
that these values are 1-based, so the top left corner is at the
coordinates @samp{1,1}.
@end deffn
@deffn {Procedure} scroll-up [amount 1] [port (current-output-port)]
Scroll @var{port} up by @var{amount} rows.
@end deffn
@deffn {Procedure} scroll-down [amount 1] [port (current-output-port)]
Scroll @var{port} down by @var{amount} rows.
@end deffn
@deffn {Procedure} cursor-up [distance 1] [port (current-output-port)]
Move the cursor of @var{port} up @var{distance} rows.
@end deffn
@deffn {Procedure} cursor-down [distance 1] [port (current-output-port)]
Move the cursor of @var{port} down @var{distance} rows.
@end deffn
@deffn {Procedure} cursor-forward [distance 1] [port (current-output-port)]
Move the cursor of @var{port} forward @var{distance} columns.
@end deffn
@deffn {Procedure} cursor-back [distance 1] [port (current-output-port)]
Move the cursor of @var{port} backwards @var{distance} columns.
@end deffn
@deffn {Procedure} cursor-next-line [distance 1] [port (current-output-port)]
Move the cursor of @var{port} up @var{distance} rows and place it at
the beginning of the line.
@end deffn
@deffn {Procedure} cursor-prev-line [distance 1] [port (current-output-port)]
Move the cursor of @var{port} down @var{distance} rows and place it at
the beginning of the line.
@end deffn
@deffn {Procedure} clear-line [port (current-output-port)]
Clear the current line of @var{port}.
@end deffn
@deffn {Procedure} clear-line-left [port (current-output-port)]
Clear the current line of @var{port} left of its cursor.
@end deffn
@deffn {Procedure} clear-line-right [port (current-output-port)]
Clear the current line of @var{port} right of its cursor.
@end deffn
@deffn {Procedure} clear-lines n [port (current-output-port)]
Clear @var{n} lines of @var{port}.
@end deffn
@deffn {Procedure} insert-lines n [port (current-output-port)]
Insert @var{n} blank rows at the top of the scrolling region of
@var{port}, pushing lower rows down.
@end deffn
@deffn {Procedure} delete-lines n [port (current-output-port)]
Delete @var{n} rows at the top of the scrolling region of @var{port},
pulling any rows below up.
@end deffn
@deffn {Procedure} set-window-title title [port (current-output-port)]
Set the window title of @var{port} to @var{title}.
@end deffn
@node Style
@section Style
The @code{(termenv style)} module provides procedures for manipulating
the style and color (@pxref{Color}) of text.
@deffn {Procedure} foreground c s @dots{}
Return a string of terminal control codes representing the string or
strings @var{s} with the foreground color indicated by the hexcode
@var{c}.
@end deffn
@deffn {Procedure} background c s @dots{}
Return a string of terminal control codes representing the string or
strings @var{s} with the background color indicated by the hexcode
@var{c}.
@end deffn
@deffn {Procedure} bold s @dots{}
Return a string of terminal control codes to render the string or
strings @var{s} in boldface.
@end deffn
@deffn {Procedure} faint s @dots{}
Return a string of terminal control codes to render the string or
strings @var{s} faintly.
@end deffn
@deffn {Procedure} italic s @dots{}
Return a string of terminal control codes to italicize the string or
strings @var{s}.
@end deffn
@deffn {Procedure} underline s @dots{}
Return a string of terminal control codes to underline the string or
strings @var{s}.
@end deffn
@deffn {Procedure} overline s @dots{}
Return a string of terminal control codes to overline the string or
strings @var{s}.
@end deffn
@deffn {Procedure} blink s @dots{}
Return a string of terminal control codes to render the string or
strings @var{s} blinking.
@end deffn
@deffn {Procedure} invert s @dots{}
Return a string of terminal control codes to reverse the string or
strings @var{s}.
@end deffn
@deffn {Procedure} cross-out s @dots{}
Return a string of terminal control codes to cross out the string or
strings @var{s} in boldface.
@end deffn
@node Unix
@section Unix
The @code{(termenv unix)} module provides a single procedure for
determining the color and control code support of a terminal.
@deffn {Procedure} color-profile port
Test the characteristics of the terminal indicated by @code{port} and
return a symbol indicating its highest-bit color profile. Returns one
of:
@itemize
@item
@var{true-color}: Port supports 24-bit ``true color'' representing
about 16 million colors.
@item
@var{ansi256}: Port supports a 256-color palette consisting of 216
colors, 16 ANSI colors, and 24 shades of gray. Color values are
24-bit.
@item
@var{ansi}: Port supports 16 colors, bold, italics, and background
coloration.
@item
@var{ascii}: Port does not support colors or styles. In practice, this
means the output port is not a terminal.
@end itemize
@end deffn
@node Index
@unnumbered Index
@printindex fn
@bye

35
guile-termenv/hconfig.scm
View File

@ -1,35 +0,0 @@
(define-module
(guile-termenv 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 "")
(define %license 'gpl3+)
(define %copyright '(2024))
(define %gettext-domain "guile-termenv")
(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)

65
guix.scm
View File

@ -1,16 +1,15 @@
(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-termenv")
@ -18,21 +17,33 @@
(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"))))))
#: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))
(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))
(propagated-inputs (list))
(synopsis "")
(description "")
(home-page "")
(synopsis "Guile port of termenv")
(description
"A library to provide easy control of terminals from Guile using terminal control codes.")
(home-page "https://git.solarpunk.moe/vv/guile-termenv")
(license license:gpl3+))

88
hall.scm
View File

@ -1,46 +1,44 @@
(hall-description
(name "guile-termenv")
(prefix "")
(version "0.1")
(author "")
(email "")
(copyright (2024))
(synopsis "")
(description "")
(home-page "")
(license gpl3+)
(dependencies `())
(skip ("bootstrap"))
(features
((guix #f)
(use-guix-specs-for-dependencies #f)
(native-language-support #f)
(licensing #f)))
(files (libraries
((directory
"termenv"
((scheme-file "style")
(scheme-file "unix")
(scheme-file "hyperlink")
(scheme-file "screen")
(scheme-file "color")
(scheme-file "hconfig")))
(scheme-file "termenv")
(directory
"tests"
((scheme-file "utils")))))
(tests ((directory
"tests"
((scheme-file "test-screen")
(scheme-file "test-style")))))
(programs ((directory "scripts" ())))
(documentation
((org-file "README")
(symlink "README" "README.org")
(text-file "HACKING")
(text-file "COPYING")
(directory "doc" ((texi-file "guile-termenv")))))
(infrastructure
((scheme-file "guix")
(text-file ".gitignore")
(scheme-file "hall")))))
(name "termenv")
(prefix "guile")
(version "0.1")
(author "Vivanne Langdon")
(email "")
(copyright (2024))
(synopsis "Guile port of termenv")
(description
"A library to provide easy control of terminals from Guile using terminal control codes.")
(home-page "https://git.solarpunk.moe/vv/guile-termenv")
(license gpl3+)
(dependencies `())
(features
((guix #t)
(use-guix-specs-for-dependencies #f)
(native-language-support #f)
(licensing #f)))
(files (libraries
((directory "termenv"
((scheme-file "style")
(scheme-file "unix")
(scheme-file "hyperlink")
(scheme-file "screen")
(scheme-file "color")
(scheme-file "hconfig")))
(scheme-file "termenv")))
(tests ((directory "tests"
((scheme-file "test-screen")
(scheme-file "test-style")))))
(documentation
((org-file "README")
(symlink "README" "README.org")
(text-file "HACKING")
(text-file "COPYING")
(directory "doc"
((texi-file "guile-termenv")))))
(programs ())
(infrastructure
((scheme-file "guix")
(text-file ".gitignore")
(scheme-file "hall")
(directory "tests"
((scheme-file "utils")))))))

52
termenv/color.scm
View File

@ -304,6 +304,41 @@
(b color-b)
(type color-type))
(define* (hex->color hex #:optional (type 'foreground))
(define strlen (string-length hex))
(define trimmed
(cond
((and (or (= strlen 4)
(= strlen 7))
(char=? (string-ref hex 0) #\#))
(substring/copy hex 1))
((and (or (= strlen 5)
(= strlen 8))
(char=? (string-ref hex 1) #\x))
(substring/copy hex 2))
((or (= strlen 3)
(= strlen 6))
hex)
(else (error "Invalid hex string: incorrect length"))))
(define width (if (= (string-length trimmed) 3) 1 2))
(define r (locale-string->integer
(substring/copy trimmed 0 width) 16))
(define g (locale-string->integer
(substring/copy trimmed width (* 2 width)) 16))
(define b (locale-string->integer
(substring/copy trimmed (* 2 width) (* 3 width)) 16))
(when (= width 1)
(let ((double-hex
(lambda (v)
(+ (* v #XF) v))))
(set! r (double-hex r))
(set! g (double-hex g))
(set! b (double-hex b))))
(make-color r g b type))
(define %ANSI256-COLORS
(map hex->color %ANSI256-HEX))
@ -371,23 +406,6 @@
(expt (- cie-a1 cie-a2) 2)
(expt (- cie-b1 cie-b2) 2))))
(define* (hex->color str #:optional (type 'foreground))
(define trimmed (string-trim str #\#))
(define width (floor (/ (string-length trimmed) 3)))
(unless (or (= 1 width)
(= 2 width))
(error "Invalid hex: not the right length"))
(define r (substring/copy trimmed 0 width))
(define g (substring/copy trimmed width (* 2 width)))
(define b (substring/copy trimmed (* 2 width) (* 3 width)))
(make-color
(locale-string->integer r 16)
(locale-string->integer g 16)
(locale-string->integer b 16)
type))
(define (color->ansi color)
"Given a full color, convert to the nearest ansi color equivalent"
(color->table color %ANSI-COLORS))

6
termenv/hyperlink.scm
View File

@ -3,11 +3,11 @@
#:export (format-hyperlink
hyperlink))
(define (format-hyperlink port link name)
(define* (format-hyperlink link #:optional name (port #t))
"Output a hyperlink using OSC8 to the provided port"
(format port (hyperlink link name)))
(define (hyperlink link name)
(define* (hyperlink link #:optional name)
"Create an OSC8 hyperlink sequence"
(string-append %OSC "8;;" link %ST name %OSC "8;;" %ST))
(string-append %OSC "8;;" link %ST (or name link) %OSC "8;;" %ST))