lurette 0.87 Wed, 18 Sep 2002 16:50:33 +0200 by jahier

Parent-Version:      0.86
Version-Log:

Save and restore sessions without messing up directory names
(namely, avoid name clashes in the /tmp dir).

Project-Description: Lurette

.lurette.prcs_aux

@@ -80,7 +80,7 @@
 (test/heater_float.lus 175 1020068208 b/44_heater_flo 1.1)
 (test/vrai_tram.c 3060 1027066799 b/8_vrai_tram. 1.3)
 (source/print.mli 773 1027066799 46_print.mli 1.10)
-(source/lurettetop.ml 24417 1032355637 c/1_lurettetop 1.8)
+(source/lurettetop.ml 24866 1032360633 c/1_lurettetop 1.9)
 (ihm/xlurette/xlurette.glade 43069 1032355637 c/13_xlurette.g 1.2)
 (test/heater_int.lus 170 1020068208 b/43_heater_int 1.1)
 (source/graph.mli 2218 1027066799 13_graph.mli 1.9)

lurette.prj

 ;; -*- Prcs -*-
 (Created-By-Prcs-Version 1 3 3)
 (Project-Description "Lurette")
-(Project-Version lurette 0 86)
-(Parent-Version lurette 0 85)
+(Project-Version lurette 0 87)
+(Parent-Version lurette 0 86)
 (Version-Log "
-Finish to implement xlurette.
+Save and restore sessions without messing up directory names
+(namely, avoid name clashes in the /tmp dir).
 
 ")
 (New-Version-Log ""
 )
-(Checkin-Time "Wed, 18 Sep 2002 15:27:17 +0200")
+(Checkin-Time "Wed, 18 Sep 2002 16:50:33 +0200")
 (Checkin-Login jahier)
 (Populate-Ignore ())
 (Project-Keywords)
@@ -75,7 +76,7 @@ Finish to implement xlurette.
   (source/gne.mli (lurette/b/36_gne.mli 1.2 644))
   (source/gne.ml (lurette/b/37_gne.ml 1.2 644))
 
-  (source/lurettetop.ml (lurette/c/1_lurettetop 1.8 644))
+  (source/lurettetop.ml (lurette/c/1_lurettetop 1.9 644))
   (source/gen_stubs.ml (lurette/24_generate_l 1.34 644))
 
   (source/control.mli (lurette/c/3_control.ml 1.2 644))

source/lurettetop.ml

@@ -694,13 +694,13 @@ let rec (main_loop : string -> string -> string -> int -> unit) =
 		       let sim_cmd = "sim2chro -ecran -in " ^ user_dir ^ "/" ^ flag.output ^ 
 					    " > /dev/null &\n" in
 		       let _ = output_string stderr sim_cmd ; flush stderr; Sys.command sim_cmd 
-		       in 
+		       in
 			 true
 		   | Quit -> false
 		   | HelpSimple -> print_string cmd_usage; true
 		   | Help -> display_cmd (); true
 		   | Man -> print_string man ; true
-		   | Pack(file) -> 
+		   | Pack(file) ->
 		       (* XXX autoconf: gnu tar ougth to be installed ! *)
 		       let 
 			 cmd = ("mv " ^ lurette_tmp_dir ^ " /tmp/" ^ file ^  
@@ -708,12 +708,23 @@ let rec (main_loop : string -> string -> string -> int -> unit) =
 				file ^ ".tgz /tmp/" ^ file ^ 
 				" > tar.log; mv /tmp/" ^ 
 				file ^ " " ^ lurette_tmp_dir ^ " >> tar.log " ) 
+		       
 		       in
-		       let _ = 
+		       let tar_res = 
 			 output_string stderr (cmd ^ "\n") ; 
 			 flush stderr;
 			 Sys.command cmd 
-		       in true
+		       in	 
+			 if tar_res <> 0 
+			 then 
+			   (
+			     print_string ("*** <<" ^ cmd ^ 
+					   ">> failed. Is gnu-tar in your path ?\n");
+			     flush stdout;
+			     true
+			   )
+			 else
+			   true
 		   | Error(errmsg) -> 
 		       print_string errmsg; 
 		       print_string cmd_usage;
@@ -784,20 +795,32 @@ let _ =
 	  flush stderr ;
 	  exit 2
       | _ ->
-	    exit 2
+	  exit 2
   in
+  let tmp_dir = get_fresh_dir () in
   let lurette_tmp_dir = 
     match flag.restore with
-	None -> get_fresh_dir ()
+	None -> tmp_dir
       | Some file ->
 	  (* XXX autoconf: gnu tar ougth to be installed ! *)
-	  let cmd = ("cd /; tar xvfz " ^ user_dir ^ file) in 
-	  let _ = 
+	  let cmd = ("tar xvfz " ^ user_dir ^ file ^ " --directory " ^ tmp_dir) in 
+	  let tar_res = 
 	    output_string stderr (cmd ^ "\n"); 
 	    flush stderr;
-	    Sys.command cmd in
-	    ("/tmp/" ^ (remove_extension file))
+	    Sys.command cmd 
+	  in
+	    if tar_res <> 0 
+	    then 
+	      (
+		print_string ("*** <<" ^ cmd ^ 
+			      ">> failed. Is gnu-tar in your path?\n");
+		flush stdout;
+		exit 2
+	      )
+	    else
+	      (tmp_dir ^ "/tmp/" ^ (remove_extension file))
   in
+    
     Unix.chdir lurette_tmp_dir;
     if 
       !(flag.go)