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