scsh-conservatory
/
commander-s
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Ensure $,~, and globs are expanded for all cases

This commit is contained in:
mainzelm 2006-04-06 16:26:53 +00:00
parent 52f8656ee2
commit f994674432
1 changed files with 30 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

46
scheme/std-command.scm
View File

@ -55,27 +55,33 @@
=> lookup-env-var) => lookup-env-var)
(else str))) (else str)))
(define (expand-filename-string s)
(resolve-file-name (substitute-env-vars s)))
(define (expand-string/s-expr v) (define (expand-string/s-expr v)
(if (string? v) (if (string? v)
(substitute-env-vars v) (expand-filename-string v)
v)) v))
(define (expand/glob-arguments args)
(fold-right
(lambda (arg args)
(let ((expanded (expand-string/s-expr arg)))
(if (and (string? expanded) (contains-glob-expression? expanded))
(append (glob-argument expanded) args)
(cons expanded args))))
'() args))
(define (expand-redirection redirection) (define (expand-redirection redirection)
(make-redirection (make-redirection
(redirection-op redirection) (redirection-op redirection)
(expand-string/s-expr (redirection-dest redirection)))) (expand-string/s-expr (redirection-dest redirection))))
(define (expand-command command) (define (expand-command command)
(let ((expanded (map expand-string/s-expr (command-args command))))
(make-command (make-command
(expand-string/s-expr (command-executable command)) (expand-string/s-expr (command-executable command))
(fold-right (expand/glob-arguments (command-args command))
(lambda (arg args) (map expand-redirection (command-redirections command))))
(if (and (string? arg) (contains-glob-expression? arg))
(append (glob-argument arg) args)
(cons arg args)))
'() expanded)
(map expand-redirection (command-redirections command)))))
(define (expand-command-line command-line) (define (expand-command-line command-line)
(make-command-line (make-command-line
@ -111,11 +117,11 @@
(define just-run-in-foreground (define just-run-in-foreground
(lambda (command args) (lambda (command args)
(run/fg* `(exec-epf (,command ,@args))))) (run/fg* `(exec-epf (,command ,@(expand/glob-arguments args))))))
(define just-run-in-background (define just-run-in-background
(lambda (command args) (lambda (command args)
(run/bg* `(exec-epf (,command ,@args))))) (run/bg* `(exec-epf (,command ,@(expand/glob-arguments args))))))
;; Parse options for ls command using args-fold (SRFI 37) ;; Parse options for ls command using args-fold (SRFI 37)
;; We don't care for options that format the output. ;; We don't care for options that format the output.
@ -184,7 +190,7 @@
reverse reverse
(lambda (l) l))) (lambda (l) l)))
(paths (if (null? paths) (paths (if (null? paths)
(list (cwd)) (list (file-name-as-directory (cwd)))
paths))) paths)))
(reverse (reverse
(sort (sort
@ -194,7 +200,7 @@
(if (file-directory? path) (if (file-directory? path)
(directory-files path (set? 'dot-files?)) (directory-files path (set? 'dot-files?))
(list (file-name->fs-object path)))) (list (file-name->fs-object path))))
paths))))))))) (expand/glob-arguments paths))))))))))
(register-plugin! (register-plugin!
(make-command-plugin "ps" (make-command-plugin "ps"
@ -225,12 +231,16 @@
(lambda () (lambda ()
(and (file-directory? file) (and (file-directory? file)
(file-name-as-directory file))))))) (file-name-as-directory file)))))))
(or (to-complete-prefix to-complete) (cwd)))) (or (to-complete-prefix to-complete) (file-name-as-directory (cwd)))))
(lambda (command args) (lambda (command args)
(chdir (resolve-file-name (if (null? args) (let* ((exp-args (expand/glob-arguments args))
"~" (arg (if (null? exp-args)
(car args)))) (getenv "HOME")
(cwd)))) (if (null? (cdr exp-args))
(car exp-args)
(error "too many arguments to cd" exp-args)))))
(chdir arg)
(cwd)))))
(register-plugin! (register-plugin!
(make-command-plugin "setenv" (make-command-plugin "setenv"