X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fos.lisp;h=bcbf65839c0b5a6e39aaab9c0e87714d1c492cc1;hb=3ade95bab16abe09642554e9cbf56f117f01e507;hp=f9cc31f0a31dea5ffe6a3180440500374f519370;hpb=c6c305a69913c148753813cc057be7127017ae6a;p=uffi.git diff --git a/src/os.lisp b/src/os.lisp index f9cc31f..bcbf658 100644 --- a/src/os.lisp +++ b/src/os.lisp @@ -2,56 +2,51 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: os.cl +;;;; Name: os.lisp ;;;; Purpose: Operating system interface for UFFI ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: Sep 2002 ;;;; -;;;; $Id: os.lisp,v 1.1 2002/10/14 01:51:15 kevin Exp $ +;;;; $Id$ ;;;; -;;;; This file, part of UFFI, is Copyright (c) 2002 by Kevin M. Rosenberg. -;;;; Much of this code was taken from other open source project and copyright -;;;; for that code is noted below where appropriate. +;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg. ;;;; -;;;; UFFI users are granted the rights to distribute and use this software -;;;; as governed by the terms of the Lisp Lesser GNU Public License -;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;;; ************************************************************************* -(declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(in-package :uffi) +(in-package #:uffi) +;; modified from function ASDF -- Copyright Dan Barlow and Contributors -;; Take from ASDF -- Copyright Dan Barlow and Contributors - -(defun run-shell-command (control-string &rest args) +(defun run-shell-command (control-string &rest args &key output) "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and synchronously execute the result using a Bourne-compatible shell, with output to *trace-output*. Returns the shell's exit code." + (unless output + (setq output *trace-output*)) + (let ((command (apply #'format nil control-string args))) - (format *trace-output* "; $ ~A~%" command) #+sbcl (sb-impl::process-exit-code (sb-ext:run-program "/bin/sh" - (list "-c" command) - :input nil :output *trace-output*)) + (list "-c" command) + :input nil :output output)) #+(or cmu scl) (ext:process-exit-code (ext:run-program "/bin/sh" - (list "-c" command) - :input nil :output *trace-output*)) + (list "-c" command) + :input nil :output output)) #+allegro - (excl:run-shell-command command :input nil :output *trace-output*) + (excl:run-shell-command command :input nil :output output) #+lispworks (system:call-system-showing-output command :shell-type "/bin/sh" - :output-stream *trace-output*) + :output-stream output) #+clisp ;XXX not exactly *trace-output*, I know (ext:run-shell-command command :output :terminal :wait t) @@ -60,7 +55,7 @@ output to *trace-output*. Returns the shell's exit code." (nth-value 1 (ccl:external-process-status (ccl:run-program "/bin/sh" (list "-c" command) - :input nil :output *trace-output* + :input nil :output output :wait t))) #-(or openmcl clisp lispworks allegro scl cmu sbcl)