2 * Copyright (C) 2010 Red Hat Inc.
4 * This program is free software; you can redistribute it and/or modify
5 * it under the terms of the GNU General Public License as published by
6 * the Free Software Foundation; either version 2 of the License, or
7 * (at your option) any later version.
9 * This program is distributed in the hope that it will be useful,
10 * but WITHOUT ANY WARRANTY; without even the implied warranty of
11 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 * GNU General Public License for more details.
14 * You should have received a copy of the GNU General Public License along
15 * with this program; if not, write to the Free Software Foundation, Inc.,
16 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
22 (* See struct/field description in .mli file. *)
25 model : GTree.tree_store;
26 hash : (int, hdata) Hashtbl.t;
27 index_col : int GTree.column;
28 mode_col : string GTree.column;
29 name_col : string GTree.column;
30 size_col : string GTree.column;
31 date_col : string GTree.column;
35 mutable state : state_t;
37 mutable visited : bool;
48 | ErrorMessage of string
51 | Directory of Slave.direntry
52 | File of Slave.direntry
54 (* Store hdata into a row. *)
55 let store_hdata {model = model; hash = hash; index_col = index_col} row hdata =
56 let index = unique () in
57 Hashtbl.add hash index hdata;
58 model#set ~row ~column:index_col index
60 (* Retrieve previously stored hdata from a row. *)
61 let get_hdata { model = model; hash = hash; index_col = index_col } row =
62 let index = model#get ~row ~column:index_col in
63 try Hashtbl.find hash index
64 with Not_found -> assert false
66 (* Iterate over children of node, looking for matching hdata. *)
67 let find_child_node_by_content ({ model = model } as t) row c =
69 if (get_hdata t row).content = c then
71 else if model#iter_next row then
77 if not (model#iter_has_child row) then
80 let first_child = model#iter_children (Some row) in
83 (* Search up to the top of the tree so we know if this directory
84 * comes from an OS or a volume, and the full path to here.
86 * The path up the tree will always look something like:
90 * \_ Loading <--- you are here
92 let rec get_pathname ({ model = model } as t) row =
93 let hdata = get_hdata t row in
94 let parent = model#iter_parent row in
96 match hdata, parent with
97 | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, Some parent ->
99 | { state=IsLeaf; content=(Loading|ErrorMessage _|Info _) }, None ->
101 | { content=Directory { Slave.dent_name = name }}, Some parent
102 | { content=File { Slave.dent_name = name }}, Some parent ->
103 let src, parent_name = get_pathname t parent in
105 if parent_name = "/" then "/" ^ name
106 else parent_name ^ "/" ^ name in
108 | { content=Top src }, _ -> src, "/"
109 | { content=Directory _}, None -> assert false
110 | { content=File _}, None -> assert false
111 | { content=Loading }, _ -> assert false
112 | { content=ErrorMessage _}, _ -> assert false
113 | { content=Info _}, _ -> assert false
115 (* Base colours. XXX Should be configurable somewhere. *)
116 let file_color = 0x20, 0x20, 0xff (* regular file *)
117 let dir_color = 0x80, 0x80, 0x20 (* directory *)
118 let symlink_color = file_color (* symlink *)
119 let suid_color = 0x20, 0x20, 0x80 (* setuid bit set on regular file *)
120 let suid_bgcolor = 0xff, 0xc0, 0xc0
121 let sgid_color = suid_color (* setgid bit set on regular file *)
122 let sgid_bgcolor = suid_bgcolor
123 let block_color = 0x00, 0x60, 0x60 (* block device *)
124 let char_color = block_color (* char device *)
125 let fifo_color = 0x60, 0x00, 0x60 (* fifo *)
126 let socket_color = fifo_color (* socket *)
127 let other_color = file_color (* anything not one of the above *)
129 (* Mark up a filename for the name_col column.
131 * XXX This shouldn't be in Filetree_type module, but we have to have
132 * it here because set_visited is here.
135 * http://library.gnome.org/devel/pango/stable/PangoMarkupFormat.html
137 let rec markup_of_name ?(visited = false) direntry =
138 let name = direntry.Slave.dent_name in
139 let mode = direntry.Slave.dent_stat.Guestfs.mode in
140 if is_directory mode then ( (* directory *)
141 let fg = if not visited then normal dir_color else darken dir_color in
142 sprintf "<span weight=\"bold\" fgcolor=\"%s\">%s</span>"
143 fg (markup_escape name)
145 else if is_symlink mode then ( (* symlink *)
146 let link = direntry.Slave.dent_link in
148 if not visited then normal symlink_color else darken symlink_color in
149 sprintf "<span style=\"italic\" fgcolor=\"%s\">%s</span> %s <span style=\"italic\" fgcolor=\"%s\">%s</span>"
150 fg (markup_escape name) utf8_rarrow fg (markup_escape link)
152 else ( (* not directory, not symlink *)
154 if is_regular_file mode then (
155 if is_suid mode then suid_color, Some suid_bgcolor
156 else if is_sgid mode then sgid_color, Some sgid_bgcolor
157 else file_color, None
159 else if is_block mode then block_color, None
160 else if is_char mode then char_color, None
161 else if is_fifo mode then fifo_color, None
162 else if is_socket mode then socket_color, None
163 else other_color, None in
164 let fg = if not visited then normal fg else darken fg in
167 | Some bg -> sprintf " bgcolor=\"%s\"" (normal bg)
169 sprintf "<span fgcolor=\"%s\"%s>%s</span>"
170 fg bg (markup_escape name)
173 and normal (r, g, b) =
174 let r = if r < 0 then 0 else if r > 255 then 255 else r in
175 let g = if g < 0 then 0 else if g > 255 then 255 else g in
176 let b = if b < 0 then 0 else if b > 255 then 255 else b in
177 sprintf "#%02x%02x%02x" r g b
179 and darken (r, g, b) =
180 normal (r * 4 / 10, g * 4 / 10, b * 4 / 10)
182 (* This is a bit of a hack. Ideally just setting 'visited' would
183 * darken the colour when the cell was re-rendered. However that would
184 * mean we couldn't store other stuff in the name column. Therefore,
185 * repopulate the name column.
187 let set_visited ({ model = model; name_col = name_col } as t) row =
188 let hdata = get_hdata t row in
189 if hdata.visited = false then (
190 hdata.visited <- true;
191 match hdata.content with
192 | Directory direntry | File direntry ->
193 debug "set_visited %s" direntry.Slave.dent_name;
194 model#set ~row ~column:name_col
195 (markup_of_name ~visited:true direntry)
196 | Loading | ErrorMessage _ | Info _ | Top _ -> ()