/usr/lib/ocaml/lablgtk2/glib.ml is in liblablgtk2-ocaml-dev 2.18.3+dfsg-1build1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 | (**************************************************************************)
(* Lablgtk *)
(* *)
(* This program is free software; you can redistribute it *)
(* and/or modify it under the terms of the GNU Library General *)
(* Public License as published by the Free Software Foundation *)
(* version 2, with the exception described in file COPYING which *)
(* comes with the library. *)
(* *)
(* This program is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU Library General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU Library General *)
(* Public License along with this program; if not, write to the *)
(* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *)
(* Boston, MA 02111-1307 USA *)
(* *)
(* *)
(**************************************************************************)
(* $Id$ *)
type unichar = int
type unistring = unichar array
exception GError of string
external _init : unit -> unit = "ml_glib_init"
let () = _init () ; Callback.register_exception "gerror" (GError "")
module Main = struct
type t
external create : bool -> t = "ml_g_main_new"
external iteration : bool -> bool = "ml_g_main_iteration"
external pending : unit -> bool = "ml_g_main_pending"
external is_running : t -> bool = "ml_g_main_is_running"
external quit : t -> unit = "ml_g_main_quit"
external destroy : t -> unit = "ml_g_main_destroy"
type locale_category =
[ `ALL | `COLLATE | `CTYPE | `MESSAGES | `MONETARY | `NUMERIC | `TIME ]
external setlocale : locale_category -> string option -> string
= "ml_setlocale"
external wrap_poll_func : unit -> unit = "ml_g_wrap_poll_func"
end
let int_of_priority = function
| `HIGH -> -100
| `DEFAULT -> 0
| `HIGH_IDLE -> 100
| `DEFAULT_IDLE -> 200
| `LOW -> 300
module Timeout = struct
type id
external add : ?prio:int -> ms:int -> callback:(unit -> bool) -> id
= "ml_g_timeout_add"
let add = add ?prio:None
external remove : id -> unit = "ml_g_source_remove"
end
module Idle = struct
type id
external add : ?prio:int -> (unit -> bool) -> id
= "ml_g_idle_add"
external remove : id -> unit = "ml_g_source_remove"
end
module Io = struct
type channel
type condition = [ `IN | `OUT | `PRI | `ERR | `HUP | `NVAL ]
type id
external channel_of_descr : Unix.file_descr -> channel
= "ml_g_io_channel_unix_new"
external remove : id -> unit = "ml_g_source_remove"
external add_watch :
cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id
= "ml_g_io_add_watch"
external read : channel -> buf:string -> pos:int -> len:int -> int
= "ml_g_io_channel_read"
external read_chars : channel -> buf:string -> pos:int -> len:int -> int
= "ml_g_io_channel_read_chars"
end
module Message = struct
type log_level =
[ `ERROR | `CRITICAL | `WARNING | `MESSAGE | `INFO | `DEBUG
| `FLAG_RECURSION | `FLAG_FATAL ]
external _log_level : log_level -> int = "ml_Log_level_val"
let log_level = function
| `CUSTOM i -> i lsl 8
| #log_level as level -> _log_level level
let int_of_log_levels levels =
List.fold_left (fun acc lev -> acc lor (log_level lev)) 0 levels
type log_handler
external _set_log_handler :
?domain:string -> levels:int -> (level:int -> string -> unit) -> log_handler
= "ml_g_log_set_handler"
let set_log_handler ?domain ~levels f =
_set_log_handler ?domain ~levels:(int_of_log_levels levels) f
external remove_log_handler : log_handler -> unit
= "ml_g_log_remove_handler"
external _set_always_fatal : int -> unit = "ml_g_log_set_always_fatal"
let set_always_fatal (levels : log_level list) =
_set_always_fatal (int_of_log_levels levels)
external _set_fatal_mask : ?domain:string -> int -> unit = "ml_g_log_set_fatal_mask"
let set_fatal_mask ?domain levels =
_set_fatal_mask ?domain (int_of_log_levels levels)
external _log : string -> int -> string -> unit = "ml_g_log"
let log ?(domain="") level fmt =
Printf.kprintf (_log domain (log_level level)) fmt
end
(*
module Thread = struct
external init : unit -> unit = "ml_g_thread_init"
(* Call only once! *)
external enter : unit -> unit = "ml_gdk_threads_enter"
external leave : unit -> unit = "ml_gdk_threads_leave"
end
*)
module Convert = struct
type error =
| NO_CONVERSION
| ILLEGAL_SEQUENCE
| FAILED
| PARTIAL_INPUT
| BAD_URI
| NOT_ABSOLUTE_PATH
exception Error of error * string
let () = Callback.register_exception "g_convert_error" (Error (NO_CONVERSION, ""))
external convert :
string -> to_codeset:string -> from_codeset:string -> string
= "ml_g_convert"
external convert_with_fallback :
?fallback:string -> to_codeset:string -> from_codeset:string -> string -> string
= "ml_g_convert_with_fallback"
(* [get_charset ()] returns the pair [u,s] where [u] is true if the
current charset is UTF-8 encoded and [s] is the charset name. *)
external get_charset : unit -> bool * string = "ml_g_get_charset"
external utf8_validate : string -> bool = "ml_g_utf8_validate"
let raise_bad_utf8 () =
raise (Error (ILLEGAL_SEQUENCE, "Invalid byte sequence for UTF-8 string"))
let locale_from_utf8 s =
match get_charset () with
| (true, _) ->
if utf8_validate s
then s
else raise_bad_utf8 ()
| (false, to_codeset) ->
convert s ~to_codeset ~from_codeset:"UTF-8"
let locale_to_utf8 s =
match get_charset () with
| (true, _) ->
if utf8_validate s
then s
else raise_bad_utf8 ()
| (false, from_codeset) ->
convert s ~to_codeset:"UTF-8" ~from_codeset
external filename_from_utf8 : string -> string
= "ml_g_filename_from_utf8"
external filename_to_utf8 : string -> string
= "ml_g_filename_to_utf8"
external filename_from_uri : string -> string option * string
= "ml_g_filename_from_uri"
external filename_to_uri : ?hostname:string -> string -> string
= "ml_g_filename_to_uri"
end
module Unichar = struct
external to_lower : unichar -> unichar = "ml_g_unichar_tolower"
external to_upper : unichar -> unichar = "ml_g_unichar_toupper"
external to_title : unichar -> unichar = "ml_g_unichar_totitle"
external digit_value : unichar -> int = "ml_g_unichar_digit_value"
external xdigit_value : unichar -> int = "ml_g_unichar_xdigit_value"
external validate : unichar -> bool = "ml_g_unichar_validate" "noalloc"
external isalnum : unichar -> bool = "ml_g_unichar_isalnum"
external isalpha : unichar -> bool = "ml_g_unichar_isalpha"
external iscntrl : unichar -> bool = "ml_g_unichar_iscntrl"
external isdigit : unichar -> bool = "ml_g_unichar_isdigit"
external isgraph : unichar -> bool = "ml_g_unichar_isgraph"
external islower : unichar -> bool = "ml_g_unichar_islower"
external isprint : unichar -> bool = "ml_g_unichar_isprint"
external ispunct : unichar -> bool = "ml_g_unichar_ispunct"
external isspace : unichar -> bool = "ml_g_unichar_isspace"
external isupper : unichar -> bool = "ml_g_unichar_isupper"
external isxdigit : unichar -> bool = "ml_g_unichar_isxdigit"
external istitle : unichar -> bool = "ml_g_unichar_istitle"
external isdefined : unichar -> bool = "ml_g_unichar_isdefined"
external iswide : unichar -> bool = "ml_g_unichar_iswide"
end
module Utf8 = struct
include Gutf8
external validate : string -> bool = "ml_g_utf8_validate"
external length : string -> int = "ml_g_utf8_strlen"
external offset_to_pos : string -> pos:int -> off:int -> int
= "ml_g_utf8_offset_to_pointer" "noalloc"
external uppercase : string -> string = "ml_g_utf8_strup"
external lowercase : string -> string = "ml_g_utf8_strdown"
type normalize_mode = [ `DEFAULT | `DEFAULT_COMPOSE | `ALL | `ALL_COMPOSE ]
external normalize : string -> normalize_mode -> string
= "ml_g_utf8_normalize"
external casefold : string -> string = "ml_g_utf8_casefold"
external collate : string -> string -> int = "ml_g_utf8_collate"
external collate_key : string -> string = "ml_g_utf8_collate_key"
end
module Markup = struct
type error =
| BAD_UTF8
| EMPTY
| PARSE
| UNKNOWN_ELEMENT
| UNKNOWN_ATTRIBUTE
| INVALID_CONTENT
exception Error of error * string
let () = Callback.register_exception "g_markup_error" (Error (BAD_UTF8, ""))
external escape_text : string -> string = "ml_g_markup_escape_text"
end
external get_prgname : unit -> string = "ml_g_get_prgname"
external set_prgname : string -> unit = "ml_g_set_prgname"
external get_application_name : unit -> string = "ml_g_get_application_name"
external set_application_name : string -> unit = "ml_g_set_application_name"
external get_user_name : unit -> string = "ml_g_get_user_name"
external get_real_name : unit -> string = "ml_g_get_real_name"
external get_home_dir : unit -> string option = "ml_g_get_home_dir"
external get_tmp_dir : unit -> string = "ml_g_get_tmp_dir"
external find_program_in_path : string -> string = "ml_g_find_program_in_path"
external getenv : string -> string = "ml_g_getenv"
external setenv : string -> string -> bool -> unit = "ml_g_setenv"
external unsetenv : string -> unit = "ml_g_unsetenv"
external get_user_cache_dir : unit -> string = "ml_g_get_user_cache_dir"
external get_user_data_dir : unit -> string = "ml_g_get_user_data_dir"
external get_user_config_dir : unit -> string = "ml_g_get_user_config_dir"
external get_system_data_dirs : unit -> string list = "ml_g_get_system_data_dirs"
external get_system_config_dirs : unit -> string list = "ml_g_get_system_config_dirs"
external usleep : int -> unit = "ml_g_usleep"
|