real-copy-file;real-move-file;copy-stream

flan-utils.lisp

@@ -1,6 +1,8 @@
 ;;;; utils.lisp -- some random utils I collect. might be useful, probably won't be.
 
-(defpackage :flan-utils (:use :cl))
+(defpackage :flan-utils
+  (:use :cl)
+  (:nicknames :fu))
 (in-package :flan-utils)
 
 (defmacro export* (&rest syms)
@@ -37,8 +39,28 @@
 
 (defexport
 
+    
 ;;; --- actual (exported) code goes here --
 
+    
+(defun copy-stream (from to &key (buffer-size 4096))
+  "Block copy byte streams"
+  (let ((buffer (make-array buffer-size :element-type '(unsigned-byte 8))))
+    (loop for bytes-read = (read-sequence buffer from)
+       while (plusp bytes-read)
+       do (write-sequence buffer to :end bytes-read))))
+
+(defun real-copy-file (from to)
+  "Copy a file"
+  (with-open-file (from from :direction :input :element-type '(unsigned-byte 8))
+    (with-open-file (to to :direction :output :if-exists :supersede :element-type '(unsigned-byte 8))
+      (copy-stream from to))))
+
+(defun real-move-file (from to)
+  "Actually move a file"
+  (real-copy-file from to)
+  (delete-file from))
+    
 (defmacro errors (stmt)
   `(let ((ret (handler-case (cons ,stmt nil)
 	       (t (c) (cons nil c)))))
@@ -448,13 +470,15 @@
 
 ; --- reader macros
 
-(defun sexpr-reader (stream char &key (func 'val))
+(defun sexpr-reader (stream char &key (func 'val) (unset t) (keep-char t))
   "Read next token only if S expression, else return as is"
   (if (char= (peek-char t stream t nil t) #\()
     (values (funcall func (read stream t nil t)) t)
     (let ((*readtable* (copy-readtable)))
-      (set-macro-character char nil)
+      (and unset (set-macro-character char nil))
-      (values (read-from-string (strcat (string char) (write-to-string (read stream t nil t)))) nil))))
+      (if keep-char
+	  (values (read-from-string (strcat (string char) (write-to-string (read stream t nil t)))) nil)
+	  (values (read stream t nil t) nil)))))
 
 (defun not-reader (stream char)
   (declare (ignore char))