Source

camlimages / examples / liv / liv.ml

The default branch has multiple heads

Full commit
  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Jun Furuse, projet Cristal, INRIA Rocquencourt           *)
(*                                                                     *)
(*  Copyright 1999,2000,2001,2002,2001,2002                            *)
(*  Institut National de Recherche en Informatique et en Automatique.  *)
(*  Distributed only by permission.                                    *)
(*                                                                     *)
(***********************************************************************)
open Images
open OImages

(*
let _ =
  Bitmap.maximum_live := 15000000; (* 60MB *)
  Bitmap.maximum_block_size := !Bitmap.maximum_live / 16;
;;
*)


let _ = prerr_endline "init done";;

module D = Display
open D

(* open Gc *)
open Unix
open LargeFile
open GMain

open Livmisc
open Gui
open Tout

exception Skipped

let cwd = Unix.getcwd ()
let home = Sys.getenv "HOME"

let convert_file file = 
  let b = Buffer.create (String.length file) in

  let rec loop file =
    let dir = Filename.dirname file in
    let base = Filename.basename file in
    begin match dir with
    | "." -> Buffer.add_string b dir
    | "/" -> ()
    | _ -> loop dir
    end;
    Buffer.add_char b '/';
    Buffer.add_string b (try Glib.Convert.locale_to_utf8 base with _ -> base)
  in
  loop file;
  Buffer.contents b
;;

let base_filters = ref ([] : D.filter list);;

let _ =
  let files = ref [] in
  let random = ref false in
  let dirrandom = ref false in
  let dirsample = ref false in
  let size = ref false in

(*JPF*)  
  let mtimesort = ref false in
  let xmode = ref `n in
  let check = ref true in
  let gcheck = ref false in
(*/JPF*)  

  Random.init (Pervasives.truncate (Unix.time ()));
  Arg.parse 
    [
      "-random", Arg.Unit (fun () -> random := true), ": random mode";
      "-dirrandom", Arg.Unit (fun () -> dirrandom := true), ": random per directory mode";
      "-dirsample", Arg.Unit (fun () -> dirsample := true), ": random per directory sample mode";
      "-wait", Arg.Float (fun sec -> Tout.wait := sec), "sec : wait sec";
      "-root", Arg.String (function
	  "center" -> D.root_mode := `CENTER
	| "random" -> D.root_mode := `RANDOM
	| _ -> raise (Failure "root mode")), ": on root [center|random]";
(*
      "-transition", Arg.String (function
	  "myst" -> D.transition := `MYST
	| "transparent" -> D.transition := `TRANSPARENT
	| _ -> raise (Failure "transition")), ": transition [myst|transparent]";
      "-transparentborder", Arg.Unit (fun () ->
	base_filters := `TRANSPARENT_BORDER :: !base_filters),
      ": transparent border filter";
*)
      "-size", Arg.String (fun s ->
	match Mstring.split_str (function 'x' -> true | _ -> false) s with
	  [w;h] -> 
	    size := true; 
	    base_filters := `SIZE (int_of_string w, int_of_string h,`NOASPECT) :: !base_filters
  	| _ -> raise (Failure "size")), ": size [w]x[h]";
      "-atleast", Arg.String (fun s ->
	match Mstring.split_str (function 'x' -> true | _ -> false) s with
	  [w;h] -> 
	    size := true; 
	    base_filters := `SIZE (int_of_string w, int_of_string h,`ATLEAST) :: !base_filters
  	| _ -> raise (Failure "zoom")), ": zoom [w]x[h]";
      "-atmost", Arg.String (fun s ->
	match Mstring.split_str (function 'x' -> true | _ -> false) s with
	  [w;h] -> 
	    size := true; 
	    base_filters := `SIZE (int_of_string w, int_of_string h,`ATMOST) :: !base_filters
  	| _ -> raise (Failure "zoom")), ": zoom [w]x[h]";

