/usr/lib/ocaml/lablgtk2/gBroken.mli is in liblablgtk2-ocaml-dev 2.16.0+dfsg-1.
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 | (**************************************************************************)
(*                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 Gobject
open Gtk
open GObj
open GContainer
(** Deprecated widgets
   @gtkdoc gtk Deprecated *)
(** {3 Obsolete GtkTree/GtkTreeItem framework} *)
(** @gtkdoc gtk GtkTreeItem
    @deprecated use {!GTree.view} instead *)
class tree_item_signals : tree_item obj ->
  object
    inherit GContainer.item_signals
    method collapse : callback:(unit -> unit) -> GtkSignal.id
    method expand : callback:(unit -> unit) -> GtkSignal.id
  end
(** @gtkdoc gtk GtkTreeItem
    @deprecated use {!GTree.view} instead *)
class tree_item : Gtk.tree_item obj ->
  object
    inherit GContainer.container
    val obj : Gtk.tree_item obj
    method event : event_ops
    method as_item : Gtk.tree_item obj
    method collapse : unit -> unit
    method connect : tree_item_signals
    method expand : unit -> unit
    method remove_subtree : unit -> unit
    method set_subtree : tree -> unit
    method subtree : tree option
  end
(** @gtkdoc gtk GtkTree 
    @deprecated use {!GTree.view} instead *)
and tree_signals : Gtk.tree obj ->
  object
    inherit GContainer.container_signals
    val obj : Gtk.tree obj
    method select_child : callback:(tree_item -> unit) -> GtkSignal.id
    method selection_changed : callback:(unit -> unit) -> GtkSignal.id
    method unselect_child : callback:(tree_item -> unit) -> GtkSignal.id
  end
(** @gtkdoc gtk GtkTree 
    @deprecated use {!GTree.view} instead *)
and tree : Gtk.tree obj ->
  object
    inherit [tree_item] GContainer.item_container
    val obj : Gtk.tree obj
    method event : event_ops
    method as_tree : Gtk.tree obj
    method child_position : tree_item -> int
    method clear_items : start:int -> stop:int -> unit
    method connect : tree_signals
    method insert : tree_item -> pos:int -> unit
    method remove_items : tree_item list -> unit
    method select_item : pos:int -> unit
    method selection : tree_item list
    method set_selection_mode : Tags.selection_mode -> unit
    method set_view_lines : bool -> unit
    method set_view_mode : [`LINE|`ITEM] -> unit
    method unselect_item : pos:int -> unit
    method private wrap : Gtk.widget obj -> tree_item
  end
(** @gtkdoc gtk GtkTreeItem
    @deprecated use {!GTree.view} instead *)
val tree_item :
  ?label:string ->
  ?packing:(tree_item -> unit) -> ?show:bool -> unit -> tree_item
(** @gtkdoc gtk GtkTree 
    @deprecated use {!GTree.view} instead *)
val tree :
  ?selection_mode:Tags.selection_mode ->
  ?view_mode:[`LINE|`ITEM] ->
  ?view_lines:bool ->
  ?border_width:int ->
  ?width:int ->
  ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> tree
(** {3 Obsolete GtkOldEditable/GtkText framework} *)
class old_editable_signals : ([> Gtk.old_editable ] as 'b) Gtk.obj ->
  object
    inherit GEdit.editable_signals
    val obj : 'b Gtk.obj
    method activate : callback:(unit -> unit) -> GtkSignal.id
    method copy_clipboard : callback:(unit -> unit) -> GtkSignal.id
    method cut_clipboard : callback:(unit -> unit) -> GtkSignal.id
    method move_cursor : callback:(int -> int -> unit) -> GtkSignal.id
    method move_page : callback:(int -> unit) -> GtkSignal.id
    method move_to_column : callback:(int -> unit) -> GtkSignal.id
    method move_to_row : callback:(int -> unit) -> GtkSignal.id
    method move_word : callback:(int -> unit) -> GtkSignal.id
    method paste_clipboard : callback:(unit -> unit) -> GtkSignal.id
 end
class text : Gtk.text Gtk.obj ->
  object
    inherit GEdit.editable
    inherit [Gtk.text] GObj.objvar
    method connect : old_editable_signals
    method backward_delete : int -> unit
    method event : GObj.event_ops
    method forward_delete : int -> unit
    method freeze : unit -> unit
    method hadjustment : GData.adjustment
    method insert :
      ?font:Gdk.font ->
      ?foreground:GDraw.color -> ?background:GDraw.color -> string -> unit
    method length : int
    method line_wrap : bool
    method point : int
    method set_hadjustment : GData.adjustment -> unit
    method set_line_wrap : bool -> unit
    method set_point : int -> unit
    method set_vadjustment : GData.adjustment -> unit
    method set_word_wrap : bool -> unit
    method thaw : unit -> unit
    method vadjustment : GData.adjustment
    method word_wrap : bool
 end
val text :
  ?hadjustment:GData.adjustment ->
  ?vadjustment:GData.adjustment ->
  ?editable: bool ->
  ?line_wrap:bool -> ?word_wrap:bool ->
  ?packing:(widget -> unit) -> ?show:bool -> unit -> text
 |