X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=src%2Fos.lisp;h=6d412a756b03467507cddb9518594d4c4b209b37;hb=HEAD;hp=075be960a80da83749c49669fdaa04fb3c23758d;hpb=1eef42e18bc87785aec91ce4710085d30898b160;p=uffi.git diff --git a/src/os.lisp b/src/os.lisp index 075be96..6d412a7 100644 --- a/src/os.lisp +++ b/src/os.lisp @@ -5,11 +5,9 @@ ;;;; Name: os.lisp ;;;; Purpose: Operating system interface for UFFI ;;;; Programmer: Kevin M. Rosenberg -;;;; Date Started: Sep 2002 +;;;; Date Started: Sep 2002 ;;;; -;;;; $Id$ -;;;; -;;;; This file, part of UFFI, is Copyright (c) 2002-2005 by Kevin M. Rosenberg. +;;;; This file, part of UFFI, is Copyright (c) 2002-2010 by Kevin M. Rosenberg. ;;;; ;;;; ************************************************************************* @@ -25,26 +23,11 @@ #+gcl (si:getenv (string var)) #+lispworks (lw:environment-variable (string var)) #+lucid (lcl:environment-variable (string var)) - #+mcl (ccl::getenv var) + #+(or openmcl digitool) (ccl::getenv var) #+sbcl (sb-ext:posix-getenv var) - #-(or allegro clisp cmu gcl lispworks lucid mcl sbcl) + #-(or allegro clisp cmu gcl lispworks lucid openmcl digitool sbcl) (error 'not-implemented :proc (list 'getenv var))) -(defun (setf getenv) (val var) - "Set an environment variable." - #+allegro (setf (sys::getenv (string var)) (string val)) - #+clisp (setf (sys::getenv (string var)) (string val)) - #+cmu (let ((cell (assoc (string var) ext:*environment-list* :test #'equalp - :key #'string))) - (if cell - (setf (cdr cell) (string val)) - (push (cons (intern (string var) "KEYWORD") (string val)) ext:*environment-list*))) - #+gcl (si:setenv (string var) (string val)) - #+lispworks (setf (lw:environment-variable (string var)) (string val)) - #+lucid (setf (lcl:environment-variable (string var)) (string val)) - #-(or allegro clisp cmu gcl lispworks lucid) - (error 'not-implemented :proc (list '(setf getenv) var))) - ;; modified from function ASDF -- Copyright Dan Barlow and Contributors @@ -58,37 +41,37 @@ output to *trace-output*. Returns the shell's exit code." (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 + + #+clisp ;XXX not exactly *trace-output*, I know (ext:run-shell-command command :output :terminal :wait t) #+openmcl (nth-value 1 - (ccl:external-process-status - (ccl:run-program "/bin/sh" (list "-c" command) - :input nil :output output - :wait t))) + (ccl:external-process-status + (ccl:run-program "/bin/sh" (list "-c" command) + :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.") ))