(*
      "-normalize", Arg.Unit (fun () ->
	base_filters := `NORMALIZE :: !base_filters), 
            ": normalize colormap";

      "-enhance", Arg.Unit (fun () ->
	base_filters := `ENHANCE :: !base_filters), 
            ": enhance colormap";
*)
(*JPF*)	
     "-check", Arg.Unit (fun () -> check := true), ": check mode";
     "-Check", Arg.Unit (fun () -> check := true; gcheck := true), 
       ": ground check mode";
     "-x", Arg.Unit (fun () -> xmode := `x), ": x mode";
     "-XXX", Arg.Unit (fun () -> xmode := `XXX), ": x mode";
     "-X", Arg.Unit (fun () -> xmode := `X), ": X mode";
     "-_", Arg.Unit (fun () -> xmode := `u), ": -_ mode";
     "--_", Arg.Unit (fun () -> xmode := `u), ": -_ mode";
     "-mtime", Arg.Unit (fun () -> mtimesort := true), ": mtimesort mode";
(*/JPF*)
    ]  
    (fun s -> files := s :: !files)
    "liv files";

  let files =
    let fs = ref [] in
    List.iter (fun f ->
      try
	let st = stat f in
	match st.st_kind with
	| S_DIR ->
	    Scandir.scan_dir (fun f -> 
	      try 
		ignore (guess_extension (snd (Livmisc.get_extension f)));
		fs := f :: !fs;
	      with _e -> (* prerr_endline ((f^": "^ Printexc.to_string e)) *) ()) f
	| _ -> fs := f :: !fs
      with
      | _ -> prerr_endline ("ERROR: " ^ f)) !files;
    Array.of_list !fs 
  in

  if not !size then
    base_filters := `SIZE (fst root_size, snd root_size, `ATMOST) 
                         :: !base_filters;
  base_filters := List.rev !base_filters;
  
  let cur = ref (-1) in
  let curpath = ref "" in

  let disp_cur = ref (-1) in

  let random_array ary = 
    let num = Array.length ary in
    for i = 0 to num - 1 do
      let tmp = ary.(i) in
      let pos = Random.int num in
      ary.(i) <- ary.(pos);
      ary.(pos) <- tmp
    done
  in

  if !dirsample then begin
    let tbl = Hashtbl.create 17 in
    let dirs = ref [] in
    let num_files = Array.length files in
    for i = 0 to num_files - 1 do
      let dirname = Filename.dirname files.(i) in
      Hashtbl.add tbl dirname files.(i);
      if not (List.mem dirname !dirs) then dirs := dirname :: !dirs
    done;
    let dirsarray = Array.of_list !dirs in
    random_array dirsarray;
    let pos = ref 0 in
    let subpos = ref 0 in
    let subfiles = Array.init (Array.length dirsarray) (fun a ->
      let ary = Array.of_list (Hashtbl.find_all tbl dirsarray.(a)) in
      random_array ary; ary)
    in
    while !pos < Array.length files do
      for i = 0 to Array.length dirsarray - 1 do
	if !subpos < Array.length subfiles.(i) then begin
	  files.(!pos) <- subfiles.(i).(!subpos);
	  incr pos
	end
      done;
      incr subpos
    done 
  end else
  if !dirrandom then begin
    let tbl = Hashtbl.create 17 in
    let dirs = ref [] in
    let num_files = Array.length files in
    for i = 0 to num_files - 1 do
      let dirname = Filename.dirname files.(i) in
      Hashtbl.add tbl dirname files.(i);
      if not (List.mem dirname !dirs) then dirs := dirname :: !dirs
    done;
    let dirsarray = Array.of_list !dirs in
    random_array dirsarray;
    let pos = ref 0 in
    for i = 0 to Array.length dirsarray - 1 do
      let dirfiles = Array.of_list 
	  (List.sort compare (Hashtbl.find_all tbl dirsarray.(i))) in
      if !random then begin
	random_array dirfiles
      end;
      for j = 0 to Array.length dirfiles - 1 do
	files.(!pos) <- dirfiles.(j);
	incr pos
      done
    done
  end else if !random then random_array files;

(*JPF*)
  let files =
    if !mtimesort then begin
      let ctimes = 
        Array.map (fun f ->
    	  let st = lstat f in
    	  let t = st.st_mtime in
    	  f,(if !random then t +. Random.float (float (24*60*60)) else t)) files
      in
      Array.sort (fun (f1,t1) (f2,t2) ->
	let c = compare t1 t2 in
        if c = 0 then compare f1 f2 else c) ctimes;
      Array.map fst ctimes
    end else files
  in 
(*/JPF*)

  infowindow#show ();

  imglist#freeze ();
  Array.iter (fun file -> 
    ignore (imglist#append [convert_file file]))
    files;
  imglist#thaw ();

  let cache = Cache.create 5 in

  let rename pos newname =
    let oldname = files.(pos) in
    let xvname s = Filename.dirname s ^ "/.xvpics/" ^ Filename.basename s in
    let oldxvname = xvname oldname in
    let newxvname = xvname newname in
    let gthumbname s = 
      let abs = 
	if s = "" then "" else 
	if s.[0] = '/' then s
	else Filename.concat cwd s
      in
      (Filename.concat (Filename.concat home ".gnome2/gthumb/comments") abs)
	^ ".xml"
    in
    let oldgthumbname = gthumbname oldname in
    let newgthumbname = gthumbname newname in
    imglist#set_cell ~text: (convert_file newname) pos 0;
    let command s = Sys.command s in
    if Filename.dirname newname <> Filename.dirname oldname then begin
      ignore (command 
		(Printf.sprintf "mkdir -p %s" (Filename.dirname newname)));
    end;
    prerr_endline (Printf.sprintf "%s => %s" oldname newname); 
    ignore (command 
	      (Printf.sprintf "yes no | mv -i \"%s\" \"%s\"" oldname newname));
    if Sys.file_exists oldxvname then begin
      ignore (command 
		(Printf.sprintf "mkdir -p %s" (Filename.dirname newxvname)));
	ignore (command 
		  (Printf.sprintf "yes no | mv -i \"%s\" \"%s\"" oldxvname newxvname))
    end;
    if Sys.file_exists oldgthumbname then begin
      ignore (command 
		(Printf.sprintf "mkdir -p %s" (Filename.dirname newgthumbname)));
      ignore (command 
		(Printf.sprintf "yes no | mv -i \"%s\" \"%s\"" oldgthumbname newgthumbname))
    end;
    files.(pos) <- newname;
    Cache.rename cache oldname newname
  in

  let image_id = ref 0 in

  let display_image reload file =
    (* prerr_endline file; *)
    remove_timeout ();

    let load_image () =
      prog#map (); 
      prog#set_fraction 0.01; 
      prog#set_format_string ("loading...");
      let image = 
	try
  	  match tag (OImages.load file 
  		       [Load_Progress prog#set_fraction]) with
  	  | Rgb24 i -> i
	  | Rgba32 i -> i#to_rgb24
  	  | Index8 i -> i#to_rgb24
  	  | Index16 i -> i#to_rgb24
  	  | _ -> raise (Failure "not supported")
	with 
	| e -> prerr_endline (Printexc.to_string e); raise e
      in
      prog#set_fraction 1.0; sync ();
      image
    in

    let id, image =
      try
      	if not reload then begin
      	  Cache.find cache file
	end else raise Not_found
      with
	Not_found ->
	  let im = load_image () in
	  incr image_id;
	  !image_id, im
    in
    Cache.add cache file (id, image) (fun _ -> ());
    
    prog#set_fraction 0.01;
    display id image !base_filters; (* this cause lots of gc *)

    window#set_title (convert_file file);
    
    disp_cur := !cur;
    curpath := file;
(*JPF*)
    (* update mtime *)
    if !check then begin
      try
	let st = lstat file in
	if st.st_kind = S_LNK then begin
	  let lnk = Unix.readlink file in
	  Unix.unlink file;
	  Unix.symlink lnk file
	end else begin
	  Unix.utimes file (Unix.time ()) (Unix.time ());
	end
      with
	_ -> ()
    end;
(*/JPF*)
  in

  let display_image reload file =
    try 
      display_image reload file 
    with Wrong_file_type | Wrong_image_type ->
      try
	prerr_endline "guess type";
	let typ =
	  let typ = Livshtype.guess file in
	  match typ with
	  | Livshtype.ContentType x ->
	      begin match
		Mstring.split_str (function '/' -> true | _ -> false) x
	      with
	      | [mj;mn] -> mj,mn
      	      | _ -> assert false
	      end
	  | Livshtype.ContentEncoding x ->
	      "encoding", x
	  | Livshtype.Special m ->
	      "special",m
	in
	prerr_endline (fst typ ^ "/" ^ snd typ);  
	match typ with
(*JPF*)
	| "application", "vnd.rn-realmedia"
	| "audio", "x-pn-realaudio" ->
	    disp_cur := !cur;
	    curpath := file;
	    ignore (Sys.command "killall -KILL mplayer");
	    ignore (Sys.command (Printf.sprintf "mplayer -framedrop \"%s\" &" file))
	| "video", _ ->
	    disp_cur := !cur;
	    curpath := file;	
	    ignore (Sys.command "killall -KILL mplayer");
	    ignore (Sys.command (Printf.sprintf "mplayer -framedrop '%s' &" file))
(*/JPF*)
	| _ -> raise Wrong_file_type
      with
      | _ -> ()
  in

  let _filter_toggle opt = 
	if List.mem opt !base_filters then
	  base_filters :=
	     List.fold_right (fun x st ->
	       if x = opt then st
	       else x :: st) !base_filters []
	else
	  base_filters := !base_filters @ [opt]
  in

  let display_current reload =
    let f = 
      if !cur >= 0 && !cur < Array.length files then begin
    	imglist#unselect_all ();
    	imglist#select !cur 0;
    	if imglist#row_is_visible !cur <> `FULL then begin
	  imglist#moveto ~row_align: 0.5 ~col_align: 0.0 !cur 0
    	end;
      	files.(!cur)
      end else !curpath
    in
(*JPF*)
    let _xlevel, _enhanced, _checked = Jpf.get_flags f in
(*
    if enhanced then filter_toggle `ENHANCE;
*)

    let f = 
      if !gcheck && files.(!cur) = f then begin
	let xlevel, enhanced, _checked = Jpf.get_flags files.(!cur) in
	let newname = Jpf.set_flags files.(!cur) (xlevel,enhanced,true) in
	if files.(!cur) <> newname then begin
	  rename !cur newname
	end;
	newname end else f
    in
(*/JPF*)

      display_image reload f;
(*JPF*)
(*
    if enhanced then filter_toggle `ENHANCE;
*)
(*/JPF*)

    ()
  in

(*JPF*)
  let check_skip mode =
    match mode with
    | Some `FORCE -> ()
    | Some `DIR ->
	let disp_file = files.(!disp_cur) in
	let cur_file = files.(!cur) in
	if Filename.dirname disp_file = Filename.dirname cur_file then
	  raise Skipped
    | None ->
        let xlevel, _enhanced, checked = Jpf.get_flags files.(!cur) in
        if !gcheck && checked then raise Skipped;
        match !xmode with
        | `n -> ()
        | `u -> if xlevel < 0 then raise Skipped
        | `x ->
(*
    	let imgs = Array.length files in
*)
    	let perc = 
              if xlevel < 0 then 0 else  
    	  match xlevel with
    	    0 -> 25
    	  | 1 -> 50
    	  | 2 -> 75
    	  | _ -> 100
    	in
    	if Random.int 100 < perc then () else raise Skipped
        | `XXX ->
(*
    	let imgs = Array.length files in
*)
    	let perc = 
              if xlevel < 0 then 0 else  
    	  match xlevel with
    	    0 | 1 -> 1
          | 2 -> 10
    	  | _ -> 100
    	in
    	if Random.int 100 < perc then () else raise Skipped
        | `X ->
    	let perc = 
              if xlevel < 0 then 0 else  
    	  match xlevel with
    	    0 -> 0
    	  | _ -> 100
    	in
    	if Random.int 100 < perc then () else raise Skipped
  in
(*/JPF*)

  let rec next mode =
    if !cur >= 0 then begin
      let cur' = 
  	if !cur >= Array.length files - 1 then 0 else !cur + 1
      in
      if !cur = cur' then ()
      else begin
  	cur := cur';
  	try
(*JPF*)
	  check_skip mode;
(*/JPF*)
  	  display_current false;
      	with
      	| Sys_error s ->
  	    prerr_endline s;
  	    next mode
(*JPF*)
	| Skipped -> next mode
(*/JPF*)
        | Wrong_file_type | Wrong_image_type -> next mode
      end
    end
  in

  let rec prev mode =
    if !cur >= 0 then begin
      let cur' =
      	if !cur = 0 then Array.length files - 1 else !cur - 1
      in
      if !cur = cur' then ()
      else begin
      	cur := cur';
      	try
(*JPF*)
	  check_skip mode;
(*/JPF*)
  	  display_current false
      	with
      	| Sys_error s ->
  	    prerr_endline s;
  	    prev mode
      	| Skipped -> prev mode
      	| Wrong_file_type | Wrong_image_type -> prev mode
      end
    end
  in

  let bind () =
    let callback = fun ev ->
      begin match GdkEvent.Key.string ev with
(*
      | "E" -> 
	  filter_toggle `ENHANCE;
	  display_current true

*)
(*JPF*)
      | "E" -> 
	  let name = files.(!disp_cur) in
	  let xlevel,enhance,checked = Jpf.get_flags name in
          let enhance' = not enhance in
          let newname = Jpf.set_flags name (xlevel,enhance',checked) in
	  if name <> newname then begin
            rename !disp_cur newname
	  end;
	  display_current true
(*/JPF*)
(*
      | "N" -> 
	  filter_toggle `NORMALIZE;
	  display_current true
*)
	    
      |	"l" -> display_current true

      | " " | "n" | "f" -> next None
(*JPF*)
      | "\014" (* C-N *) | "\006" (* C-F *) -> next (Some `FORCE)
      | "N" | "F" -> next (Some `DIR)
(*/JPF*)
      | "p" | "b" -> prev None
(*JPF*)
      | "\016" (* C-P *) | "\002" (* C-B *) -> prev (Some `FORCE)
      | "P" | "B" -> prev (Some `DIR)
(*/JPF*)
      | "q" -> Main.quit ()
(*
      | "v" -> 
	(* liv visual shell *)
  	  let rec func = fun file typ ->
	    match typ with
	    | "image", _ -> 
    	      	display_image false file
(*
            | "special", "dir" -> 
                new Livsh.livsh file func; ()
*)
	    | _ -> Gdk.X.beep ()
  	  in
	  (* where we should display ? *)
	  let dirname = 
	    if Array.length files = 0 then Unix.getcwd ()
	    else Filename.dirname files.(!cur) 
	  in
	  let dirname =
	    if Filename.is_relative dirname then begin
 	      let cwd = Unix.getcwd () in
	      Filename.concat cwd dirname
	    end else dirname
	  in
	  ignore (new Livsh.livsh dirname func)
*)
(*JPF*)
      | "e" -> 
	  if !check then begin
	    let name = files.(!disp_cur) in
	    let _xlevel,enhance,checked = Jpf.get_flags name in
            let xlevel' = -1 in
            let newname = Jpf.set_flags name (xlevel',enhance,checked) in
	    if name <> newname then begin
              rename !disp_cur newname
	    end;
	    next None
          end 
      | "x" -> 
	  if !check then begin
	    let name = files.(!disp_cur) in
	    let xlevel,enhance,checked = Jpf.get_flags name in
            let xlevel' = xlevel + 1 in
            let newname = Jpf.set_flags name (xlevel',enhance,checked) in
	    if name <> newname then begin
              rename !disp_cur newname
	    end;
	    next None
	  end
      | "r" -> 
	  if !check then begin
	    let name = files.(!disp_cur) in
	    let xlevel,enhance,checked = Jpf.get_flags name in
            let xlevel' = 
              if xlevel > 0 then xlevel - 1 
              else if xlevel < 0 then xlevel + 1
              else xlevel
            in
            let newname = Jpf.set_flags name (xlevel',enhance,checked) in
	    if name <> newname then begin
              rename !disp_cur newname
	    end;
	    next None
	  end
      | "s" -> 
	  if !check then begin
	    let name = files.(!disp_cur) in
	    let dir = Filename.dirname name in
            let base = Filename.basename name in
            let newname = 
              let trash =
                try string_tail dir 7 = "/series" with _ -> false 
              in
              if trash then
                Filename.concat 
                  (String.sub dir 0 (String.length dir - 7)) base 
              else Filename.concat (Filename.concat dir "series") base 
            in
	    if name <> newname then begin
              rename !disp_cur newname
	    end;
	    next None
	  end
      | "d" -> 
	  if !check then begin
	    let name = files.(!disp_cur) in
	    let dir = Filename.dirname name in
            let base = Filename.basename name in
            let newname = 
              let trash =
                try string_tail dir 6 = "/trash" with _ -> false 
              in
              if trash then
                Filename.concat 
                  (String.sub dir 0 (String.length dir - 6)) base 
              else Filename.concat (Filename.concat dir "trash") base 
            in
	    if name <> newname then begin
              rename !disp_cur newname
	    end;
	    next None
	  end
(*/JPF*)
      | _ -> () 
      end; false
    in
    ignore (window#event#connect#key_press ~callback: callback);
    ignore (infowindow#event#connect#key_press ~callback: callback);

    ignore (imglist#connect#select_row ~callback: (fun ~row ~column:_ ~event:_ ->
      if !cur <> row then begin
      	cur := row;
      	display_image false files.(!cur)
      end))
  in

  bind ();

  Tout.hook_next := next;

  window#show ();

  let starter = ref None in

  starter := Some (window#event#connect#configure ~callback: (fun _ev ->
    may window#misc#disconnect !starter;
    if Array.length files <> 0 then begin
      cur := 0;
      prog#unmap ();
      display_current false
    end else begin
      try
	display_image false (Pathfind.find [ "~/.liv"; 
					     "/usr/lib/liv"; 
					     "/usr/local/lib/liv";
					     "." ] "liv.jpg")
      with
      | _ -> ()
    end; false));

(*
  let release _ = prerr_endline "freed string!" in
  let test () =
    let f () =
      let string = String.create 3000 in
      Gc.finalise release string;
      let buf = Gpointer.region_of_string string in
      ignore (GdkPixbuf.from_data ~width: 100 ~height: 10
		~bits: 8 ~rowstride:300 ~has_alpha: false buf);
      ()
    in
    for i = 0 to 100 do f () done
  in
  test ();
*)

  Main.main ()