command, builtin, glob, echo cleanup and fixes
This commit is contained in:
parent
d065723221
commit
c32034d13d
|
@ -17,6 +17,7 @@
|
||||||
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
;;; along with Gash. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
(define-module (gash builtins)
|
(define-module (gash builtins)
|
||||||
|
#:use-module (ice-9 ftw)
|
||||||
#:use-module (ice-9 getopt-long)
|
#:use-module (ice-9 getopt-long)
|
||||||
#:use-module (ice-9 local-eval)
|
#:use-module (ice-9 local-eval)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
|
@ -35,6 +36,7 @@
|
||||||
#:use-module (gash io)
|
#:use-module (gash io)
|
||||||
#:use-module (gash job)
|
#:use-module (gash job)
|
||||||
#:use-module (gash pipe)
|
#:use-module (gash pipe)
|
||||||
|
#:use-module (gash util)
|
||||||
|
|
||||||
#:export (
|
#:export (
|
||||||
%builtin-commands
|
%builtin-commands
|
||||||
|
@ -74,8 +76,8 @@
|
||||||
(define (echo-command . args)
|
(define (echo-command . args)
|
||||||
(match args
|
(match args
|
||||||
(() (newline))
|
(() (newline))
|
||||||
(("-n" args ...) (map display args))
|
(("-n" args ...) (display (string-join args)))
|
||||||
(_ (map display args) (newline))))
|
(_ (display (string-join args)) (newline))))
|
||||||
|
|
||||||
(define (bg-command . args)
|
(define (bg-command . args)
|
||||||
(match args
|
(match args
|
||||||
|
@ -419,25 +421,21 @@ Options:
|
||||||
=>
|
=>
|
||||||
(lambda (command)
|
(lambda (command)
|
||||||
(if args
|
(if args
|
||||||
`(,apply ,command ',(map (cut local-eval <> (the-environment)) args))
|
(apply command (map (cut local-eval <> (the-environment)) args))
|
||||||
command)))
|
(command))))
|
||||||
(else #f)))))
|
(else #f)))))
|
||||||
|
|
||||||
(define (command . args)
|
(define (command . args)
|
||||||
(define (exec command)
|
(define (exec command)
|
||||||
(cond ((procedure? command) command)
|
(cond ((procedure? command) command)
|
||||||
((every string? command) (cut apply (compose status:exit-val system*) command))
|
|
||||||
;; not sure whether to do $?/PIPESTATUS here or in sh-exec
|
|
||||||
((every string? command)
|
((every string? command)
|
||||||
(cut apply (compose (lambda (status)
|
(let* ((program (car command))
|
||||||
((compose (cut assignment "?" <>) number->string) status)
|
(escape-builtin? (and (string? program) (string-prefix? "\\" program)))
|
||||||
status)
|
(program (if escape-builtin? (string-drop program 1) program))
|
||||||
(lambda (status)
|
(command (cons program (cdr command))))
|
||||||
(when (not (zero? status))
|
(or (builtin command #:prefer-builtin? (and %prefer-builtins?
|
||||||
(format (current-error-port) "*****gash: ~a: ~a" (car command) (strerror status)))
|
(not escape-builtin?)))
|
||||||
status)
|
(cut apply (compose status:exit-val system*) command))))
|
||||||
status:exit-val
|
|
||||||
system*) command))
|
|
||||||
(else (lambda () #t))))
|
(else (lambda () #t))))
|
||||||
(exec (append-map glob args)))
|
(exec (append-map glob args)))
|
||||||
|
|
||||||
|
@ -451,23 +449,24 @@ Options:
|
||||||
(make-regexp (string-append "^" pattern "$"))))
|
(make-regexp (string-append "^" pattern "$"))))
|
||||||
(define (glob-match regex path) ;; pattern path -> bool
|
(define (glob-match regex path) ;; pattern path -> bool
|
||||||
(regexp-match? (regexp-exec regex path)))
|
(regexp-match? (regexp-exec regex path)))
|
||||||
(define (glob- pattern paths)
|
(define (glob- pattern file-names)
|
||||||
(map (lambda (path)
|
(map (lambda (file-name)
|
||||||
(if (string-prefix? "./" path) (string-drop path 2) path))
|
(if (string-prefix? "./" file-name) (string-drop file-name 2) file-name))
|
||||||
(append-map (lambda (path)
|
(append-map (lambda (file-name)
|
||||||
(map (cute string-append (if (string=? "/" path) "" path) "/" <>)
|
(map (cut string-append (if (string=? "/" file-name) "" file-name) "/" <>)
|
||||||
(filter (conjoin (negate (cut string-prefix? "." <>))
|
(filter (conjoin (negate (cut string-prefix? "." <>))
|
||||||
(cute glob-match (glob2regex pattern) <>))
|
(cute glob-match (glob2regex pattern) <>))
|
||||||
(or (scandir path) '()))))
|
(or (scandir file-name) '()))))
|
||||||
paths)))
|
file-names)))
|
||||||
(cond
|
(cond
|
||||||
((not pattern) '(""))
|
((not pattern) '(""))
|
||||||
((glob? pattern) (let ((absolute? (string-prefix? "/" pattern)))
|
((glob? pattern) (let ((absolute? (string-prefix? "/" pattern)))
|
||||||
(let loop ((patterns (filter (negate string-null?) (string-split pattern #\/)))
|
(let loop ((patterns (filter (negate string-null?) (string-split pattern #\/)))
|
||||||
(paths (if absolute? '("/") '("."))))
|
(file-names (if absolute? '("/") '("."))))
|
||||||
(if (null? patterns)
|
(if (null? patterns)
|
||||||
paths
|
file-names
|
||||||
(loop (cdr patterns) (glob- (car patterns) paths))))))
|
(begin
|
||||||
|
(loop (cdr patterns) (glob- (car patterns) file-names)))))))
|
||||||
(#t (list pattern))))
|
(#t (list pattern))))
|
||||||
|
|
||||||
(define (singlequotes . o)
|
(define (singlequotes . o)
|
||||||
|
|
|
@ -145,42 +145,6 @@ copyleft.
|
||||||
(_ o))))
|
(_ o))))
|
||||||
(map expand- o))
|
(map expand- o))
|
||||||
|
|
||||||
|
|
||||||
;; TODO: add braces
|
|
||||||
(define (glob pattern) ;; pattern -> list of path
|
|
||||||
|
|
||||||
(define (glob? pattern)
|
|
||||||
(string-match "\\?|\\*" pattern))
|
|
||||||
|
|
||||||
(define (glob2regex pattern)
|
|
||||||
(let* ((pattern (regexp-substitute/global #f "\\." pattern 'pre "\\." 'post))
|
|
||||||
(pattern (regexp-substitute/global #f "\\?" pattern 'pre "." 'post))
|
|
||||||
(pattern (regexp-substitute/global #f "\\*" pattern 'pre ".*" 'post)))
|
|
||||||
(make-regexp (string-append "^" pattern "$"))))
|
|
||||||
|
|
||||||
(define (glob-match regex path) ;; pattern path -> bool
|
|
||||||
(regexp-match? (regexp-exec regex path)))
|
|
||||||
|
|
||||||
(define (glob- pattern paths)
|
|
||||||
(map (lambda (path)
|
|
||||||
(if (string-prefix? "./" path) (string-drop path 2) path))
|
|
||||||
(append-map (lambda (path)
|
|
||||||
(map (cute string-append (if (string=? "/" path) "" path) "/" <>)
|
|
||||||
(filter (conjoin (negate (cut string-prefix? "." <>))
|
|
||||||
(cute glob-match (glob2regex pattern) <>))
|
|
||||||
(or (scandir path) '()))))
|
|
||||||
paths)))
|
|
||||||
(cond
|
|
||||||
((not pattern) '(""))
|
|
||||||
((string-prefix? "$" pattern) (list (pk "get " pattern " => " (assoc-ref global-variables (string-drop pattern 1))))) ;; TODO: REMOVE ME
|
|
||||||
((glob? pattern) (let ((absolute? (string-prefix? "/" pattern)))
|
|
||||||
(let loop ((patterns (filter (negate string-null?) (string-split pattern #\/)))
|
|
||||||
(paths (if absolute? '("/") '("."))))
|
|
||||||
(if (null? patterns)
|
|
||||||
paths
|
|
||||||
(loop (cdr patterns) (glob- (car patterns) paths))))))
|
|
||||||
(#t (list pattern))))
|
|
||||||
|
|
||||||
(define (DEAD-background ast)
|
(define (DEAD-background ast)
|
||||||
(match ast
|
(match ast
|
||||||
(('pipeline fg rest ...) `(pipeline #f ,@rest))
|
(('pipeline fg rest ...) `(pipeline #f ,@rest))
|
||||||
|
|
13
gash/peg.scm
13
gash/peg.scm
|
@ -1,5 +1,4 @@
|
||||||
(define-module (gash peg)
|
(define-module (gash peg)
|
||||||
#:use-module (ice-9 ftw)
|
|
||||||
#:use-module (ice-9 local-eval)
|
#:use-module (ice-9 local-eval)
|
||||||
#:use-module (ice-9 match)
|
#:use-module (ice-9 match)
|
||||||
#:use-module (ice-9 pretty-print)
|
#:use-module (ice-9 pretty-print)
|
||||||
|
@ -15,7 +14,6 @@
|
||||||
#:use-module (gash gash)
|
#:use-module (gash gash)
|
||||||
#:use-module (gash io)
|
#:use-module (gash io)
|
||||||
#:use-module (gash job)
|
#:use-module (gash job)
|
||||||
#:use-module (gash util)
|
|
||||||
|
|
||||||
#:export (
|
#:export (
|
||||||
parse
|
parse
|
||||||
|
@ -211,16 +209,7 @@
|
||||||
(('substitution o) `(substitution ,@(transform o)))
|
(('substitution o) `(substitution ,@(transform o)))
|
||||||
(('pipeline o) (pk `(pipeline ,(transform o))))
|
(('pipeline o) (pk `(pipeline ,(transform o))))
|
||||||
(('pipeline h t) (pk `(pipeline ,(transform h) ,@(map transform t))))
|
(('pipeline h t) (pk `(pipeline ,(transform h) ,@(map transform t))))
|
||||||
(('command o ...) (let* ((command (map transform o))
|
(('command o ...) `(command ,@(map transform o)))
|
||||||
(program (car command))
|
|
||||||
(escape-builtin? (and (string? program) (string-prefix? "\\" program)))
|
|
||||||
(program (if escape-builtin? (string-drop program 1) program))
|
|
||||||
(command (cons program (cdr command))))
|
|
||||||
(when (> %debug-level 1)
|
|
||||||
(format (current-error-port) "transform command=~s\n" command))
|
|
||||||
(or (builtin command #:prefer-builtin? (and %prefer-builtins?
|
|
||||||
(not escape-builtin?)))
|
|
||||||
`(command ,@command))))
|
|
||||||
(('literal o) (transform o))
|
(('literal o) (transform o))
|
||||||
(('name o) o)
|
(('name o) o)
|
||||||
(('number o) o)
|
(('number o) o)
|
||||||
|
|
Loading…
Reference in New Issue