2018-10-31 19:34:48 +00:00
|
|
|
;;; Gash --- Guile As SHell
|
2018-07-04 19:02:49 +01:00
|
|
|
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
|
|
|
;;; Copyright © 2016 Efraim Flashner <efraim@flashner.co.il>
|
|
|
|
;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
|
|
|
|
;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
|
|
|
|
;;;
|
|
|
|
;;; This file is part of Gash.
|
|
|
|
;;;
|
|
|
|
;;; Gash 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.
|
|
|
|
;;;
|
|
|
|
;;; Gash 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 Gash. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
2018-10-27 20:29:46 +01:00
|
|
|
;;; Commentary:
|
|
|
|
|
|
|
|
;;; The initial bournish.scm was taken from Guix.
|
|
|
|
|
|
|
|
;;; Code:
|
|
|
|
|
2018-07-04 19:02:49 +01:00
|
|
|
(define-module (gash bournish-commands)
|
|
|
|
#:use-module (srfi srfi-26)
|
|
|
|
#:use-module (gash io)
|
2018-10-30 18:45:01 +00:00
|
|
|
#:use-module (gash config)
|
|
|
|
#:use-module (gash shell-utils)
|
|
|
|
|
2018-11-12 06:14:05 +00:00
|
|
|
#:use-module ((gash commands basename) #:prefix gash:)
|
2018-10-30 18:45:01 +00:00
|
|
|
#:use-module (gash commands cat)
|
|
|
|
#:use-module (gash commands compress)
|
|
|
|
#:use-module (gash commands cp)
|
2018-11-12 06:14:05 +00:00
|
|
|
#:use-module ((gash commands dirname) #:prefix gash:)
|
2018-10-30 18:45:01 +00:00
|
|
|
#:use-module (gash commands find)
|
|
|
|
#:use-module (gash commands grep)
|
|
|
|
#:use-module (gash commands ls)
|
2018-11-30 11:26:28 +00:00
|
|
|
#:use-module (gash commands mkdir)
|
|
|
|
#:use-module (gash commands mv)
|
2018-10-30 18:45:01 +00:00
|
|
|
#:use-module (gash commands reboot)
|
2018-10-31 21:30:49 +00:00
|
|
|
#:use-module (gash commands rm)
|
2018-10-30 18:45:01 +00:00
|
|
|
#:use-module (gash commands sed)
|
|
|
|
#:use-module (gash commands tar)
|
2018-11-04 10:28:01 +00:00
|
|
|
#:use-module (gash commands touch)
|
2018-12-01 21:48:57 +00:00
|
|
|
#:use-module (gash commands tr)
|
2018-10-30 18:45:01 +00:00
|
|
|
#:use-module (gash commands wc)
|
|
|
|
#:use-module (gash commands which)
|
2018-07-16 07:41:10 +01:00
|
|
|
|
2018-07-04 19:02:49 +01:00
|
|
|
#:export (
|
2018-07-16 07:41:10 +01:00
|
|
|
%bournish-commands
|
2018-11-05 19:45:26 +00:00
|
|
|
basename-command
|
2018-07-04 19:02:49 +01:00
|
|
|
cat-command
|
2018-10-30 18:45:01 +00:00
|
|
|
compress-command
|
|
|
|
cp-command
|
2018-11-05 19:24:54 +00:00
|
|
|
dirname-command
|
2018-07-16 07:41:10 +01:00
|
|
|
find-command
|
|
|
|
grep-command
|
2018-07-04 19:02:49 +01:00
|
|
|
ls-command
|
2018-11-30 11:26:28 +00:00
|
|
|
mkdir-command
|
|
|
|
mv-command
|
2018-07-04 19:02:49 +01:00
|
|
|
reboot-command
|
2018-10-31 21:30:49 +00:00
|
|
|
rm-command
|
2018-10-30 18:45:01 +00:00
|
|
|
sed-command
|
2018-11-05 19:45:26 +00:00
|
|
|
tar-command
|
|
|
|
touch-command
|
2018-12-01 21:48:57 +00:00
|
|
|
tr-command
|
2018-07-04 19:02:49 +01:00
|
|
|
rm-command
|
|
|
|
wc-command
|
|
|
|
which-command
|
|
|
|
))
|
|
|
|
|
2018-10-30 18:45:01 +00:00
|
|
|
(define (wrap-command name command)
|
2018-07-05 05:17:34 +01:00
|
|
|
(lambda args
|
2018-10-30 18:45:01 +00:00
|
|
|
(lambda _
|
|
|
|
(catch #t
|
|
|
|
(cut apply command (cons name args))
|
|
|
|
(lambda (key . args)
|
|
|
|
(format (current-error-port) "~a: ~a ~a\n" name key args)
|
|
|
|
(case key
|
|
|
|
((quit) (car args))
|
|
|
|
(else 1)))))))
|
|
|
|
|
2018-11-12 06:14:05 +00:00
|
|
|
(define basename-command (wrap-command "basename" gash:basename))
|
2018-11-14 21:40:52 +00:00
|
|
|
(define cat-command (wrap-command "cat" cat))
|
2018-10-30 18:45:01 +00:00
|
|
|
(define compress-command (wrap-command "compress" compress))
|
|
|
|
(define cp-command (wrap-command "cp" cp))
|
2018-11-12 06:14:05 +00:00
|
|
|
(define dirname-command (wrap-command "dirname" gash:dirname))
|
2018-10-30 18:45:01 +00:00
|
|
|
(define find-command (wrap-command "find" find))
|
|
|
|
(define grep-command (wrap-command "grep" grep))
|
|
|
|
(define ls-command (wrap-command "ls" ls))
|
2018-11-30 11:26:28 +00:00
|
|
|
(define mkdir-command (wrap-command "mkdir" mkdir'))
|
|
|
|
(define mv-command (wrap-command "mv" mv))
|
2018-11-04 06:27:59 +00:00
|
|
|
(define reboot-command (wrap-command "reboot" reboot'))
|
2018-10-31 21:30:49 +00:00
|
|
|
(define rm-command (wrap-command "rm" rm))
|
2018-11-04 07:43:04 +00:00
|
|
|
(define rmdir-command (wrap-command "rmdir" rmdir))
|
2018-10-30 18:45:01 +00:00
|
|
|
(define sed-command (wrap-command "sed" sed))
|
|
|
|
(define tar-command (wrap-command "tar" tar))
|
2018-11-04 10:28:01 +00:00
|
|
|
(define touch-command (wrap-command "touch" touch))
|
2018-12-01 21:48:57 +00:00
|
|
|
(define tr-command (wrap-command "tr" tr))
|
2018-10-30 18:45:01 +00:00
|
|
|
(define wc-command (wrap-command "wc" wc))
|
|
|
|
(define which-command (wrap-command "which" which))
|
|
|
|
|
|
|
|
(define (%bournish-commands)
|
2018-07-16 07:41:10 +01:00
|
|
|
`(
|
2018-11-05 19:45:26 +00:00
|
|
|
("basename" . ,basename-command)
|
2018-10-27 10:19:21 +01:00
|
|
|
("cat" . ,cat-command)
|
|
|
|
("compress" . ,compress-command)
|
|
|
|
("cp" . ,cp-command)
|
2018-11-05 19:24:54 +00:00
|
|
|
("dirname" . ,dirname-command)
|
2018-10-27 10:19:21 +01:00
|
|
|
("find" . ,find-command)
|
|
|
|
("grep" . ,grep-command)
|
|
|
|
("ls" . ,ls-command)
|
2018-11-30 11:26:28 +00:00
|
|
|
("mkdir" . ,mkdir-command)
|
|
|
|
("mv" . ,mv-command)
|
2018-10-27 10:19:21 +01:00
|
|
|
("reboot" . ,reboot-command)
|
2018-10-31 21:30:49 +00:00
|
|
|
("rm" . ,rm-command)
|
2018-11-04 07:43:04 +00:00
|
|
|
("rmdir" . ,rmdir-command)
|
2018-10-30 18:45:01 +00:00
|
|
|
("sed" . ,sed-command)
|
2018-10-27 10:19:21 +01:00
|
|
|
("tar" . ,tar-command)
|
2018-11-04 10:28:01 +00:00
|
|
|
("touch" . ,touch-command)
|
2018-12-01 21:48:57 +00:00
|
|
|
("tr" . ,tr-command)
|
2018-10-27 10:19:21 +01:00
|
|
|
("wc" . ,wc-command)
|
|
|
|
("which" . ,which-command)
|
2018-07-16 07:41:10 +01:00
|
|
|
))
|