-(* XXX No binding for g_markup_escape in lablgtk2. *)
-let markup_escape name =
- let f = function
- | '&' -> "&" | '<' -> "<" | '>' -> ">"
- | c -> String.make 1 c
- in
- String.replace_chars f name
-
-(* Mark up a filename for the name_col column. *)
-let rec markup_of_name name =
- markup_escape name
-
-(* Mark up symbolic links. *)
-and markup_of_link link =
- let link = markup_escape link in
- if link <> "" then utf8_rarrow ^ " " ^ link else ""
-
-(* Mark up mode. *)
-and markup_of_mode mode =
- let c =
- if is_socket mode then 's'
- else if is_symlink mode then 'l'
- else if is_regular_file mode then '-'
- else if is_block mode then 'b'
- else if is_directory mode then 'd'
- else if is_char mode then 'c'
- else if is_fifo mode then 'p' else '?' in
- let ru = if test_bit 0o400L mode then 'r' else '-' in
- let wu = if test_bit 0o200L mode then 'w' else '-' in
- let xu = if test_bit 0o100L mode then 'x' else '-' in
- let rg = if test_bit 0o40L mode then 'r' else '-' in
- let wg = if test_bit 0o20L mode then 'w' else '-' in
- let xg = if test_bit 0o10L mode then 'x' else '-' in
- let ro = if test_bit 0o4L mode then 'r' else '-' in
- let wo = if test_bit 0o2L mode then 'w' else '-' in
- let xo = if test_bit 0o1L mode then 'x' else '-' in
- let str = sprintf "%c%c%c%c%c%c%c%c%c%c" c ru wu xu rg wg xg ro wo xo in
-
- let suid = test_bit 0o4000L mode in
- let sgid = test_bit 0o2000L mode in
- let svtx = test_bit 0o1000L mode in
- if suid then str.[3] <- 's';
- if sgid then str.[6] <- 's';
- if svtx then str.[9] <- 't';
-
- "<span color=\"#222222\" size=\"small\">" ^ str ^ "</span>"
-
-(* File type tests. *)
-and file_type mask mode = Int64.logand mode 0o170000L = mask
-
-and is_socket mode = file_type 0o140000L mode
-and is_symlink mode = file_type 0o120000L mode
-and is_regular_file mode = file_type 0o100000L mode
-and is_block mode = file_type 0o060000L mode
-and is_directory mode = file_type 0o040000L mode
-and is_char mode = file_type 0o020000L mode
-and is_fifo mode = file_type 0o010000L mode
-
-and test_bit mask mode = Int64.logand mode mask = mask
-
-(* Mark up dates. *)
-and markup_of_date time =
- let time = Int64.to_float time in
- let tm = Unix.localtime time in
- sprintf "<span color=\"#222222\" size=\"small\">%04d-%02d-%02d %02d:%02d:%02d</span>"
- (tm.Unix.tm_year + 1900) (tm.Unix.tm_mon + 1) tm.Unix.tm_mday
- tm.Unix.tm_hour tm.Unix.tm_min tm.Unix.tm_sec