...
 
Commits (114)
......@@ -7,4 +7,14 @@
(eval . (put '<sh-until> 'scheme-indent-function 1))
(eval . (put '<sh-while> 'scheme-indent-function 1))
(eval . (put '<sh-with-redirects> 'scheme-indent-function 1))
(eval . (put 'call-with-backquoted-input-port 'scheme-indent-function 1)))))
(eval . (put 'call-with-backquoted-input-port 'scheme-indent-function 1))
(eval . (put 'make-script 'scheme-indent-function 1))
(eval . (put 'sh:for 'scheme-indent-function 1))
(eval . (put 'sh:subshell 'scheme-indent-function 0))
(eval . (put 'sh:substitute-command 'scheme-indent-function 0))
(eval . (put 'sh:with-redirects 'scheme-indent-function 1))
(eval . (put 'call-with-break 'scheme-indent-function 0))
(eval . (put 'call-with-continue 'scheme-indent-function 0))
(eval . (put 'with-arguments 'scheme-indent-function 1))
(eval . (put 'with-environ 'scheme-indent-function 1))
(eval . (put 'with-variables 'scheme-indent-function 1)))))
......@@ -5,6 +5,7 @@ Makefile.in
aclocal.m4
autom4te.cache/*
build-aux/*
!build-aux/git-version-gen
!build-aux/gitlab-ci.yml
config.log
config.status
......@@ -14,4 +15,7 @@ lcov.info
pre-inst-env
scripts/geesh
tests/*.trs
tests/config.scm
tests/spec/oil
tests/spec/oil-link
tools/coverage
......@@ -36,24 +36,77 @@ endif # HAVE_GENHTML
test-list: ; @echo $(TESTS)
.PHONY: check-spec
check-spec:
$(MAKE) $(AM_MAKEFLAGS) -L -C tests/spec check
.PHONY: check-bootstrap
check-bootstrap:
guix build -f tests/bash-without-bash.scm
dist-hook:
echo $(VERSION) > $(distdir)/.tarball-version
MODULES = \
geesh/built-ins/break.scm \
geesh/built-ins/cd.scm \
geesh/built-ins/colon.scm \
geesh/built-ins/continue.scm \
geesh/built-ins/dot.scm \
geesh/built-ins/echo.scm \
geesh/built-ins/eval.scm \
geesh/built-ins/exec.scm \
geesh/built-ins/exit.scm \
geesh/built-ins/export.scm \
geesh/built-ins/false.scm \
geesh/built-ins/pwd.scm \
geesh/built-ins/read.scm \
geesh/built-ins/readonly.scm \
geesh/built-ins/return.scm \
geesh/built-ins/set.scm \
geesh/built-ins/shift.scm \
geesh/built-ins/trap.scm \
geesh/built-ins/true.scm \
geesh/built-ins/umask.scm \
geesh/built-ins/unset.scm \
geesh/built-ins/utils.scm \
geesh/built-ins.scm \
geesh/environment.scm \
geesh/eval.scm \
geesh/lexer.scm \
geesh/parser.scm \
geesh/pattern.scm \
geesh/repl.scm \
geesh/shell.scm \
geesh/word.scm
bin_SCRIPTS = \
scripts/geesh
do_subst = sed \
-e 's,[@]GUILE[@],$(GUILE),g' \
-e 's,[@]MODDIR[@],$(moddir),g' \
-e 's,[@]GODIR[@],$(godir),g'
scripts/geesh: scripts/geesh.in Makefile
$(do_subst) < $(srcdir)/scripts/geesh.in > scripts/geesh
chmod a+x scripts/geesh
TESTS = \
tests/environment.scm \
tests/lexer.scm \
tests/parser.scm \
tests/repl.scm \
tests/pattern.scm \
tests/shell.scm \
tests/word.scm
EXTRA_DIST = \
scripts/geesh.in
CLEANFILES = \
$(GOBJECTS) \
$(bin_SCRIPTS) \
$(TESTS:tests/%.scm=%.log) \
$(TESTS:tests/%.scm=%.trs)
clean-local:
$(MAKE) $(AM_MAKEFLAGS) -L -C tests/spec clean
#!/bin/sh
# Print a version string.
scriptversion=2018-03-07.03; # UTC
# Copyright (C) 2007-2018 Free Software Foundation, Inc.
#
# 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 <https://www.gnu.org/licenses/>.
# This script is derived from GIT-VERSION-GEN from GIT: https://git-scm.com/.
# It may be run two ways:
# - from a git repository in which the "git describe" command below
# produces useful output (thus requiring at least one signed tag)
# - from a non-git-repo directory containing a .tarball-version file, which
# presumes this script is invoked like "./git-version-gen .tarball-version".
# In order to use intra-version strings in your project, you will need two
# separate generated version string files:
#
# .tarball-version - present only in a distribution tarball, and not in
# a checked-out repository. Created with contents that were learned at
# the last time autoconf was run, and used by git-version-gen. Must not
# be present in either $(srcdir) or $(builddir) for git-version-gen to
# give accurate answers during normal development with a checked out tree,
# but must be present in a tarball when there is no version control system.
# Therefore, it cannot be used in any dependencies. GNUmakefile has
# hooks to force a reconfigure at distribution time to get the value
# correct, without penalizing normal development with extra reconfigures.
#
# .version - present in a checked-out repository and in a distribution
# tarball. Usable in dependencies, particularly for files that don't
# want to depend on config.h but do want to track version changes.
# Delete this file prior to any autoconf run where you want to rebuild
# files to pick up a version string change; and leave it stale to
# minimize rebuild time after unrelated changes to configure sources.
#
# As with any generated file in a VC'd directory, you should add
# /.version to .gitignore, so that you don't accidentally commit it.
# .tarball-version is never generated in a VC'd directory, so needn't
# be listed there.
#
# Use the following line in your configure.ac, so that $(VERSION) will
# automatically be up-to-date each time configure is run (and note that
# since configure.ac no longer includes a version string, Makefile rules
# should not depend on configure.ac for version updates).
#
# AC_INIT([GNU project],
# m4_esyscmd([build-aux/git-version-gen .tarball-version]),
# [bug-project@example])
#
# Then use the following lines in your Makefile.am, so that .version
# will be present for dependencies, and so that .version and
# .tarball-version will exist in distribution tarballs.
#
# EXTRA_DIST = $(top_srcdir)/.version
# BUILT_SOURCES = $(top_srcdir)/.version
# $(top_srcdir)/.version:
# echo $(VERSION) > $@-t && mv $@-t $@
# dist-hook:
# echo $(VERSION) > $(distdir)/.tarball-version
me=$0
version="git-version-gen $scriptversion
Copyright 2011 Free Software Foundation, Inc.
There is NO warranty. You may redistribute this software
under the terms of the GNU General Public License.
For more information about these matters, see the files named COPYING."
usage="\
Usage: $me [OPTION]... \$srcdir/.tarball-version [TAG-NORMALIZATION-SED-SCRIPT]
Print a version string.
Options:
--prefix PREFIX prefix of git tags (default 'v')
--fallback VERSION
fallback version to use if \"git --version\" fails
--help display this help and exit
--version output version information and exit
Running without arguments will suffice in most cases."
prefix=v
fallback=
while test $# -gt 0; do
case $1 in
--help) echo "$usage"; exit 0;;
--version) echo "$version"; exit 0;;
--prefix) shift; prefix=${1?};;
--fallback) shift; fallback=${1?};;
-*)
echo "$0: Unknown option '$1'." >&2
echo "$0: Try '--help' for more information." >&2
exit 1;;
*)
if test "x$tarball_version_file" = x; then
tarball_version_file="$1"
elif test "x$tag_sed_script" = x; then
tag_sed_script="$1"
else
echo "$0: extra non-option argument '$1'." >&2
exit 1
fi;;
esac
shift
done
if test "x$tarball_version_file" = x; then
echo "$usage"
exit 1
fi
tag_sed_script="${tag_sed_script:-s/x/x/}"
nl='
'
# Avoid meddling by environment variable of the same name.
v=
v_from_git=
# First see if there is a tarball-only version file.
# then try "git describe", then default.
if test -f $tarball_version_file
then
v=`cat $tarball_version_file` || v=
case $v in
*$nl*) v= ;; # reject multi-line output
[0-9]*) ;;
*) v= ;;
esac
test "x$v" = x \
&& echo "$0: WARNING: $tarball_version_file is missing or damaged" 1>&2
fi
if test "x$v" != x
then
: # use $v
# Otherwise, if there is at least one git commit involving the working
# directory, and "git describe" output looks sensible, use that to
# derive a version string.
elif test "`git log -1 --pretty=format:x . 2>&1`" = x \
&& v=`git describe --abbrev=4 --match="$prefix*" HEAD 2>/dev/null \
|| git describe --abbrev=4 HEAD 2>/dev/null` \
&& v=`printf '%s\n' "$v" | sed "$tag_sed_script"` \
&& case $v in
$prefix[0-9]*) ;;
*) (exit 1) ;;
esac
then
# Is this a new git that lists number of commits since the last
# tag or the previous older version that did not?
# Newer: v6.10-77-g0f8faeb
# Older: v6.10-g0f8faeb
vprefix=`expr "X$v" : 'X\(.*\)-g[^-]*$'` || vprefix=$v
case $vprefix in
*-*) : git describe is probably okay three part flavor ;;
*)
: git describe is older two part flavor
# Recreate the number of commits and rewrite such that the
# result is the same as if we were using the newer version
# of git describe.
vtag=`echo "$v" | sed 's/-.*//'`
commit_list=`git rev-list "$vtag"..HEAD 2>/dev/null` \
|| { commit_list=failed;
echo "$0: WARNING: git rev-list failed" 1>&2; }
numcommits=`echo "$commit_list" | wc -l`
v=`echo "$v" | sed "s/\(.*\)-\(.*\)/\1-$numcommits-\2/"`;
test "$commit_list" = failed && v=UNKNOWN
;;
esac
# Change the penultimate "-" to ".", for version-comparing tools.
# Remove the "g" to save a byte.
v=`echo "$v" | sed 's/-\([^-]*\)-g\([^-]*\)$/.\1-\2/'`;
v_from_git=1
elif test "x$fallback" = x || git --version >/dev/null 2>&1; then
v=UNKNOWN
else
v=$fallback
fi
v=`echo "$v" |sed "s/^$prefix//"`
# Test whether to append the "-dirty" suffix only if the version
# string we're using came from git. I.e., skip the test if it's "UNKNOWN"
# or if it came from .tarball-version.
if test "x$v_from_git" != x; then
# Don't declare a version "dirty" merely because a timestamp has changed.
git update-index --refresh > /dev/null 2>&1
dirty=`exec 2>/dev/null;git diff-index --name-only HEAD` || dirty=
case "$dirty" in
'') ;;
*) # Append the suffix only if there isn't one already.
case $v in
*-dirty) ;;
*) v="$v-dirty" ;;
esac ;;
esac
fi
# Omit the trailing newline, so that m4_esyscmd can use the result directly.
printf %s "$v"
# Local variables:
# eval: (add-hook 'before-save-hook 'time-stamp)
# time-stamp-start: "scriptversion="
# time-stamp-format: "%:y-%02m-%02d.%02H"
# time-stamp-time-zone: "UTC0"
# time-stamp-end: "; # UTC"
# End:
AC_INIT([Geesh], [0.1-rc])
AC_INIT([Geesh],
m4_esyscmd([build-aux/git-version-gen .tarball-version]))
AC_CONFIG_SRCDIR([geesh])
AC_CONFIG_AUX_DIR([build-aux])
AM_INIT_AUTOMAKE([color-tests silent-rules -Wall -Werror foreign])
......@@ -12,7 +13,8 @@ AM_CONDITIONAL([HAVE_GENHTML], [test -n $GENHTML])
AC_CONFIG_FILES([Makefile])
AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
AC_CONFIG_FILES([scripts/geesh], [chmod +x scripts/geesh])
AC_CONFIG_FILES([tests/config.scm])
AC_CONFIG_FILES([tests/spec/Makefile])
AC_CONFIG_FILES([tools/coverage], [chmod +x tools/coverage])
AC_OUTPUT
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins)
#:use-module (geesh built-ins echo)
#:export (search-built-ins
search-special-built-ins))
;;; Commentary:
;;;
;;; This module provides built-in searching functions.
;;;
;;; Code:
(define (undefined env . args)
(throw 'undefined-built-in))
;; Special built-ins take precedence over any other command.
(define *special-built-ins*
`(("." . ,(@@ (geesh built-ins dot) main))
(":" . ,(@@ (geesh built-ins colon) main))
("break" . ,(@@ (geesh built-ins break) main))
("continue" . ,(@@ (geesh built-ins continue) main))
("eval" . ,(@@ (geesh built-ins eval) main))
("exec" . ,(@@ (geesh built-ins exec) main))
("exit" . ,(@@ (geesh built-ins exit) main))
("export" . ,(@@ (geesh built-ins export) main))
("readonly" . ,(@@ (geesh built-ins readonly) main))
("return" . ,(@@ (geesh built-ins return) main))
("set" . ,(@@ (geesh built-ins set) main))
("shift" . ,(@@ (geesh built-ins shift) main))
("times" . ,undefined)
("trap" . ,(@@ (geesh built-ins trap) main))
("unset" . ,(@@ (geesh built-ins unset) main))))
;; Regular built-ins take precendence over utilities in the search
;; path, but not over functions.
(define *built-ins*
`( ;; POSIX-specified built-ins.
("alias" . ,undefined)
("bg" . ,undefined)
("cd" . ,(@@ (geesh built-ins cd) main))
("command" . ,undefined)
("false" . ,(@@ (geesh built-ins false) main))
("fc" . ,undefined)
("fg" . ,undefined)
("getopts" . ,undefined)
("hash" . ,undefined)
("jobs" . ,undefined)
("kill" . ,undefined)
("newgrp" . ,undefined)
("pwd" . ,(@@ (geesh built-ins pwd) main))
("read" . ,(@@ (geesh built-ins read) main))
("true" . ,(@@ (geesh built-ins true) main))
("umask" . ,(@@ (geesh built-ins umask) main))
("unalias" . ,undefined)
("wait" . ,undefined)
;; Other built-ins.
("echo" . ,echo)))
(define (search-special-built-ins name)
(assoc-ref *special-built-ins* name))
(define (search-built-ins name)
(assoc-ref *built-ins* name))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins break)
#:use-module (geesh environment))
;;; Commentary:
;;;
;;; The 'break' utility.
;;;
;;; Code:
(define (main . args)
(let* ((arg (and (pair? args) (car args)))
(n (string->number (or arg "1"))))
(if (and arg (or (not n) (not (exact-integer? n)) (< n 1)))
1
(begin
;; Since we do not return, we have to set the status here.
(set-status! 0)
(sh:break (1- n))))))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins cd)
#:use-module (geesh environment)
#:use-module (ice-9 match))
;;; Commentary:
;;;
;;; The 'cd' utility.
;;;
;;; Code:
(define pwd (@@ (geesh built-ins pwd) main))
(define (directory? path)
"Check if @var{path} refers to a directory."
(eq? (stat:type (stat path)) 'directory))
(define (canonicalize-path-logically path)
"Canonicalize @var{path} by removing dot components, processing
dot-dot components, and removing duplicate slashes (with the exception
that if there are exactly two leading slashes, those two are
preserved). This differs from @code{canonicalize-path} in that it
does not process symbolic links before processing dot-dot components."
(define char-set:not-slash
(char-set-complement (char-set #\/)))
(define (acc->path acc)
(if (null? acc)
"/"
(string-join (reverse acc) "/" 'prefix)))
;; XXX: Following POSIX, we should preserve both leading slashes
;; when there are exactly two.
(let loop ((parts (string-tokenize path char-set:not-slash)) (acc '()))
(match parts
(() (acc->path acc))
(("." . tail) (loop tail acc))
((".." . tail) (match acc
(() (loop tail acc))
((prev . acc-tail)
(and (directory? (acc->path acc))
(loop tail acc-tail)))))
((part . tail) (loop tail (cons part acc))))))
(define (main . args)
(match args
(("-")
(match (main (getvar "OLDPWD" ""))
(0 (pwd))
(x x)))
(_
(let loop ((args args) (logical? #t))
(match args
(()
(match (getvar "HOME")
(#f (format (current-error-port)
"~a: cd: Could not find home directory.~%"
(car (program-arguments)))
EXIT_FAILURE)
(directory (main directory))))
(("-P" . tail) (loop tail #f))
(("-L" . tail) (loop tail #t))
((or (directory) ("--" directory))
(let ((curpath (cond
(logical? (canonicalize-path-logically
(if (string-prefix? "/" directory)
directory
(string-append (getvar "PWD")
"/" directory))))
(else (if (string-prefix? "/" directory)
directory
(string-append (getcwd)
"/" directory))))))
(if (catch 'system-error
(lambda ()
(chdir curpath)
#t)
(lambda args
(format (current-error-port)
"~a: cd: ~a: ~a~%"
(car (program-arguments)) curpath
(strerror (system-error-errno args)))
#f))
(begin
(setvar! "OLDPWD" (getvar "PWD"))
(setvar! "PWD" (if logical? curpath (getcwd)))
EXIT_SUCCESS)
EXIT_FAILURE)))
(_ (format (current-error-port)
"~a: cd: Invalid arguments."
(car (program-arguments)))))))))
;;; The Geesh Shell Interpreter
;;; Copyright 2017 Timothy Sample <samplet@ngyro.com>
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
......@@ -16,23 +16,13 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-repl)
#:use-module (geesh repl)
#:use-module (srfi srfi-64)
#:use-module (tests automake))
(define-module (geesh built-ins colon))
;;; Commentary:
;;;
;;; Tests for the repl module.
;;; The 'colon' utility.
;;;
;;; Code:
(test-begin "repl")
(test-equal "Echos input with prompt"
"$ Hello World!\n$ "
(with-output-to-string
(lambda ()
(with-input-from-string "Hello World!" run-repl))))
(test-end "repl")
(define (main . args)
0)
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins continue)
#:use-module (geesh environment))
;;; Commentary:
;;;
;;; The 'continue' utility.
;;;
;;; Code:
(define (main . args)
(let* ((arg (and (pair? args) (car args)))
(n (string->number (or arg "1"))))
(if (and arg (or (not n) (not (exact-integer? n)) (< n 1)))
1
(begin
;; Since we do not return, we have to set the status here.
(set-status! 0)
(sh:continue (1- n))))))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins dot)
#:use-module (geesh built-ins utils)
#:use-module (geesh environment)
#:use-module (geesh parser)
#:use-module (ice-9 match))
;;; Commentary:
;;;
;;; The 'dot' utility.
;;;
;;; Code:
(define (main . args)
(match args
((file)
(catch 'system-error
(lambda ()
(call-with-input-file file
(lambda (port)
(set-status! 0)
(call-with-return
(lambda ()
(let loop ()
(match (read-sh port)
((? eof-object?) (get-status))
(exp ((get-evaluator) exp)
(loop)))))))))
(lambda args
(format (current-error-port)
"~a: .: ~a: ~a.~%"
(car (program-arguments)) file
(strerror (system-error-errno args)))
EXIT_FAILURE)))
(_ (format (current-error-port)
"~a: .: Invalid options ~s.~%"
(car (program-arguments)) args)
EXIT_FAILURE)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins echo)
#:export (echo))
;;; Commentary:
;;;
;;; The 'echo' utility.
;;;
;;; Code:
(define (echo . args)
(let* ((n? (and (pair? args) (string=? (car args) "-n")))
(args (if n? (cdr args) args)))
(display (string-join args " "))
(unless n?
(newline))
0))
......@@ -16,41 +16,23 @@
;;; You should have received a copy of the GNU General Public License
;;; along with Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (test-environment)
(define-module (geesh built-ins eval)
#:use-module (geesh built-ins utils)
#:use-module (geesh environment)
#:use-module (srfi srfi-64)
#:use-module (tests automake))
#:use-module (geesh parser)
#:use-module (ice-9 match))
;;; Commentary:
;;;
;;; Tests for the environment module.
;;; The 'eval' utility.
;;;
;;; Code:
(test-begin "environment")
;;;
;;; Variables.
;;;
(test-equal "Stores existing variables"
"bar"
(let ((env (make-environment '(("FOO" . "bar")))))
(var-ref env "FOO")))
(test-equal "Stores new variables"
"bar"
(let ((env (make-environment '())))
(set-var! env "FOO" "bar")
(var-ref env "FOO")))
(test-equal "Updates variables"
"baz"
(let ((env (make-environment '(("FOO" . "bar")))))
(set-var! env "FOO" "baz")
(var-ref env "FOO")))
(test-equal "Returns '#f' for unset variables"
#f
(let ((env (make-environment '())))
(var-ref env "FOO")))
(define (main . args)
(match (string-trim-both (string-join args " ") #\space)
("" 0)
(code
(call-with-input-string code
(lambda (port)
((get-evaluator) `(<sh-begin> ,@(read-sh-all port)))))
(get-status))))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins exec)
#:use-module (geesh environment)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1))
;;; Commentary:
;;;
;;; The 'exec' utility.
;;;
;;; Code:
(define (main . args)
(match args
((name . args)
(flush-all-ports)
(with-environ (get-environ)
(lambda ()
(catch 'system-error
(lambda ()
(apply execlp name name args)
EXIT_SUCCESS)
(lambda args
(format (current-error-port)
"~a: exec: ~a: ~a.~%"
(car (program-arguments)) name
(strerror (system-error-errno args)))
EXIT_FAILURE)))))
(_ (format (current-error-port)
"~a: exec: Invalid options ~s.~%"
(car (program-arguments)) args)
EXIT_FAILURE)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins exit)
#:use-module (geesh environment))
;;; Commentary:
;;;
;;; The 'exit' utility.
;;;
;;; Code:
(define (main . args)
(let* ((arg (or (and (pair? args)
(car (last-pair args)))
(number->string (get-status))
"0"))
(number (string->number arg))
(status (or (and (exact-integer? number)
(>= number 0)
(<= number 256)
number)
;; If the above is not true, the exit status is
;; undefined.
EXIT_FAILURE)))
(sh:exit status)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins export)
#:use-module (geesh built-ins utils)
#:use-module (geesh environment)
#:use-module (ice-9 match))
;;; Commentary:
;;;
;;; The 'export' utility.
;;;
;;; Code:
(define (main . args)
(match args
(("-p") (throw 'not-implemented "export -p"))
(_ (for-each (lambda (assignment)
(call-with-values (lambda () (split-assignment assignment))
(lambda (name value)
(set-exported! name value))))
args)
0)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins false))
;;; Commentary:
;;;
;;; The 'false' utility.
;;;
;;; Code:
(define (main . args)
1)
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins pwd)
#:use-module (geesh environment)
#:use-module (ice-9 match))
;;; Commentary:
;;;
;;; The 'pwd' utility.
;;;
;;; Code:
(define (main . args)
(let loop ((args args) (logical? #t))
(match args
(("-P" . tail) (loop tail #f))
(("-L" . tail) (loop tail #t))
(()
(display (if logical?
(getvar "PWD")
(getcwd)))
(newline)
EXIT_SUCCESS))))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins read)
#:use-module (geesh environment)
#:use-module (ice-9 match)
#:use-module (ice-9 rdelim))
;;; Commentary:
;;;
;;; The 'read' utility.
;;;
;;; Code:
(define (main . args)
(match (read-line (current-input-port))
((? eof-object?) 1)
(str (setvar! (car args) str)
0)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins readonly)
#:use-module (geesh built-ins utils)
#:use-module (geesh environment)
#:use-module (ice-9 match))
;;; Commentary:
;;;
;;; The 'readonly' utility.
;;;
;;; Code:
(define (main . args)
(match args
(("-p") (throw 'not-implemented "readonly -p"))
(_ (for-each (lambda (assignment)
(call-with-values (lambda () (split-assignment assignment))
(lambda (name value)
(set-read-only! name value))))
args)
0)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins return)
#:use-module (geesh environment))
;;; Commentary:
;;;
;;; The 'return' utility.
;;;
;;; Code:
(define (main . args)
(let* ((arg (or (and (pair? args)
(car (last-pair args)))
(number->string (get-status))
"0"))
(number (string->number arg))
(status (or (and (exact-integer? number)
(>= number 0)
(<= number 256)
number)
;; If the above is not true, the exit status is
;; undefined.
EXIT_FAILURE)))
(sh:return status)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins set)
#:use-module (geesh environment)
#:use-module (ice-9 match))
;;; Commentary:
;;;
;;; The 'set' utility.
;;;
;;; Code:
(define (option? o)
(memq o *option-names*))
(define (option-letter? chr)
(assoc chr *option-letters*))
(define (set-option! option value args)
(setopt! option value)
(unless (null? args)
(set-program-arguments (cons (car (program-arguments)) args))))
(define (main . args)
(match args
(("-o")
(for-each (lambda (option)
(format #t "~a\t~a~%"
option (getopt option)))
*option-names*)
EXIT_SUCCESS)
(("+o")
(for-each (lambda (option)
(format #t "set ~a ~a~%"
(if (getopt option) "-o" "+o") option))
*option-names*)
EXIT_SUCCESS)
(_ (let loop ((args args))
(match args
(() EXIT_SUCCESS)
(("--" . args)
(set-program-arguments (cons (car (program-arguments)) args))
EXIT_SUCCESS)
(("-o" option-string . args)
(let ((option (string->symbol option-string)))
(match option
((? option?)
(setopt! option #t)
(loop args))
(_ (format (current-error-port)
"~a: set: invalid option ~a~%"
(car (program-arguments)) option)
EXIT_FAILURE))))
(("+o" option-string . args)
(let ((option (string->symbol option-string)))
(match option
((? option?)
(setopt! option #f)
(loop args))
(_ (format (current-error-port)
"~a: set: invalid option ~a~%"
(car (program-arguments)) option)
EXIT_FAILURE))))
((op . args)
(match (string->list op)
((#\- (? option-letter? chr))
(setopt! (assoc-ref *option-letters* chr) #t)
(loop args))
((#\+ (? option-letter? chr))
(setopt! (assoc-ref *option-letters* chr) #f)
(loop args))
(_ (loop (cons* "--" op args)))))
(_ (format (current-error-port)
"~a: set: invalid options ~s~%"
(car (program-arguments)) args)
EXIT_FAILURE))))))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins shift)
#:use-module (geesh environment)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1))
;;; Commentary:
;;;
;;; The 'shift' utility.
;;;
;;; Code:
(define (main . args)
(match args
(() (main "1"))
((n-string)
(let ((n (string->number n-string)))
(cond
((and n (exact? n) (>= n 0)
(<= n (length (cdr (program-arguments)))))
(set-program-arguments
(cons (car (program-arguments))
(drop (cdr (program-arguments)) n)))
EXIT_SUCCESS)
(else
(format (current-error-port)
"~a: shift: Invalid option ~s.~%"
(car (program-arguments)) n-string)
EXIT_FAILURE))))
(_ (format (current-error-port)
"~a: shift: Invalid options ~s.~%"
(car (program-arguments)) args)
EXIT_FAILURE)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins trap)
#:use-module (geesh environment)
#:use-module (ice-9 match))
;;; Commentary:
;;;
;;; The 'trap' utility.
;;;
;;; Code:
(define sh:eval (@@ (geesh built-ins eval) main))
(define (action->handler action)
(let ((n (string->number action)))
(cond
((and n (integer? n) (>= n 0)) SIG_DFL)
((string=? action "-") SIG_DFL)
((string-null? action) SIG_IGN)
(else (lambda () (sh:eval action))))))
(define (condition->signum condition)
(let ((n (string->number condition)))
(cond
((and n (integer? n)) n)
((string-ci=? condition "EXIT") 0)
(else (let* ((name (if (string-prefix-ci? "SIG" condition)
(string-upcase condition)
(string-append "SIG" (string-upcase condition))))
(symb (string->symbol name)))
(or (and=> (module-variable (current-module) symb)
variable-ref)
-1))))))
(define (main . args)
(match args
(() "print")
(("--" . args) (main args))
((action conditions ..1)
(let ((handler (action->handler action)))
(for-each (lambda (condition)
(match (condition->signum condition)
(0 (set-atexit! handler))
(n (sigaction n handler))))
conditions))
EXIT_SUCCESS)
(_ (format (current-error-port)
"~a: trap: Invalid options ~s.~%"
(car (program-arguments)) args)
EXIT_FAILURE)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins true))
;;; Commentary:
;;;
;;; The 'true' utility.
;;;
;;; Code:
(define (main . args)
0)
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins umask)
#:use-module (ice-9 match))
;;; Commentary:
;;;
;;; The 'umask' utility.
;;;
;;; Code:
(define (main . args)
(match args
((mask)
(let ((n (string->number mask 8)))
(cond
((and n (integer? n) (>= n 0) (< n 512))
(umask n)
EXIT_SUCCESS)
(else
(format (current-error-port)
"~a: umask: Invalid option ~s.~%"
(car (program-arguments)) mask)
EXIT_FAILURE))))
(_ (format (current-error-port)
"~a: umask: Invalid options ~s.~%"
(car (program-arguments)) args)
EXIT_FAILURE)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins unset)
#:use-module (geesh environment)
#:use-module (ice-9 match))
;;; Commentary:
;;;
;;; The 'unset' utility.
;;;
;;; Code:
(define (main . args)
(match args
(("-f" . names)
(for-each unsetfun! names)
0)
((or ("-v" . names)
names)
(for-each unsetvar! names)
0)))
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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.
;;;
;;; Geesh 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 Geesh. If not, see <http://www.gnu.org/licenses/>.
(define-module (geesh built-ins utils)
#:use-module (ice-9 match)
#:export (get-evaluator
split-assignment))
;;; Commentary:
;;;
;;; Utility functions shared by built-ins.
;;;
;;; Code:
;; We need to be able to run Shell code from the 'dot' and 'eval'
;; built-ins. This is a bit of trickery to avoid a module dependency
;; loop.
(define (get-evaluator)
(module-ref (resolve-interface '(geesh eval)) 'eval-sh))
(define (split-assignment assignment)
(match (string-index assignment #\=)
(#f (values assignment #f))
(index (let ((name (substring assignment 0 index)))
(match (substring assignment (1+ index))
((? string-null?) (values name #f))
(value (values name value)))))))
This diff is collapsed.
;;; The Geesh Shell Interpreter
;;; Copyright 2018 Timothy Sample <samplet@ngyro.com>
;;;
;;; This file is part of Geesh.
;;;
;;; Geesh 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