X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fos.lisp;h=bd95f05385db385547ab0551ec6662b712f4126c;hb=c4533c02d3f2ebd53178c93de2dee09ca39fe0e7;hp=f9cc31f0a31dea5ffe6a3180440500374f519370;hpb=c6c305a69913c148753813cc057be7127017ae6a;p=uffi.git diff --git a/src/os.lisp b/src/os.lisp index f9cc31f..bd95f05 100644 --- a/src/os.lisp +++ b/src/os.lisp @@ -2,57 +2,68 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: os.cl +;;;; Name: os.lisp ;;;; Purpose: Operating system interface for UFFI ;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Sep 2002 +;;;; 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) -;; Take from ASDF -- Copyright Dan Barlow and Contributors +(defun getenv (var) + "Return the value of the environment variable." + #+allegro (sys::getenv (string var)) + #+clisp (sys::getenv (string var)) + #+cmu (cdr (assoc (string var) ext:*environment-list* :test #'equalp + :key #'string)) + #+gcl (si:getenv (string var)) + #+lispworks (lw:environment-variable (string var)) + #+lucid (lcl:environment-variable (string var)) + #+mcl (ccl::getenv var) + #+sbcl (sb-ext:posix-getenv var) + #-(or allegro clisp cmu gcl lispworks lucid mcl sbcl) + (error 'not-implemented :proc (list 'getenv var))) -(defun run-shell-command (control-string &rest args) + +;; modified from function ASDF -- Copyright Dan Barlow and Contributors + +(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 + (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 + (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,9 +71,9 @@ 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) - (error "RUN-SHELL-PROGRAM not implemented for this Lisp") + (error "RUN-SHELL-PROGRAM not implemented for this Lisp.") ))