[elephant-cvs] CVS elephant/src/utils

[ieslick]

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
	, at 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)))
  )