picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

commit 715b6616050d8912627eb9b86fd878cdba882629
parent 241b60dd0d48f3898f3c4935fe232479db3b3f07
Author: Alexander Burger <abu@software-lab.de>
Date:   Tue, 25 Jun 2013 07:35:49 +0200

Added 'snapshot' function
Diffstat:
MCHANGES | 1+
Mlib/too.l | 44+++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 44 insertions(+), 1 deletion(-)

diff --git a/CHANGES b/CHANGES @@ -1,4 +1,5 @@ * DDjun13 picoLisp-3.1.3 + 'snapshot' in "lib/too.l" 'info' optional 'flg' argument '+Swap' relation prefix class Allow unlimited number of coroutines diff --git a/lib/too.l b/lib/too.l @@ -1,6 +1,48 @@ -# 01mar13abu +# 24jun13abu # (c) Software Lab. Alexander Burger +### Local Backup ### +(de snapshot (Dst Max . @) + (let I -1 + (while (info (pack Dst "." (inc 'I)))) + (while (>= (dec 'I) Max) + (call 'rm "-r" (pack Dst "." I)) ) + (while (ge0 I) + (call 'mv (pack Dst "." I) (pack Dst "." (inc I))) + (dec 'I) ) ) + (call 'mkdir (pack Dst ".0")) + (while (args) + (let + (Lst (filter bool (split (chop (next)) '/)) + Src (car Lst) + Old (pack Dst ".1/" Src) + New (pack Dst ".0/" Src) ) + (recur (Lst Src Old New) + (ifn (cdr Lst) + (recur (Src Old New) + (cond + ((=T (car (info Src T))) # Directory + (call 'mkdir "-p" New) + (for F (dir Src T) + (unless (member F '("." "..")) + (recurse + (pack Src '/ F) + (pack Old '/ F) + (pack New '/ F) ) ) ) + (call 'touch "-r" Src New) ) + ((= (info Src T) (info Old T)) # Same + `(if (== 64 64) + '(native "@" "link" 'I Old New) + '(call 'ln Old New) ) ) + (T (call 'cp "-dp" Src New)) ) ) # Changed or new + (call 'mkdir "-p" New) + (recurse + (cdr Lst) + (pack Src '/ (cadr Lst)) + (pack Old '/ (cadr Lst)) + (pack New '/ (cadr Lst)) ) + (call 'touch "-r" Src New) ) ) ) ) ) + ### DB Garbage Collection ### (de dbgc () (markExt *DB)