builtins: ls: Support -a,--all,-1,--one-file-per-line,-h,--version.
* gash/bournish-commands.scm (ls-command-implementation): Support -a,--all,-1,--one-file-per-line,-h,--version.
This commit is contained in:
Jan Nieuwenhuizen
parent
512b848b11
commit
40aa82fca9
|
|
@ -20,13 +20,18 @@
|
|||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
(define-module (gash bournish-commands)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (ice-9 getopt-long)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 rdelim)
|
||||
#:use-module (ice-9 regex)
|
||||
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
|
||||
#:use-module (gash guix-build-utils)
|
||||
#:use-module (gash config)
|
||||
#:use-module (gash io)
|
||||
#:export (
|
||||
display-tabulated
|
||||
|
|
@ -94,37 +99,69 @@ TERMINAL-WIDTH. Use COLUMN-GAP spaces between two subsequent columns."
|
|||
(newline)
|
||||
(loop (map 1+ indexes)))))
|
||||
|
||||
(cond-expand
|
||||
(guile
|
||||
;; Support -1, see https://lists.gnu.org/archive/html/bug-guile/2018-07/msg00009.html
|
||||
(module-define! (resolve-module '(ice-9 getopt-long)) 'short-opt-rx (make-regexp "^-([a-zA-Z0-9]+)(.*)")))
|
||||
(else))
|
||||
|
||||
(define ls-command-implementation
|
||||
;; Run-time support procedure.
|
||||
(case-lambda
|
||||
(()
|
||||
(display-tabulated (scandir ".")))
|
||||
(files
|
||||
(let ((files (append-map (lambda (file)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(match (stat:type (lstat file))
|
||||
('directory
|
||||
;; Like GNU ls, list the contents of
|
||||
;; FILE rather than FILE itself.
|
||||
(match (scandir file
|
||||
(match-lambda
|
||||
((or "." "..") #f)
|
||||
(_ #t)))
|
||||
(#f
|
||||
(list file))
|
||||
((files ...)
|
||||
(map (cut string-append file "/" <>)
|
||||
files))))
|
||||
(_
|
||||
(list file))))
|
||||
(lambda args
|
||||
(let ((errno (system-error-errno args)))
|
||||
(format (current-error-port) "~a: ~a~%"
|
||||
file (strerror errno))
|
||||
'()))))
|
||||
files)))
|
||||
(display-tabulated files)))))
|
||||
(args
|
||||
(format (current-error-port) "hiero:args=~s\n" args)
|
||||
(let* ((option-spec
|
||||
'((all (single-char #\a))
|
||||
(help)
|
||||
(one-file-per-line (single-char #\1))
|
||||
(version)))
|
||||
(options (getopt-long (cons "ls" args) option-spec))
|
||||
(all? (option-ref options 'all #f))
|
||||
(help? (option-ref options 'help #f))
|
||||
(one-file-per-line? (option-ref options 'one-file-per-line #f))
|
||||
(version? (option-ref options 'version #f))
|
||||
(files (option-ref options '() '())))
|
||||
(cond (help? (display "Usage: ls [OPTION]... [FILE]...
|
||||
|
||||
Options:
|
||||
-a, --all do not ignore entries starting with .
|
||||
-1 list one file per line
|
||||
--help display this help and exit
|
||||
--version display version information and exit
|
||||
"))
|
||||
(version? (format #t "ls (GASH) ~a\n" %version))
|
||||
(else
|
||||
(let* ((files (if (null? files) (scandir ".")
|
||||
(append-map (lambda (file)
|
||||
(catch 'system-error
|
||||
(lambda ()
|
||||
(match (stat:type (lstat file))
|
||||
('directory
|
||||
;; Like GNU ls, list the contents of
|
||||
;; FILE rather than FILE itself.
|
||||
(match (scandir file
|
||||
(match-lambda
|
||||
((or "." "..") #f)
|
||||
(_ #t)))
|
||||
(#f
|
||||
(list file))
|
||||
((files ...)
|
||||
(map (cut string-append file "/" <>)
|
||||
files))))
|
||||
(_
|
||||
(list file))))
|
||||
(lambda args
|
||||
(let ((errno (system-error-errno args)))
|
||||
(format (current-error-port) "~a: ~a~%"
|
||||
file (strerror errno))
|
||||
'()))))
|
||||
files)))
|
||||
(files (if all? files
|
||||
(filter (negate (cut string-prefix? "." <>)) files))))
|
||||
(if one-file-per-line? (for-each stdout files)
|
||||
(display-tabulated files)))))))))
|
||||
|
||||
(define ls-command (wrap-command ls-command-implementation "ls"))
|
||||
|
||||
|
|
|
|||
|
|
@ -1,3 +1,21 @@
|
|||
;;; 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 builtins)
|
||||
#:use-module (ice-9 match)
|
||||
|
||||
|
|
@ -5,6 +23,7 @@
|
|||
#:use-module (srfi srfi-26)
|
||||
|
||||
#:use-module (gash bournish-commands)
|
||||
#:use-module (gash config)
|
||||
#:use-module (gash gash)
|
||||
#:use-module (gash job)
|
||||
#:use-module (gash peg)
|
||||
|
|
|
|||
|
|
@ -14,6 +14,7 @@
|
|||
#:use-module (ice-9 receive)
|
||||
#:use-module (ice-9 regex)
|
||||
|
||||
#:use-module (gash config)
|
||||
#:use-module (gash job)
|
||||
#:use-module (gash pipe)
|
||||
#:use-module (gash peg)
|
||||
|
|
@ -68,8 +69,8 @@ gash [options]
|
|||
"))
|
||||
|
||||
(define (display-version)
|
||||
(display "
|
||||
GASH 0.1
|
||||
(display (string-append "
|
||||
GASH " %version "
|
||||
|
||||
Copryright (C) 2016,2017,2018 R.E.W. van Beusekom, rutger.van.beusekom@gmail.com.
|
||||
|
||||
|
|
@ -77,7 +78,7 @@ This is gash, Guile As SHell. Gash is free software and is covered by
|
|||
the GNU General Public License version 3 or later, see COPYING for the
|
||||
copyleft.
|
||||
|
||||
"))
|
||||
")))
|
||||
|
||||
(define (main args)
|
||||
(let ((thunk
|
||||
|
|
|
|||
Loading…
Reference in New Issue