Update of /project/elephant/cvsroot/elephant/src/utils In directory clnet:/tmp/cvs-serv697
Added Files: convenience.lisp os.lisp Log Message: Missing files from last checkin
--- /project/elephant/cvsroot/elephant/src/utils/convenience.lisp 2007/02/14 04:38:56 NONE +++ /project/elephant/cvsroot/elephant/src/utils/convenience.lisp 2007/02/14 04:38:56 1.1
;; Copyright Ian Eslick ;; License: LGPL ;; ;; A collection of handy utilities for compacting code complexity in elephant ;;
(in-package :elephant-utils)
(defmacro do-subsets ((subset subset-size list) &body body) "Look over subsets of the list" `(loop for ,subset in (subsets ,subset-size ,list) do ,@body))
(defun subsets (size list) "Generate subsets of size n from the list; the last subset has the remaining elements if size does not represent an equal division" (let ((subsets nil)) (loop for elt in list for i from 0 do (when (= 0 (mod i size)) (setf (car subsets) (nreverse (car subsets))) (push nil subsets)) (push elt (car subsets))) (setf (car subsets) (nreverse (car subsets))) (nreverse subsets)))
(defun remove-keywords (key-names args) (loop for ( name val ) on args by #'cddr unless (member name key-names) append (list name val)))
(defun concat-separated-strings (separator &rest lists) (format nil (concatenate 'string "~{~A~^" (string separator) "~}") (append-sublists lists)))
(defun append-sublists (list) "Takes a list of lists and appends all sublists" (let ((results (car list))) (dolist (elem (cdr list) results) (setq results (append results elem))))) --- /project/elephant/cvsroot/elephant/src/utils/os.lisp 2007/02/14 04:38:56 NONE +++ /project/elephant/cvsroot/elephant/src/utils/os.lisp 2007/02/14 04:38:56 1.1
(in-package :elephant-utils)
(defun launch-background-program (directory program &key (args nil)) "Launch a program in a specified directory - not all shell interfaces or OS's support this" #+(and allegro (not mswindows)) (excl:run-shell-command (concat-separated-strings " " (list program) args) :wait nil :directory directory) ;; #+(and allegro mswindows) ;; #+(and sbcl unix) ;; (sb-ext:start-process ... ;; #+(and openmcl unix) ;; #+lispworks )
(defun kill-background-program (pid) #+(and allegro (not mswindows)) (progn (excl.osi:kill pid 9) (system:reap-os-subprocess :pid pid)) ;; #+(and allegro mswindows) #+(and sbcl unix) (sb-ext:process-kill "/bin/kill" (list "-9" (format nil "~A" pid))) )