os.lisp

   1 ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:          os.lisp
   6 ;;;; Purpose:       Operating System utilities
   7 ;;;; Programmer:    Kevin M. Rosenberg
   8 ;;;; Date Started:  Jul 2003
   9 ;;;;
  10 ;;;; $Id: os.lisp,v 1.1 2003/07/23 22:08:21 kevin Exp $
  11 ;;;;
  12 ;;;; *************************************************************************
  13
  14 (in-package #:kmrcl)
  15
  16 (defun run-shell-command (control-string &rest args)
  17   "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
  18 synchronously execute the result using a Bourne-compatible shell,
  19 returns (VALUES string-output exit-code)"
  20   (let ((command (apply #'format nil control-string args)))
  21     #+sbcl
  22     (sb-impl::process-exit-code
  23      (sb-ext:run-program
  24       "/bin/sh"
  25       (list  "-c" command)
  26       :input nil :output nil))
  27
  28     #+(or cmu scl)
  29     (ext:process-exit-code
  30      (ext:run-program
  31       "/bin/sh"
  32       (list  "-c" command)
  33       :input nil :output nil))
  34
  35     #+allegro
  36     (multiple-value-bind (output dummy exit)
  37         (excl:run-shell-command command :input nil :output :stream
  38                                 :wait nil)
  39       (declare (ignore dummy))
  40       (values output exit))
  41
  42     #+lispworks
  43     (system:call-system-showing-output
  44      command
  45      :shell-type "/bin/sh"
  46      :output-stream output)
  47
  48     #+clisp             ;XXX not exactly *verbose-out*, I know
  49     (ext:run-shell-command  command :output :terminal :wait t)
  50
  51     #+openmcl
  52     (nth-value 1
  53                (ccl:external-process-status
  54                 (ccl:run-program "/bin/sh" (list "-c" command)
  55                                  :input nil :output nil
  56                                  :wait t)))
  57
  58     #-(or openmcl clisp lispworks allegro scl cmu sbcl)
  59     (error "RUN-SHELL-PROGRAM not implemented for this Lisp")
  60
  61     ))