This file is indexed.

/usr/lib/ocaml/lablgtk2/gMisc.ml is in liblablgtk2-ocaml-dev 2.18.5+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
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
(**************************************************************************)
(*                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$ *)

open Gaux
open Gobject
open Gtk
open GtkBase
open GtkMisc
open OgtkMiscProps
open GObj

let separator dir ?packing ?show () =
  let w = Separator.create dir [] in
  pack_return (new widget_full w) ~packing ~show

class statusbar_context obj ctx = object (self)
  val obj : statusbar obj = obj
  val context : Gtk.statusbar_context = ctx
  method context = context
  method push text = Statusbar.push obj context ~text
  method pop () = Statusbar.pop obj context
  method remove = Statusbar.remove obj context
  method flash ?(delay=1000) text =
    let msg = self#push text in
    Glib.Timeout.add delay (fun () -> self#remove msg; false);
    ()
end

class statusbar obj = object
  inherit GPack.box (obj : Gtk.statusbar obj)
  method has_resize_grip = Statusbar.get_has_resize_grip obj
  method set_has_resize_grip v = Statusbar.set_has_resize_grip obj v
  method new_context ~name =
    new statusbar_context obj (Statusbar.get_context_id obj name)
end

let statusbar =
  Statusbar.make_params [] ~cont:
    (GContainer.pack_container ~create:
       (fun p -> new statusbar (Statusbar.create p)))

class status_icon_signals (obj : Gtk.status_icon Gobject.obj) = object
(*    inherit [Gtk.status_icon] gobject_signals obj*)
    inherit gtk_status_icon_sigs
    method private connect sgn ~callback =
      GtkSignal.connect ~sgn ~callback ~after: true obj
    method private notify prop ~callback =
      GtkSignal.connect_property obj ~prop ~callback
end

class status_icon obj = object
  val obj : Gtk.status_icon Gobject.obj = obj
  inherit gtk_status_icon_props
  method connect = new status_icon_signals obj
  method set_from_pixbuf = StatusIcon.set_from_pixbuf obj
  method set_from_file = StatusIcon.set_from_file obj
  method set_from_stock = StatusIcon.set_from_stock obj
  method set_from_icon_name = StatusIcon.set_from_icon_name obj
  method get_pixbuf = StatusIcon.get_pixbuf obj
  method get_stock = StatusIcon.get_stock obj
  method get_icon_name = StatusIcon.get_icon_name obj
  method get_size = StatusIcon.get_size obj
  method set_tooltip = StatusIcon.set_tooltip obj
  method is_embedded= StatusIcon.is_embedded obj
end

let status_icon =
  StatusIcon.make_params [] ~cont:
    (fun p () -> new status_icon (StatusIcon.create p))

let status_icon_from_pixbuf =
  StatusIcon.make_params [] ~cont:
    (fun p pb ->
       let o = new status_icon (StatusIcon.create p) in
       o#set_from_pixbuf pb;
       o
    )
let status_icon_from_file =
  StatusIcon.make_params [] ~cont:
    (fun p file ->
       let o = new status_icon (StatusIcon.create p) in
       o#set_from_file file;
       o
    )
let status_icon_from_stock =
  StatusIcon.make_params [] ~cont:
    (fun p s ->
       let o = new status_icon (StatusIcon.create p) in
       o#set_from_stock s;
       o
    )
let status_icon_from_icon_name =
  StatusIcon.make_params [] ~cont:
    (fun p s ->
       let o = new status_icon (StatusIcon.create p) in
       o#set_from_icon_name s;
       o
    )


class calendar_signals obj = object
  inherit widget_signals_impl obj
  inherit calendar_sigs
end

class calendar obj = object
  inherit ['a] widget_impl (obj : Gtk.calendar obj)
  inherit calendar_props
  method event = new GObj.event_ops obj
  method connect = new calendar_signals obj
  method select_month = Calendar.select_month obj
  method select_day = Calendar.select_day obj
  method mark_day = Calendar.mark_day obj
  method unmark_day = Calendar.unmark_day obj
  method clear_marks = Calendar.clear_marks obj
  method display_options = Calendar.display_options obj
  method date = Calendar.get_date obj
  method freeze () = Calendar.freeze obj
  method thaw () = Calendar.thaw obj
  method num_marked_dates = Calendar.get_num_marked_dates obj
  method is_day_marked = Calendar.is_day_marked obj
end

let calendar ?options ?packing ?show () =
  let w = Calendar.create [] in
  may options ~f:(Calendar.display_options w);
  pack_return (new calendar w) ~packing ~show

class drawing_area obj = object
  inherit widget_full (obj : [> Gtk.drawing_area] obj)
  method event = new GObj.event_ops obj
  method set_size = DrawingArea.size obj
end

let may_set_size ?(width=0) ?(height=0) w =
  if width <> 0 || height <> 0 then DrawingArea.size w ~width ~height

let drawing_area ?width ?height ?packing ?show () =
  let w = DrawingArea.create [] in
  may_set_size w ?width ?height;
  pack_return (new drawing_area w) ~packing ~show

class curve obj = object
  inherit drawing_area (obj : Gtk.curve obj)
  inherit curve_props
  method reset () = Curve.reset obj
  method set_gamma = Curve.set_gamma obj
  method set_vector = Curve.set_vector obj
  method get_vector = Curve.get_vector obj
end

let curve ?width ?height =
  Curve.make_params [] ~cont:(fun pl ?packing ?show () ->
    let w = Curve.create pl in
    may_set_size w ?width ?height;
    pack_return (new curve w) ~packing ~show)

class misc obj = object
  inherit ['a] widget_impl obj
  inherit misc_props
end

class arrow obj = object
  inherit misc obj
  inherit arrow_props
end

let arrow =
  Arrow.make_params [] ~cont:(
  Misc.all_params ~cont:(fun p ?packing ?show () ->
    pack_return (new arrow (Arrow.create p)) ~packing ~show))

class image obj = object (self)
  inherit misc obj
  inherit image_props
  method pixmap = new GDraw.pixmap (get Image.P.pixmap obj) ?mask:self#mask
  method set_pixmap (p : GDraw.pixmap) =
    set Image.P.pixmap obj p#pixmap;
    self#set_mask p#mask
  method clear () = Image.clear obj
end

type image_type =
  [ `EMPTY | `PIXMAP | `IMAGE | `PIXBUF | `STOCK | `ICON_SET | `ANIMATION
  | `ICON_NAME | `GICON ]

let image =
  Image.make_params [] ~cont:(
  Misc.all_params ~cont:(fun p ?packing ?show () ->
    pack_return (new image (Image.create p)) ~packing ~show))

let pixmap pm =
  let pl = [param Image.P.pixmap pm#pixmap; param Image.P.mask pm#mask] in
  Misc.all_params pl ~cont:(fun pl ?packing ?show () ->
    pack_return (new image (Image.create pl)) ~packing ~show)

class label_skel obj = object(self)
  inherit misc obj
  inherit label_props
  method text = GtkMiscProps.Label.get_text obj
  method set_text = GtkMiscProps.Label.set_text obj
  method selection_bounds = GtkMiscProps.Label.get_selection_bounds obj
  method select_region = GtkMiscProps.Label.select_region obj
end

class label obj = object
  inherit label_skel (obj : Gtk.label obj)
  method connect = new widget_signals_impl obj
end

let label ?text ?markup ?use_underline ?mnemonic_widget =
  let label, use_markup =
    if markup = None then text, None else markup, Some true in
  let mnemonic_widget = may_map (fun w -> w#as_widget) mnemonic_widget in
  Label.make_params [] ?label ?use_markup ?use_underline ?mnemonic_widget
    ~cont:(
  Misc.all_params ~cont:(fun p ?packing ?show () ->
    pack_return (new label (Label.create p)) ~packing ~show))

let label_cast w = new label (Label.cast w#as_widget)

class tips_query_signals obj = object
  inherit widget_signals_impl (obj : Gtk.tips_query obj)
  inherit tips_query_sigs
end

class tips_query obj = object
  inherit label_skel obj
  method start () = TipsQuery.start_query obj
  method stop () = TipsQuery.stop_query obj
  inherit tips_query_props
  method connect = new tips_query_signals obj
end

let tips_query ?caller =
  let caller = may_map (fun w -> w#as_widget) caller in
  TipsQuery.make_params [] ?caller ~cont:(
  Misc.all_params ~cont:(fun p ?packing ?show () ->
    pack_return (new tips_query (TipsQuery.create p)) ~packing ~show))

class color_selection obj = object
  inherit [Gtk.color_selection] GObj.widget_impl obj
  method connect = new GObj.widget_signals_impl obj
  method set_border_width = set Container.P.border_width obj
  inherit color_selection_props
end

let color_selection =
  ColorSelection.make_params [] ~cont:(
  GContainer.pack_container ~create:
    (fun p -> new color_selection (ColorSelection.create p)))

class font_selection obj = object
  inherit [Gtk.font_selection] widget_impl obj
  inherit font_selection_props
  method event = new event_ops obj
  method connect = new GObj.widget_signals_impl obj
  method set_border_width = set Container.P.border_width obj
end

let font_selection =
  FontSelection.make_params [] ~cont:(
  GContainer.pack_container ~create:
    (fun p -> new font_selection (FontSelection.create p)))