X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fos.lisp;h=bd95f05385db385547ab0551ec6662b712f4126c;hb=c4533c02d3f2ebd53178c93de2dee09ca39fe0e7;hp=a1b7c87a15cd7edcda39028664839b85d8a3bbb0;hpb=28581147f39fc9f2db34286235e49d5095e4b29b;p=uffi.git diff --git a/src/os.lisp b/src/os.lisp index a1b7c87..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.3 2002/10/21 15:42:07 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) + + +(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))) ;; modified from function ASDF -- Copyright Dan Barlow and Contributors -(defun run-shell-command ((control-string &key (output *trace-output*)) - &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))) #+sbcl (sb-impl::process-exit-code - (sb-ext:run-program + (sb-ext:run-program "/bin/sh" (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 output)) #+allegro (excl:run-shell-command command :input nil :output output) - + #+lispworks (system:call-system-showing-output command :shell-type "/bin/sh" :output-stream output) - + #+clisp ;XXX not exactly *trace-output*, I know (ext:run-shell-command command :output :terminal :wait t) @@ -64,5 +75,5 @@ output to *trace-output*. Returns the shell's exit code." :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.") ))