Changeset 9770 for lang/scheme

Timestamp:

04/18/08 23:36:02 (8 months ago)

Author:

hayamiz

Message:

gauche-shell: implemented foundation for shell script

Location:

lang/scheme/gauche-shell/trunk

Files:

• goshell (added)
• shell.scm (modified) (1 diff)

lang/scheme/gauche-shell/trunk/shell.scm

@@ -7 +7 @@
 
 (use srfi-1)
+(use srfi-13)
 (use file.util)
 (use gauche.collection)
 (use gauche.process)
-(export pwd ls
-        $ command)
+(use gauche.interactive)
+(export pwd ls echo
+        $ command c
+        define-command define-commands
+        rehash
+        )
 
-
-
-(define pwd current-directory)
 (define-macro ($ arg)
   `(sys-getenv 
-    ,(cond
-      ((string? arg) arg)
-      ((symbol? arg) (symbol->string arg))
-      ((number? arg) (number->string arg))
-      (else (x->string arg)))))
+     ,(string-upcase 
+       (cond
+        ((string? arg) arg)
+        ((symbol? arg) (symbol->string arg))
+        ((number? arg) (number->string arg))
+        (else (x->string arg))))))
 
-(define (ls . rest)
-  (remove #/^\.{1,2}$/
-          (if (null? rest)
-              (directory-list (pwd))
-              (apply directory-list rest))))
+(define-macro (define-command command)
+  `(define-macro (,command . args)
+     (cons 'command
+           (cons ',command
+                 args))))
+(define-macro (define-commands . commands)
+  `(begin
+     ,@(map (lambda (command)
+              `(define-command ,command))
+            commands)))
 
 (define-macro (command com . args)
-  `(process-output->string-list
-    '(,(x->string com)
-      ,@(map x->string args))))
+  (if (not (or (symbol? com) (string? com) (keyword? com)))
+      (error "Command name must be a symbol, a string, or a keyword.")
+      `(c (cons ,(x->string com)
+                (map x->string
+                     (list ,@(map (lambda (arg)
+                                    (if (symbol? arg)
+                                        (symbol->string arg)
+                                        arg))
+                                  args)))))))
+
+(define (c command)
+  (process-output->string-list command :on-abnormal-exit :ignore))
+
+(define-macro (rehash)
+  (let* ((pathes (string-split ($ PATH) ":"))
+         (commands (map
+                    string->symbol
+                    (apply
+                     append
+                     (map (lambda (path) (c `(ls ,path)))
+                          (filter file-exists? pathes))))))
+    `(begin
+       ,@(map (lambda (command)
+                `(define-command ,command))
+              commands)
+       (export ,@commands))))
 
 (provide "shell")