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
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
let default d = function
| None -> d
| Some v -> v
let all_files () =
let f = GFile.filter ~name:"All" () in
f#add_pattern "*" ;
f
let is_string_prefix s1 s2 =
let l1 = String.length s1 in
let l2 = String.length s2 in
l1 <= l2 && s1 = String.sub s2 0 l1
let image_filter () =
let f = GFile.filter ~name:"Images" () in
f#add_custom [ `MIME_TYPE ]
(fun info ->
let mime = List.assoc `MIME_TYPE info in
is_string_prefix "image/" mime) ;
f
let text_filter () =
GFile.filter
~name:"Caml source code"
~patterns:[ "*.ml"; "*.mli"; "*.mly"; "*.mll" ] ()
let ask_for_file parent =
let dialog = GWindow.file_chooser_dialog
~action:`OPEN
~title:"Open File"
~parent () in
dialog#add_button_stock `CANCEL `CANCEL ;
dialog#add_select_button_stock `OPEN `OPEN ;
dialog#add_filter (all_files ()) ;
dialog#add_filter (image_filter ()) ;
dialog#add_filter (text_filter ()) ;
begin match dialog#run () with
| `OPEN ->
print_string "filename: " ;
print_endline (default "<none>" dialog#filename) ;
flush stdout
| `DELETE_EVENT | `CANCEL -> ()
end ;
dialog#destroy ()
let main () =
GMain.init ();
let w = GWindow.window ~title:"FileChooser demo" () in
w#connect#destroy GMain.quit ;
let b = GButton.button ~stock:`OPEN ~packing:w#add () in
b#connect#clicked
(fun () -> ask_for_file w) ;
w#show () ;
GMain.main ()
let _ = main ()
(* Local Variables: *)
(* compile-command: "ocamlc -I ../src -w s lablgtk.cma filechooser.ml" *)
(* End: *)
|
