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

;; -*- coding: utf-8 mode: scheme -*-

;;; This is a library to write a shell script with gauche.

(define-module shell)
(select-module shell)

(use srfi-1)
(use srfi-13)
(use file.util)
(use gauche.collection)
(use gauche.process)
(use gauche.interactive)
(export pwd ls echo
        $ command c
        define-command define-commands
        rehash
        )

(define-macro ($ arg)
  `(sys-getenv 
     ,(string-upcase 
       (cond
        ((string? arg) arg)
        ((symbol? arg) (symbol->string arg))
        ((number? arg) (number->string arg))
        (else (x->string arg))))))

(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)
  (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")