~ chicken-core (chicken-5) a3388f627cda013b65f0387f87fa45455623fc1b

commit a3388f627cda013b65f0387f87fa45455623fc1b
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Feb 25 17:28:05 2010 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Feb 25 17:28:05 2010 +0100

    added -trunk mode to chicken-install (only for local transport), can be used by mini-salmonella

diff --git a/chicken-install.scm b/chicken-install.scm
index 61d8a7a2..8f55b1e8 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -85,6 +85,7 @@
   (define *running-test* #f)
   (define *mappings* '())
   (define *deploy* #f)
+  (define *trunk* #f)
 
   (define-constant +module-db+ "modules.db")
   (define-constant +defaults-file+ "setup.defaults")
@@ -214,6 +215,7 @@
          tests: *run-tests*
          username: *username*
          password: *password*
+	 trunk: *trunk*
 	 proxy-host: *proxy-host*
 	 proxy-port: *proxy-port*)
       [(exn net)
@@ -492,6 +494,7 @@ usage: chicken-install [OPTION | EXTENSION[:VERSION]] ...
   -u   -update-db               update export database
        -repository              print path used for egg installation
        -deploy                  build extensions for deployment
+       -trunk                   build trunk instead of tagged version (only local)
 EOF
 );|
     (exit code))
@@ -600,6 +603,9 @@ EOF
                         (unless (pair? (cdr args)) (usage 1))
                         (set! *username* (cadr args))
                         (loop (cddr args) eggs))
+		       ((string=? "-trunk" arg)
+			(set! *trunk* #t)
+			(loop (cdr args) eggs))
                        ((string=? "-password" arg)
                         (unless (pair? (cdr args)) (usage 1))
                         (set! *password* (cadr args))
diff --git a/runtime.c b/runtime.c
index 2c11d82a..b72d7bba 100644
--- a/runtime.c
+++ b/runtime.c
@@ -1374,7 +1374,7 @@ void usual_panic(C_char *msg)
 #endif
   } /* fall through if not WIN32 GUI app */
 
-  C_dbg("panic", C_text("\n%s - execution terminated\n\n%s"), msg, dmp);
+  C_dbg("panic", C_text("%s - execution terminated\n\n%s"), msg, dmp);
   C_exit(1);
 }
 
diff --git a/scripts/mini-salmonella.scm b/scripts/mini-salmonella.scm
index 568bd5f6..6c925125 100644
--- a/scripts/mini-salmonella.scm
+++ b/scripts/mini-salmonella.scm
@@ -86,16 +86,17 @@
 
 (define (install-egg egg dir)
   (let ((command
-	 (sprintf "~a ~a ~a ~a ~a"
-		  *chicken-install*
-		  (if *run-tests* "-test" "")
-		  (if *download* 
-		      ""
-		      (string-append "-t local -l " (normalize-pathname *eggdir*)))
-		  egg
-		  (if (not *debug*)
-		      (sprintf "2>~a >>~a.out" *tmplogfile* *logfile*)
-		      ""))))
+	 (conc
+	  *chicken-install* " "
+	  (if *run-tests* "-test " "")
+	  (if *trunk* "-trunk " "")
+	  (if *download* 
+	      ""
+	      (string-append "-t local -l " (normalize-pathname *eggdir*) " "))
+	  egg " "
+	  (if (not *debug*)
+	      (sprintf "2>~a >>~a.out" *tmplogfile* *logfile*)
+	      ""))))
     (when *debug*
       (print "  " command))
     (let ((status (system command)))
diff --git a/setup-download.scm b/setup-download.scm
index eec362b5..c0563cbe 100644
--- a/setup-download.scm
+++ b/setup-download.scm
@@ -48,6 +48,7 @@
 
   (define *quiet* #f)
   (define *chicken-install-user-agent* (conc "chicken-install " (chicken-version)))
+  (define *trunk* #f)
 
   (define (d fstr . args)
     (let ([port (if *quiet* (current-error-port) (current-output-port))])
@@ -80,7 +81,8 @@
   (define (locate-egg/local egg dir #!optional version destination)
     (let* ([eggdir (make-pathname dir egg)]
 	   [tagdir (make-pathname eggdir "tags")]
-           [tagver (and (file-exists? tagdir) (directory? tagdir)
+           [tagver (and (not *trunk*)
+			(file-exists? tagdir) (directory? tagdir)
                         (existing-version egg version (directory tagdir)) ) ] )
       (if tagver
           (values (make-pathname tagdir tagver) tagver)
@@ -289,8 +291,9 @@
 
   (define (retrieve-extension name transport location
                               #!key version quiet destination username password tests
-			      proxy-host proxy-port)
-    (fluid-let ([*quiet* quiet])
+			      proxy-host proxy-port trunk)
+    (fluid-let ((*quiet* quiet)
+		(*trunk* trunk))
       (case transport
 	[(local)
 	 (when destination (warning "destination for transport `local' ignored"))