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
|
(**************************************************************************)
(* Lablgtk - Examples *)
(* *)
(* This code is in the public domain. *)
(* You may freely copy parts of it in your application. *)
(* *)
(**************************************************************************)
let files = [
"gnome-fs-regular.png" ;
"gnome-fs-directory.png" ]
let error ?parent message =
let w =
GWindow.message_dialog ~message
~message_type:`ERROR
~buttons:GWindow.Buttons.close
?parent ~destroy_with_parent:true ~show:true () in
w#connect#response (fun _ -> w#destroy ()) ;
()
let sort_func dir_c name_c (m : #GTree.model) i1 i2 =
let is_dir_1 = m#get ~column:dir_c ~row:i1 in
let is_dir_2 = m#get ~column:dir_c ~row:i2 in
if not is_dir_1 && is_dir_2
then 1
else if is_dir_1 && not is_dir_2
then -1
else
let name_1 = m#get ~column:name_c ~row:i1 in
let name_2 = m#get ~column:name_c ~row:i2 in
compare name_1 name_2
type data =
{ store : GTree.list_store ;
path_c : string GTree.column ;
name_c : string GTree.column ;
icon_c : GdkPixbuf.pixbuf GTree.column ;
dir_c : bool GTree.column ;
mutable parent : string ;
file_pb : GdkPixbuf.pixbuf ;
folder_pb : GdkPixbuf.pixbuf ;
}
let create_store file_pb folder_pb parent =
let columns = new GTree.column_list in
let path_c = columns#add Gobject.Data.string in
let name_c = columns#add Gobject.Data.string in
let icon_c = columns#add (Gobject.Data.gobject_by_name "GdkPixbuf") in
let dir_c = columns#add Gobject.Data.boolean in
let store = GTree.list_store columns in
store#set_sort_func 0 (sort_func dir_c name_c) ;
store#set_sort_column_id 0 `ASCENDING ;
{ store = store ; path_c = path_c ;
name_c = name_c ; icon_c = icon_c ;
dir_c = dir_c ; parent = parent ;
file_pb = file_pb ; folder_pb = folder_pb }
let fill_store d =
d.store#clear () ;
Array.iter
(fun name ->
if name.[0] <> '.' then begin
let path = Filename.concat d.parent name in
let is_dir = (Unix.stat path).Unix.st_kind = Unix.S_DIR in
let display_name = Glib.Convert.filename_to_utf8 name in
let row = d.store#append () in
d.store#set ~row ~column:d.path_c path ;
d.store#set ~row ~column:d.name_c display_name ;
d.store#set ~row ~column:d.dir_c is_dir ;
d.store#set ~row ~column:d.icon_c (if is_dir then d.folder_pb else d.file_pb)
end)
(Sys.readdir d.parent)
let refill_store view d =
view#set_model None ;
fill_store d ;
view#set_model (Some (d.store :> GTree.model))
let up_clicked button view d () =
d.parent <- Filename.dirname d.parent ;
refill_store view d ;
button#misc#set_sensitive (d.parent <> "/")
let home_dir =
match Glib.get_home_dir () with
| None -> exit 2
| Some s -> s
let home_clicked button view d () =
d.parent <- home_dir ;
refill_store view d ;
button#misc#set_sensitive true
let item_activated button view d path =
let row = d.store#get_iter path in
let name = d.store#get ~row ~column:d.path_c in
Printf.eprintf "tree_path = %s path = %s\n%!" (GTree.Path.to_string path) name ;
let is_dir = d.store#get ~row ~column:d.dir_c in
if is_dir then begin
let path = d.store#get ~row ~column:d.path_c in
d.parent <- path ;
refill_store view d ;
button#misc#set_sensitive true
end
let do_iconview window =
match
try List.map GdkPixbuf.from_file files
with exn -> error ~parent:window (Printexc.to_string exn) ; []
with
| [ file_pb ; folder_pb ] ->
let vbox = GPack.vbox ~packing:window#add () in
let toolbar = GButton.toolbar ~packing:vbox#pack () in
let up_button =
GButton.tool_button ~stock:`GO_UP ~packing:toolbar#insert () in
up_button#set_is_important true ;
up_button#misc#set_sensitive false ;
let home_button =
GButton.tool_button ~stock:`HOME ~packing:toolbar#insert () in
home_button#set_is_important true ;
let sw = GBin.scrolled_window
~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC
~shadow_type:`ETCHED_IN
~packing:(vbox#pack ~expand:true) () in
let data = create_store file_pb folder_pb "/" in
fill_store data ;
let iv = GTree.icon_view
~model:data.store
~selection_mode:`MULTIPLE ~packing:sw#add () in
iv#set_text_column data.name_c ;
iv#set_pixbuf_column data.icon_c ;
up_button#connect#clicked (up_clicked up_button iv data) ;
home_button#connect#clicked (home_clicked up_button iv data) ;
iv#connect#item_activated (item_activated up_button iv data) ;
iv#misc#grab_focus ()
| _ -> ()
let main =
let w = GWindow.window ~title:"GtkIconView demo" ~width:650 ~height:400 () in
w#connect#destroy GMain.quit ;
do_iconview w ;
w#show () ;
GMain.main ()
|
