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
type filekind = [ `FILE | `DIR ]
class dialog
?(kind=`FILE)
?(title="Select File")
?(select="Select")
?parent () =
let dialog = GWindow.dialog ~title ?parent ~modal:true () in
let packing = dialog#vbox#pack ~expand:true in
let action = match kind with `FILE -> `SAVE | `DIR -> `CREATE_FOLDER in
let chooser = GFile.chooser_widget ~action ~packing () in
object
inherit [string] Wutil.signal as signal
initializer
begin
ignore (dialog#event#connect#delete ~callback:(fun _ -> true)) ;
dialog#add_button "Cancel" `DELETE_EVENT ;
dialog#add_button select `SELECT ;
ignore (GMisc.label ~packing:(dialog#action_area#pack ~expand:true) ()) ;
end
method add_filter ~descr ~patterns =
if kind = `FILE then
chooser#add_filter (GFile.filter ~name:descr ~patterns ())
method select ?dir ?file () =
begin
match dir , file with
| None , None -> ignore (chooser#set_filename "")
| None , Some path -> ignore (chooser#set_filename path)
| Some dir , None ->
ignore (chooser#set_current_folder dir) ;
ignore (chooser#set_current_name "")
| Some dir , Some file ->
ignore (chooser#set_current_folder dir) ;
ignore (chooser#set_current_name file)
end ;
let result = dialog#run () in
dialog#misc#hide () ;
match result with
| `DELETE_EVENT -> ()
| `SELECT ->
match chooser#get_filenames with | f::_ -> signal#fire f | _ -> ()
end
class button ?kind ?title ?select ?tooltip ?parent () =
let box = GPack.hbox ~homogeneous:false ~spacing:0 ~border_width:0 () in
let fld = GMisc.label ~text:"(none)" ~xalign:0.0
~packing:(box#pack ~expand:true) () in
let _ = GMisc.separator `VERTICAL
~packing:(box#pack ~expand:false ~padding:2) ~show:true ()
in
let _ = GMisc.image ~packing:(box#pack ~expand:false) ~stock:`OPEN () in
let button = GButton.button () in
let dialog = new dialog ?kind ?title ?select ?parent () in
object(self)
inherit Wutil.gobj_widget button
inherit! [string] Wutil.selector "" as current
val mutable disptip = fun f ->
match tooltip , f with
| None , "" -> "(none)"
| None , _ -> f
| Some d , "" -> d
| Some d , f -> Printf.sprintf "%s: %s" d f
val mutable display = function
| "" -> "(none)"
| path -> Filename.basename path
initializer
begin
button#add box#coerce ;
button#set_focus_on_click false ;
ignore (button#connect#clicked ~callback:self#select) ;
dialog#connect current#set ;
Wutil.set_tooltip button tooltip ;
current#connect
(fun f ->
button#misc#set_tooltip_text (disptip f) ;
fld#set_text (display f)) ;
end
method set_tooltip p = disptip <- p ; fld#misc#set_tooltip_text (p current#get)
method set_display p = display <- p ; fld#set_text (p current#get)
method add_filter = dialog#add_filter
method select ?dir ?file () =
let file = match file with None -> current#get | Some f -> f in
dialog#select ?dir ~file ()
end