diff --git a/gash/builtins.scm b/gash/builtins.scm index 40d9e42..8b3b4e0 100644 --- a/gash/builtins.scm +++ b/gash/builtins.scm @@ -17,6 +17,7 @@ ;;; along with Gash. If not, see . (define-module (gash builtins) + #:use-module (ice-9 getopt-long) #:use-module (ice-9 match) #:use-module (srfi srfi-1) @@ -26,9 +27,9 @@ #:use-module (gash config) #:use-module (gash environment) #:use-module (gash gash) - #:use-module (gash job) + #:use-module (gash guix-build-utils) #:use-module (gash io) - ;;#:use-module (gash peg) + #:use-module (gash job) #:export ( %builtin-commands @@ -38,6 +39,7 @@ echo-command exit-command fg-command + find-command help-command pwd-command set-command @@ -108,6 +110,39 @@ mostly works, pipes work, some redirections work. (define cp-command (wrap-command cp-command-implementation "cp")) +(define find-command-implementation + ;; Run-time support procedure. + (case-lambda + (() + (find-command-implementation ".")) + (args + (let* ((option-spec + '((help) + (version))) + (options (getopt-long (cons "ls" args) option-spec)) + (help? (option-ref options 'help #f)) + (version? (option-ref options 'version #f)) + (files (option-ref options '() '())) + (files (if (null? files) '(".") files)) + (file (car files))) + (when (> (length files) 1) + (format (current-error-port) "find: too many FILEs: ~s\n" files) + (error "find failed")) + ;; TODO: find [OPTION]... [FILE]... [EXPRESSION]... + ;; and options: esp: -x, -L + (cond (help? (display "Usage: find [OPTION]... [FILE] + +Options: + --help display this help and exit + --version display version information and exit +")) + (version? (format #t "find (GASH) ~a\n" %version)) + (else + (let* ((files (find-files file #:directories? #t #:fail-on-error? #t))) + (for-each stdout files)))))))) + +(define find-command (wrap-command find-command-implementation "find")) + (define %builtin-commands `( ("bg" . ,bg-command) @@ -117,6 +152,7 @@ mostly works, pipes work, some redirections work. ("echo" . ,echo-command) ("exit" . ,exit-command) ("fg" . ,fg-command) + ("find" . ,find-command) ("help" . ,help-command) ("jobs" . ,jobs-command) ("ls" . ,ls-command) diff --git a/gash/guix-build-utils.scm b/gash/guix-build-utils.scm index 002e43b..b3637c1 100644 --- a/gash/guix-build-utils.scm +++ b/gash/guix-build-utils.scm @@ -27,7 +27,7 @@ ;; #:use-module (srfi srfi-34) ;; #:use-module (srfi srfi-35) ;; #:use-module (srfi srfi-60) - ;; #:use-module (ice-9 ftw) + #:use-module (ice-9 ftw) ;; #:use-module (ice-9 match) ;; #:use-module (ice-9 regex) ;; #:use-module (ice-9 rdelim) @@ -35,12 +35,69 @@ ;; #:use-module (ice-9 threads) #:use-module (rnrs bytevectors) #:use-module (rnrs io ports) - #:export (dump-port)) + #:export ( + dump-port + file-name-predicate + find-files + )) ;;; Commentary: ;;; This code is taken from (guix build utils) +;;; +;;; Directories. +;;; + +(define (file-name-predicate regexp) + "Return a predicate that returns true when passed a file name whose base +name matches REGEXP." + (let ((file-rx (if (regexp? regexp) + regexp + (make-regexp regexp)))) + (lambda (file stat) + (regexp-exec file-rx (basename file))))) + +(define* (find-files dir #:optional (pred (const #t)) + #:key (stat lstat) + directories? + fail-on-error?) + "Return the lexicographically sorted list of files under DIR for which PRED +returns true. PRED is passed two arguments: the absolute file name, and its +stat buffer; the default predicate always returns true. PRED can also be a +regular expression, in which case it is equivalent to (file-name-predicate +PRED). STAT is used to obtain file information; using 'lstat' means that +symlinks are not followed. If DIRECTORIES? is true, then directories will +also be included. If FAIL-ON-ERROR? is true, raise an exception upon error." + (let ((pred (if (procedure? pred) + pred + (file-name-predicate pred)))) + ;; Sort the result to get deterministic results. + (sort (file-system-fold (const #t) + (lambda (file stat result) ; leaf + (if (pred file stat) + (cons file result) + result)) + (lambda (dir stat result) ; down + (if (and directories? + (pred dir stat)) + (cons dir result) + result)) + (lambda (dir stat result) ; up + result) + (lambda (file stat result) ; skip + result) + (lambda (file stat errno result) + (format (current-error-port) "find-files: ~a: ~a~%" + file (strerror errno)) + (when fail-on-error? + (error "find-files failed")) + result) + '() + dir + stat) + string