~ chicken-core (chicken-5) f35831470b43c1211160acb34e5dd20f1d3d4713

commit f35831470b43c1211160acb34e5dd20f1d3d4713
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Fri May 13 08:14:41 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Fri May 13 08:14:41 2011 +0200

    added kon's egg-name reconstruction script (slightly modified)

diff --git a/distribution/manifest b/distribution/manifest
index 857d25d7..e81ead8a 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -281,6 +281,9 @@ types.db
 mac.r
 chicken.png
 CHICKEN.icns
+scripts/reconstruct-egg-name.scm
+scripts/mini-salmonella.scm
+scripts/make-wrapper.scm
 manual-html/Accessing external objects.html
 manual-html/Acknowledgements.html
 manual-html/Basic mode of operation.html
diff --git a/scripts/build-boot-chicken.sh b/scripts/build-boot-chicken.sh
deleted file mode 100644
index 124b9216..00000000
--- a/scripts/build-boot-chicken.sh
+++ /dev/null
@@ -1,46 +0,0 @@
-#!/bin/sh
-#
-# usage: build-boot-chicken.sh CHICKEN PLATFORM [ARCH]
-
-
-CHICKEN="$1"
-PLATFORM="$2"
-ARCH="$3"
-MAKE=make
-EXE=
-VERSION=`cat buildversion`
-FULLSTATIC=-static
-
-if test -z "${PLATFORM}${CHICKEN}"; then
-    echo "usage: build-boot-chicken.sh CHICKEN PLATFORM [ARCH]"
-    exit 1
-fi
-
-case `uname -s` in
-    *bsd*|*BSD*)
-	MAKE=gmake;;
-    MINGW*)
-	EXE=.exe;;
-    Darwin)
-	FULLSTATIC=;;
-esac
-
-BOOTCHICKEN=chicken-boot-${VERSION}-${PLATFORM}-${ARCH}${EXE}
-
-$MAKE -f Makefile.${PLATFORM} \
-  PLATFORM=${PLATFORM} ARCH=${ARCH} PREFIX=/nowhere STATICBUILD=1 \
-  PROGRAM_SUFFIX=-boot-1 CHICKEN=${CHICKEN} DEBUGBUILD=1 \
-  LINKER_OPTIONS=${FULLSTATIC} \
-  confclean clean chicken-boot-1${EXE}
-touch *.scm
-$MAKE -f Makefile.${PLATFORM} \
-  PLATFORM=${PLATFORM} ARCH=${ARCH} PREFIX=/nowhere STATICBUILD=1 \
-  PROGRAM_SUFFIX=-boot-2 CHICKEN=./chicken-boot-1${EXE} \
-  LINKER_OPTIONS=${FULLSTATIC} \
-  confclean chicken-boot-2${EXE}
-$MAKE -f Makefile.${PLATFORM} PLATFORM=${PLATFORM} confclean
-rm -f chicken-boot-1${EXE}
-
-strip chicken-boot-2${EXE}
-mv chicken-boot-2${EXE} ${BOOTCHICKEN}
-bzip2 ${BOOTCHICKEN}
diff --git a/scripts/reconstruct-egg-name.scm b/scripts/reconstruct-egg-name.scm
new file mode 100644
index 00000000..89dd7bd1
--- /dev/null
+++ b/scripts/reconstruct-egg-name.scm
@@ -0,0 +1,80 @@
+;;;; reconstruct-egg-name.scm - add "egg-name" infolist properties to all installed eggs
+;
+; by Kon Lovett
+; (minimally modified by felix)
+
+
+(use extras files posix srfi-1 miscmacros)
+
+;; Write the elements of the list `ls' to the output-port or output-file,
+;; using
+;; the `writer' procedure. `writer' is a (procedure (* output-port)).
+;;
+;; (add `newline?' param for write #\newline after every element?)
+(define (write-file ls #!optional (file-or-port (current-output-port)) (writer write))
+  (let ((port (if (port? file-or-port) file-or-port
+                (open-output-file file-or-port) ) ) )
+    (dynamic-wind
+      void
+      (lambda () (for-each (cut writer <> port) ls))
+      (lambda () (unless (port? file-or-port) (close-output-port port)))) )
+      )
+
+#;
+(define (write-file ls #!optional (file-or-port (current-output-port)) (writer write))
+  (let* ((port (if (port? file-or-port) file-or-port
+                 (open-output-file file-or-port) ) )
+         (closit (lambda () (unless (port? file-or-port) (close-output-port
+         port)))) )
+    (handle-exceptions exn
+        (begin (closit) (abort exn))
+      (for-each (cut writer <> port) ls))
+    (closit) ) )
+
+(define-constant +info-extn+ "setup-info")
+
+(define (info-filenames #!optional (dir (repository-path)))
+  (let ((cd (current-directory)))
+    (current-directory dir)
+    (begin0
+      (map pathname-file (glob (make-pathname '() "*" +info-extn+)))
+      (current-directory cd) ) ) )
+
+(define (get-info eggnam #!optional (dir (repository-path)))
+  (car (read-file (make-pathname dir eggnam +info-extn+))) )
+
+(define (put-info info eggnam #!optional (dir (repository-path)))
+  (let ((tmpfil (create-temporary-file)))
+    (write-file (list info) tmpfil)
+    (file-move tmpfil (make-pathname dir eggnam +info-extn+) #t) ) )
+
+(define (update-info info eggnam)
+  (if (assq 'egg-name info)
+      info
+      (cons
+       `(egg-name ,eggnam)
+       info)) )
+
+(define (update-info-file eggnam #!optional (dir (repository-path)))
+  (and-let* ((info (update-info (get-info eggnam dir) eggnam)))
+    (put-info info eggnam dir)
+    #t ) )
+
+(define (main svnroot)
+  (let ((eggdir svnroot)
+        (repdir (repository-path)) )
+    (newline)
+    (print "    Local SVN Repository: " eggdir)
+    (print "Installed Egg Repository: " repdir)
+    (newline)
+    (let* ((egdrnms (directory eggdir))
+           (siflnms (info-filenames repdir))
+           (eggnams (lset-intersection string=? egdrnms siflnms)) )
+    (for-each
+      (lambda (eggnam)
+        (print eggnam)
+        (unless (update-info-file eggnam)
+          (print "Warning: no version detected") ) )
+      eggnams ) ) ) )
+
+(apply main (command-line-arguments))