[Cl-darcs-cvs] r47 - cl-darcs/trunk

[mhenoch at common-lisp.net]

Author: mhenoch
Date: Fri Oct  6 15:49:24 2006
New Revision: 47

Modified:
   cl-darcs/trunk/util.lisp
Log:
Add compress-file function


Modified: cl-darcs/trunk/util.lisp
==============================================================================
--- cl-darcs/trunk/util.lisp	(original)
+++ cl-darcs/trunk/util.lisp	Fri Oct  6 15:49:24 2006
@@ -140,6 +140,20 @@
 	 (util.zip:inflate in out)
 	 (dformat "done"))))))
 
+(defun compress-file (infile outfile)
+  "Compress INFILE and write contents to OUTFILE."
+  (setf infile (make-upath infile))
+  (cond
+    #+clisp
+    ((pathnamep infile)
+     (dformat "~&Compressing ~A through external program..." outfile)
+     (ext:run-program "gzip" :input (namestring infile) :output (namestring outfile)
+		      :if-output-exists :error)
+     (dformat "done"))
+    (t
+     (cerror "Assume compression performed."
+	     "Don't know how to gzip ~A to ~A." infile outfile))))
+
 (defun make-temp-file-name ()
   "Create a random name for a temporary file.
 This is hopefully random enough to avoid problems."