Make tar a bournish-command.
* bin/gash.in: Make Scheme script. * bin/tar.in: Likewise. * gash/bournish-commands (tar-command): New command, move from tar.scm. (%bournish-commands): Add it. * gash/tar.scm: Remove.
This commit is contained in:
Jan Nieuwenhuizen
parent
b8b170530c
commit
70d28ea480
|
|
@ -0,0 +1,6 @@
|
|||
#! /home/janneke/.guix-profile/bin/guile \
|
||||
--no-auto-compile -e main -L "/usr/local/share/guile/site/" -C "/usr/local/lib/guile//site-ccache" -L . -C . -s
|
||||
!#
|
||||
(define (main args)
|
||||
(setenv "SHELL" ((compose canonicalize-path car command-line)))
|
||||
((@ (gash gash) main) (command-line)))
|
||||
28
bin/gash.in
28
bin/gash.in
|
|
@ -1,12 +1,24 @@
|
|||
#! /bin/sh
|
||||
# -*-scheme-*-
|
||||
exec ${GUILE-guile} -L $(dirname $0) -L $(dirname $(dirname $0)) -C $(dirname $0) -C $(dirname $(dirname $0)) --no-auto-compile -e '(gash)' -s $0 "$@"
|
||||
#! @GUILE@ \
|
||||
--no-auto-compile -e main -L "@GUILE_SITE_DIR@" -C "@GUILE_SITE_CCACHE_DIR@" -L . -C . -s
|
||||
!#
|
||||
(define-module (gash)
|
||||
#:export (main))
|
||||
|
||||
(set! %load-path (append '("@GUILE_SITE_DIR@") %load-path))
|
||||
(set! %load-compiled-path (append '("@GUILE_SITE_CCACHE_DIR@") %load-compiled-path))
|
||||
;;; Gash --- Guile As SHell
|
||||
;;; Copyright © 2016,2017,2018 R.E.W. van Beusekom <rutger.van.beusekom@gmail.com>
|
||||
;;; 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/>.
|
||||
|
||||
(define (main args)
|
||||
(setenv "SHELL" ((compose canonicalize-path car command-line)))
|
||||
|
|
|
|||
29
bin/tar.in
29
bin/tar.in
|
|
@ -1,12 +1,23 @@
|
|||
#! /bin/sh
|
||||
# -*-scheme-*-
|
||||
exec ${GUILE-guile} -L $(dirname $0) -L $(dirname $(dirname $0)) -C $(dirname $0) -C $(dirname $(dirname $0)) --no-auto-compile -e '(tar)' -s $0 "$@"
|
||||
#! @GUILE@ \
|
||||
--no-auto-compile -e main -L "@GUILE_SITE_DIR@" -C "@GUILE_SITE_CCACHE_DIR@" -L . -C . -s
|
||||
!#
|
||||
(define-module (tar)
|
||||
#:export (main))
|
||||
|
||||
(set! %load-path (append '("@GUILE_SITE_DIR@") %load-path))
|
||||
(set! %load-compiled-path (append '("@GUILE_SITE_CCACHE_DIR@") %load-compiled-path))
|
||||
;;; Gash --- Guile As SHell
|
||||
;;; 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/>.
|
||||
|
||||
(define (main args)
|
||||
((@ (gash tar) main) (command-line)))
|
||||
((@ (gash gash) main) (cons* (car (command-line)) "--" "tar" (cdr (command-line)))))
|
||||
|
|
|
|||
|
|
@ -33,6 +33,7 @@
|
|||
#:use-module (gash guix-build-utils)
|
||||
#:use-module (gash config)
|
||||
#:use-module (gash io)
|
||||
#:use-module (gash ustar)
|
||||
#:use-module (gash util)
|
||||
|
||||
#:export (
|
||||
|
|
@ -310,7 +311,7 @@ Options:
|
|||
(no-file-name (single-char #\h))
|
||||
(only-matching (single-char #\o))
|
||||
(version (single-char #\V))))
|
||||
(options (getopt-long (cons "ls" args) option-spec))
|
||||
(options (getopt-long (cons "grep" args) option-spec))
|
||||
(help? (option-ref options 'help #f))
|
||||
(version? (option-ref options 'version #f))
|
||||
(files (option-ref options '() '())))
|
||||
|
|
@ -363,6 +364,39 @@ Options:
|
|||
(for-each display-match matches)
|
||||
0)))))))))
|
||||
|
||||
(define (tar-command . args)
|
||||
(lambda _
|
||||
(let* ((option-spec
|
||||
'((create (single-char #\c))
|
||||
(extract (single-char #\x))
|
||||
(file (single-char #\f) (value #t))
|
||||
(help (single-char #\h))
|
||||
(version (single-char #\V))))
|
||||
(args (cons "tar" args))
|
||||
(options (getopt-long args option-spec))
|
||||
(create? (option-ref options 'create #f))
|
||||
(extract? (option-ref options 'extract #f))
|
||||
(file (option-ref options 'file "/dev/stdout"))
|
||||
(files (option-ref options '() '()))
|
||||
(help? (option-ref options 'help #f))
|
||||
(usage? (and (not help?) (not (or (and create? (pair? files)) extract?))))
|
||||
(version? (option-ref options 'version #f)))
|
||||
(cond ((or help? usage?) (format (if usage? (current-error-port) #t)
|
||||
"\
|
||||
Usage: tar [OPTION]... [FILE]...
|
||||
-c, --create create a new archive
|
||||
-f, --file=ARCHIVE use archive file or device ARCHIVE
|
||||
-h, --help display this help
|
||||
-V, --version display version
|
||||
-x, --extract extract files from an archive
|
||||
")
|
||||
(exit (if usage? 2 0)))
|
||||
(version? (format #t "tar (GASH) ~a\n" %version) (exit 0))
|
||||
(create?
|
||||
(write-ustar-archive file files))
|
||||
(extract?
|
||||
(read-ustar-archive file files))))))
|
||||
|
||||
(define %bournish-commands
|
||||
`(
|
||||
("cat" . ,cat-command)
|
||||
|
|
@ -371,6 +405,7 @@ Options:
|
|||
("grep" . ,grep-command)
|
||||
("ls" . ,ls-command)
|
||||
("reboot" . ,reboot-command)
|
||||
("tar" . ,tar-command)
|
||||
("wc" . ,wc-command)
|
||||
("which" . ,which-command)
|
||||
))
|
||||
|
|
|
|||
|
|
@ -15,6 +15,8 @@
|
|||
#:use-module (ice-9 regex)
|
||||
|
||||
#:use-module (gash config)
|
||||
#:use-module (gash builtins)
|
||||
#:use-module (gash bournish-commands)
|
||||
#:use-module (gash environment)
|
||||
#:use-module (gash job)
|
||||
#:use-module (gash pipe)
|
||||
|
|
@ -46,8 +48,11 @@
|
|||
(call-with-input-file file-name parse))
|
||||
|
||||
(define (display-help)
|
||||
(display "\
|
||||
(let ((builtins (sort (map car (append %bournish-commands ;;%builtin-commands
|
||||
)) string<)))
|
||||
(display (string-append "\
|
||||
Usage: gash [OPTION]... [FILE]...
|
||||
or gash [OPTION]... -- BUILTIN [ARG]...
|
||||
|
||||
Options:
|
||||
-c, --command=STRING Evaluate STRING and exit
|
||||
|
|
@ -59,7 +64,10 @@ Options:
|
|||
--prefer-builtins Use builtins, even if command is available in PATH
|
||||
-v, --version Display the version
|
||||
-x, --xtrace Print simple command trace
|
||||
"))
|
||||
|
||||
Builtins:
|
||||
" (string-join builtins) "
|
||||
"))))
|
||||
|
||||
(define (display-version)
|
||||
(display (string-append "
|
||||
|
|
@ -86,7 +94,9 @@ copyleft.
|
|||
(geesh (single-char #\g))
|
||||
(version (single-char #\v))
|
||||
(xtrace (single-char #\x))))
|
||||
(options (getopt-long args option-spec #:stop-at-first-non-option #t ))
|
||||
(builtin-command-line (and=> (member "--" args) cdr))
|
||||
(args (take-while (negate (cut equal? <> "--")) args))
|
||||
(options (getopt-long args option-spec #:stop-at-first-non-option #t))
|
||||
(command? (option-ref options 'command #f))
|
||||
(opt? (lambda (name) (lambda (o) (and (eq? (car o) name) (cdr o)))))
|
||||
(debug (length (filter-map (opt? 'debug) options)))
|
||||
|
|
@ -113,6 +123,11 @@ copyleft.
|
|||
(if parse? (map pretty-print asts)
|
||||
(for-each run asts))
|
||||
(exit (script-status))))
|
||||
(builtin-command-line
|
||||
(let* ((builtin (car builtin-command-line))
|
||||
(args (cdr builtin-command-line))
|
||||
(command (assoc-ref %bournish-commands builtin)))
|
||||
((apply command args))))
|
||||
(#t (let* ((HOME (string-append (getenv "HOME") "/.gash_history"))
|
||||
(thunk (lambda ()
|
||||
(let loop ((line (readline (prompt))))
|
||||
|
|
|
|||
66
gash/tar.scm
66
gash/tar.scm
|
|
@ -1,66 +0,0 @@
|
|||
;;; Gash --- Guile As SHell
|
||||
;;; 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/>.
|
||||
|
||||
(define-module (gash tar)
|
||||
#:use-module (ice-9 getopt-long)
|
||||
#:use-module (gash config)
|
||||
#:use-module (gash ustar)
|
||||
#:export (main))
|
||||
|
||||
(define (parse-opts args)
|
||||
(let* ((option-spec
|
||||
'((create (single-char #\c))
|
||||
(extract (single-char #\x))
|
||||
(file (single-char #\f) (value #t))
|
||||
(help (single-char #\h))
|
||||
(version (single-char #\V))))
|
||||
(options (getopt-long args option-spec))
|
||||
(create? (option-ref options 'create #f))
|
||||
(extract? (option-ref options 'extract #f))
|
||||
(help? (option-ref options 'help #f))
|
||||
(files (option-ref options '() '()))
|
||||
(usage? (and (not help?) (not (or (and create? (pair? files)) extract?))))
|
||||
(version? (option-ref options 'version #f)))
|
||||
|
||||
(or
|
||||
(and version?
|
||||
(format #t "tar (GASH) ~a\n" %version)
|
||||
(exit 0))
|
||||
(and (or help? usage?)
|
||||
(format (or (and usage? (current-error-port)) (current-output-port))
|
||||
(string-append "\
|
||||
Usage: tar [OPTION]... [FILE]...
|
||||
-c, --create create a new archive
|
||||
-e, --extract extract files from an archive
|
||||
-f, --file=ARCHIVE use archive file or device ARCHIVE
|
||||
-h, --help display this help
|
||||
-V, --version display version
|
||||
"))
|
||||
(exit (or (and usage? 2) 0)))
|
||||
options)))
|
||||
|
||||
(define (main args)
|
||||
(let* ((options (parse-opts args))
|
||||
(create? (option-ref options 'create #f))
|
||||
(extract? (option-ref options 'extract #f))
|
||||
(file (option-ref options 'file "/dev/stdout"))
|
||||
(files (option-ref options '() '())))
|
||||
(cond (create?
|
||||
(write-ustar-archive file files))
|
||||
(extract?
|
||||
(read-ustar-archive file files)))))
|
||||
Loading…
Reference in New Issue