root/lang/scheme/gauche-shell/trunk/shell.scm @ 9770

Revision 9770, 1.5 kB (checked in by hayamiz, 6 years ago)

gauche-shell: implemented foundation for shell script

Line 
1;; -*- coding: utf-8 mode: scheme -*-
2
3;;; This is a library to write a shell script with gauche.
4
5(define-module shell)
6(select-module shell)
7
8(use srfi-1)
9(use srfi-13)
10(use file.util)
11(use gauche.collection)
12(use gauche.process)
13(use gauche.interactive)
14(export pwd ls echo
15        $ command c
16        define-command define-commands
17        rehash
18        )
19
20(define-macro ($ arg)
21  `(sys-getenv
22     ,(string-upcase
23       (cond
24        ((string? arg) arg)
25        ((symbol? arg) (symbol->string arg))
26        ((number? arg) (number->string arg))
27        (else (x->string arg))))))
28
29(define-macro (define-command command)
30  `(define-macro (,command . args)
31     (cons 'command
32           (cons ',command
33                 args))))
34(define-macro (define-commands . commands)
35  `(begin
36     ,@(map (lambda (command)
37              `(define-command ,command))
38            commands)))
39
40(define-macro (command com . args)
41  (if (not (or (symbol? com) (string? com) (keyword? com)))
42      (error "Command name must be a symbol, a string, or a keyword.")
43      `(c (cons ,(x->string com)
44                (map x->string
45                     (list ,@(map (lambda (arg)
46                                    (if (symbol? arg)
47                                        (symbol->string arg)
48                                        arg))
49                                  args)))))))
50
51(define (c command)
52  (process-output->string-list command :on-abnormal-exit :ignore))
53
54(define-macro (rehash)
55  (let* ((pathes (string-split ($ PATH) ":"))
56         (commands (map
57                    string->symbol
58                    (apply
59                     append
60                     (map (lambda (path) (c `(ls ,path)))
61                          (filter file-exists? pathes))))))
62    `(begin
63       ,@(map (lambda (command)
64                `(define-command ,command))
65              commands)
66       (export ,@commands))))
67
68(provide "shell")
Note: See TracBrowser for help on using the browser.