rpmdepsize.ml

   1 (* rpmdepsize - visualize the size of RPM dependencies
   2  * (C) Copyright 2009 Red Hat Inc.
   3  *
   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.
   8  *
   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.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17  *
  18  * Written by Richard W.M. Jones <rjones@redhat.com>
  19  * Python script modified from a version by Seth Vidal.
  20  *)
  21
  22 open Sexplib
  23 TYPE_CONV_PATH "."
  24
  25 open ExtList
  26 open Unix
  27 open Printf
  28
  29 let debug = true
  30
  31 (* This corresponds to the sexpr that we write out from the
  32  * Python code.  OCaml will type-check it.
  33  *)
  34 type root_packages = string * packages
  35 and packages = pkg list
  36 and pkg = {
  37   nevra : string;                       (* name-[epoch:]version-release.arch *)
  38   name : string;
  39   epoch : int;
  40   version : string;
  41   release : string;
  42   arch : string;
  43   size : int64;                         (* installed size, excl. dirs *)
  44   deps : string list;
  45 }
  46  with sexp
  47
  48 (* Full dependency representation.  This is actually a graph because
  49  * it contains dependency loops.  'deps list' is a ref because we
  50  * update it as we are building it.
  51  *)
  52 type deps = Deps of pkg * deps list ref
  53
  54 (* Final tree representation, loops removed, and everything we want to
  55  * display stored in the nodes.
  56  *)
  57 type tree = Tree of pkg * int64 * int64 * GDraw.color * tree list
  58
  59 module StringMap = Map.Make (String)
  60 let (+^) = Int64.add
  61 let sum = List.fold_left (+^) 0L
  62 let spaces n = String.make n ' '
  63
  64 (* Python has privileged access to the yum repodata, so we have to use
  65  * this Python snippet to pull the data that we need out.  This is the
  66  * part of the program that takes ages to run, because Python is as
  67  * slow as a fat snake that's just eaten a huge lunch.  We can't help that.
  68  *)
  69 let repoquery_py = "
  70 import yum
  71 import yum.misc
  72 import sys
  73
  74 yb = yum.YumBase ()
  75
  76 basepkg = yb.pkgSack.returnPackages (patterns=[sys.argv[1]])[0]
  77 deps = dict ({basepkg:False})
  78
  79 # Recursively find all the dependencies.
  80 stable = False
  81 while not stable:
  82     stable = True
  83     for pkg in deps.keys():
  84         if deps[pkg] == False:
  85             deps[pkg] = []
  86             stable = False
  87             for r in pkg.requires:
  88                 ps = yb.whatProvides (r[0], r[1], r[2])
  89                 best = yb._bestPackageFromList (ps.returnPackages ())
  90                 if best.name != pkg.name:
  91                     deps[pkg].append (best)
  92                     if not deps.has_key (best):
  93                         deps[best] = False
  94             deps[pkg] = yum.misc.unique (deps[pkg])
  95
  96 # Get the data out of python as fast as possible so we can
  97 # use a serious language for analysis of the tree.
  98 print \"(%s (\" % basepkg
  99 for pkg in deps.keys():
 100     print \"((nevra %s) (name %s) (epoch %s) (version %s) (release %s) (arch %s) (size %s)\" % (pkg, pkg.name, pkg.epoch, pkg.version, pkg.release, pkg.arch, pkg.installedsize)
 101     print \"(deps (\"
 102     for p in deps[pkg]:
 103         print \"%s \" % p,
 104     print \")))\"
 105 sys.stdout.write (\"))\")  # suppress trailing newline"
 106
 107 let () =
 108   printf "getting repository information (this can take a few seconds ...)\n%!";
 109
 110   (* Run the Python program and read in the generated sexpr. *)
 111   let cmd =
 112     sprintf "python -c %s %s"
 113       (Filename.quote repoquery_py) (Filename.quote Sys.argv.(1)) in
 114   let chan = open_process_in cmd in
 115   ignore (input_line chan); (* drop "Loaded plugins" *)
 116   let root, pkgs =
 117     root_packages_of_sexp (Sexp.of_string (Std.input_all chan)) in
 118   (match close_process_in chan with
 119    | WEXITED 0 -> ()
 120    | WEXITED i -> failwith (sprintf "command exited with status %d" i)
 121    | WSIGNALED i | WSTOPPED i ->
 122        failwith (sprintf "command stopped with signal %d" i)
 123   );
 124
 125   if debug then (
 126     List.iter (
 127       fun pkg -> printf "%s -> [%s]\n" pkg.nevra (String.concat ", " pkg.deps)
 128     ) pkgs;
 129     printf "root package is %s\n" root;
 130     printf "===\n%!"
 131   );
 132
 133   (* Create the dependency graph, probably contains loops so beware. *)
 134   let deps = List.map (fun pkg -> Deps (pkg, ref [])) pkgs in
 135   let depsmap =
 136     List.fold_left (
 137       fun map (Deps (pkg, _) as deps) ->
 138         StringMap.add pkg.nevra deps map
 139     ) StringMap.empty deps in
 140   List.iter (
 141     fun (Deps (pkg, deps)) ->
 142       let deps' = List.map (fun n -> StringMap.find n depsmap) pkg.deps in
 143       deps := List.append !deps deps'
 144   ) deps;
 145   let deps = () in ignore deps;
 146
 147   if debug then (
 148     let seen = ref StringMap.empty in
 149     let rec display ?(indent=0) = function
 150       | Deps (pkg, deps) ->
 151           if StringMap.mem pkg.nevra !seen then
 152             printf "%s%s -> ...\n" (spaces indent) pkg.nevra
 153           else (
 154             printf "%s%s -> [%s]\n"
 155               (spaces indent) pkg.nevra (
 156                 String.concat ", "
 157                   (List.map (fun (Deps (pkg, _)) -> pkg.nevra) !deps)
 158               );
 159             seen := StringMap.add pkg.nevra true !seen;
 160             List.iter (display ~indent:(indent+2)) !deps
 161           )
 162     in
 163     display (StringMap.find root depsmap);
 164     printf "===\n%!"
 165   );
 166
 167   (* For each package, calculate the total installed size of the package,
 168    * which includes all subpackages pulled in.  So it's what would be
 169    * installed if you did 'yum install foo'.
 170    *)
 171   let total pkg =
 172     let seen = ref StringMap.empty in
 173     let rec _total = function
 174       | Deps (pkg, _) when StringMap.mem pkg.nevra !seen -> 0L
 175       | Deps (pkg, { contents = children }) ->
 176           seen := StringMap.add pkg.nevra true !seen;
 177           pkg.size +^ sum (List.map _total children)
 178     in
 179     _total (StringMap.find pkg.nevra depsmap)
 180   in
 181   let totalsmap =
 182     List.fold_left (
 183       fun map pkg -> StringMap.add pkg.nevra (total pkg) map
 184     ) StringMap.empty pkgs in
 185
 186   (* Create the final display tree.  Each node is sorted so that
 187    * children with the largest contribution come first (on the left).
 188    * We remove packages which are already installed by earlier
 189    * (leftward) packages.  At each node we also store total size and
 190    * size of the additional packages.
 191    *)
 192   let tree =
 193     let seen = StringMap.empty in
 194     let seen = StringMap.add root true seen in
 195     let seen = ref seen in
 196     let mark_seen (Deps (pkg, _))= seen := StringMap.add pkg.nevra true !seen in
 197     let not_seen (Deps (pkg, _)) = not (StringMap.mem pkg.nevra !seen) in
 198     let rec build_tree = function
 199       | Deps (pkg, { contents = children }) ->
 200           (* Sort children by reverse total size. *)
 201           let cmp (Deps (p1, _)) (Deps (p2, _)) =
 202             let t1 = StringMap.find p1.nevra totalsmap in
 203             let t2 = StringMap.find p2.nevra totalsmap in
 204             compare t2 t1
 205           in
 206           let children = List.sort ~cmp children in
 207           let children = List.filter not_seen children in
 208           List.iter mark_seen children;
 209           let children = List.map build_tree children in
 210           let total = StringMap.find pkg.nevra totalsmap in
 211           let increm =
 212             let rec sum_child_sizes = function
 213               | Tree (pkg, _, _, _, children) ->
 214                   List.fold_left (
 215                     fun size child -> size +^ sum_child_sizes child
 216                   ) pkg.size children
 217             in
 218             sum_child_sizes (Tree (pkg, 0L, 0L, `WHITE, children)) in
 219           Tree (pkg, total, increm, `WHITE, children)
 220     in
 221     build_tree (StringMap.find root depsmap) in
 222
 223   if debug then (
 224     let rec display ?(indent=0) = function
 225       | Tree (pkg, total, increm, _, children) ->
 226           printf "%s%s %Ld/%Ld/%Ld\n%!"
 227             (spaces indent) pkg.nevra pkg.size increm total;
 228           List.iter (display ~indent:(indent+2)) children
 229     in
 230     display tree;
 231   );
 232
 233   (* Max depth of the tree. *)
 234   let depth =
 235     let rec depth = function
 236       | Tree (pkg, _, _, _, children) ->
 237           List.fold_left (fun d c -> max d (1 + depth c)) 1 children
 238     in
 239     depth tree in
 240
 241   (* Allocate a colour to each node in the tree based on its parent.  The
 242    * single top node is always light grey.  The second level nodes are
 243    * primary colours.
 244    *)
 245   let tree =
 246     let Tree (pkg, total, increm, _, level2) = tree in
 247     let level2 =
 248       let pcols = [
 249         `RGB (55000, 0, 0);
 250         `RGB (0, 55000, 0);
 251         `RGB (0, 0, 55000);
 252         `RGB (55000, 55000, 0);
 253         `RGB (0, 55000, 55000);
 254       ] in
 255       let rec colour_level2 cols = function
 256         | [] -> []
 257         | Tree (pkg, total, increm, _, level3) :: level2 ->
 258             let col, cols = match cols with
 259               | [] -> List.hd pcols, List.tl pcols
 260               | col :: cols -> col, cols in
 261             let level3 = colour_level3 col (List.length level3) 0 level3 in
 262             Tree (pkg, total, increm, col, level3)
 263             :: colour_level2 cols level2
 264       and colour_level3 col n i = function
 265         | [] -> []
 266         | Tree (pkg, total, increm, _, leveln) :: level3 ->
 267             let col = scale_colour col n i in
 268             let leveln = colour_level3 col (List.length leveln) 0 leveln in
 269             Tree (pkg, total, increm, col, leveln)
 270             :: colour_level3 col n (i+1) level3
 271       and scale_colour col n i =
 272         let r, g, b = match col with
 273           | `RGB (r, g, b) -> float r, float g, float b
 274           | _ -> assert false in
 275         let i = float i and n = float n in
 276         let scale = 0.8 +. i/.(5.*.n) in
 277         let r = r *. scale in
 278         let g = g *. scale in
 279         let b = b *. scale in
 280         `RGB (int_of_float r, int_of_float g, int_of_float b)
 281       in
 282       colour_level2 pcols level2 in
 283     Tree (pkg, total, increm, `RGB (55000, 55000, 55000), level2) in
 284
 285   (* top_total is the total size in bytes of everything.  Used for
 286    * relative display of percentages, widths, etc.
 287    *)
 288   let Tree (_, top_total, top_increm, _, _) = tree in
 289   assert (top_total = top_increm);
 290
 291   (* Useful display functions. *)
 292   let display_percent bytes =
 293     100. *. Int64.to_float bytes /. Int64.to_float top_total
 294
 295   and display_size bytes =
 296     if bytes > 104_857L then
 297       sprintf "%.1f MB" (Int64.to_float bytes /. 1_048_576.)
 298     else if bytes > 102L then
 299       sprintf "%.1f KB" (Int64.to_float bytes /. 1_024.)
 300     else
 301       sprintf "%Ld" bytes
 302   in
 303
 304   (* Open the window. *)
 305   let title = root ^ " - Fedora RPM dependency size viewer" in
 306   let window =
 307     GWindow.window ~width:800 ~height:600 ~title ~allow_shrink:true () in
 308
 309   ignore (window#connect#destroy ~callback:GMain.quit);
 310
 311   let da = GMisc.drawing_area ~packing:window#add () in
 312   da#misc#realize ();
 313   let draw = new GDraw.drawable da#misc#window in
 314
 315   (* Need to enable these mouse events so we can do tooltips. *)
 316   GtkBase.Widget.add_events da#as_widget
 317     [`ENTER_NOTIFY; `LEAVE_NOTIFY; `POINTER_MOTION];
 318
 319   let tooltips = ref None in
 320
 321   (* To track tooltips, the 'repaint' function records the location of
 322    * each box (ie. package) in the drawing area in this private data
 323    * structure, and the 'motion' function looks them up in order to
 324    * display the right tooltip over each box.
 325    *)
 326   let add_locn, reset_locns, get_locn =
 327     let rows = ref [||] in
 328     let rowheight = ref 0. in
 329
 330     let reset_locns rowheight' depth =
 331       (* This data structure sucks because we just do a linear search
 332        * over each row when looking up the 'x'.  Should use some sort
 333        * of self-balancing tree instead.  XXX
 334        *)
 335       rows := Array.init depth (fun _ -> ref []);
 336       rowheight := rowheight'
 337     and add_locn x yi width thing =
 338       let row = (!rows).(yi) in
 339       row := ((x, x +. width), thing) :: !row
 340     and get_locn x y =
 341       let yi = int_of_float (y /. !rowheight) in
 342       if yi >= 0 && yi < Array.length !rows then (
 343         let row = !((!rows).(yi)) in
 344         try Some
 345           (snd (List.find (fun ((xlow, xhi), thing) ->
 346                              xlow <= x && x < xhi)
 347                   row))
 348         with Not_found -> None
 349       )
 350       else None
 351     in
 352     add_locn, reset_locns, get_locn
 353   in
 354
 355   (* Pango contexts used to draw large and small text. *)
 356   let pango_large_context = da#misc#create_pango_context in
 357   pango_large_context#set_font_description (Pango.Font.from_string "Sans 12");
 358   let pango_small_context = da#misc#create_pango_context in
 359   pango_small_context#set_font_description (Pango.Font.from_string "Sans 8");
 360
 361   let repaint _ =
 362     (* Get the canvas size and fill the background with white. *)
 363     let width, height = draw#size in
 364     draw#set_background `WHITE;
 365     draw#set_foreground `WHITE;
 366     draw#rectangle ~x:0 ~y:0 ~width ~height ~filled:true ();
 367
 368     (* Calculate the scales so we can fit everything into the window. *)
 369     let rowheight = float height /. float depth in
 370     let scale = float width /. Int64.to_float top_total in
 371
 372     reset_locns rowheight depth;
 373
 374     (* Now draw the tree. *)
 375     let rec draw_tree x yi = function
 376       | Tree (pkg, total, increm, colour, children) ->
 377           (* Draw pkg at (x, y). *)
 378           let y = float yi *. rowheight in
 379           let width = scale *. Int64.to_float increm in
 380           let pkgsizewidth = scale *. Int64.to_float pkg.size in
 381           draw_pkg x yi y width pkgsizewidth rowheight colour pkg total increm;
 382
 383           (* Draw the children of pkg at (i, y + rowheight), where
 384            * i starts as x and increments for each child.
 385            *)
 386           let yi = yi + 1 in
 387           let rec loop x = function
 388             | [] -> ()
 389             | child :: children ->
 390                 draw_tree x yi child;
 391                 let Tree (_, _, increm, _, _) = child in
 392                 let childwidth = scale *. Int64.to_float increm in
 393                 loop (x +. childwidth) children
 394           in
 395           loop x children
 396
 397     (* Draw a single package. *)
 398     and draw_pkg x yi y width pkgsizewidth height colour pkg total increm =
 399       add_locn x yi width (colour, pkg, total, increm);
 400
 401       let x = int_of_float x in
 402       let y = int_of_float y in
 403       let width = int_of_float width in
 404       let pkgsizewidth = int_of_float pkgsizewidth in
 405       let height = int_of_float height in
 406
 407       if width > 8 then (
 408         draw_pkg_outline x y width pkgsizewidth height colour;
 409         draw_pkg_label x y width height colour pkg total increm
 410       )
 411       else if width >= 4 then
 412         draw_pkg_narrow x y width height colour
 413       (* else
 414          XXX This doesn't work.  We need to coalesce small packages
 415          in the tree.
 416         draw_pkg_narrow x y 1 height colour *)
 417
 418     and draw_pkg_outline x y width pkgsizewidth height colour =
 419       draw#set_foreground colour;
 420       draw#rectangle ~x:(x+2) ~y:(y+2)
 421         ~width:(width-4) ~height:(height-4)
 422         ~filled:true ();
 423       if pkgsizewidth > 2 then (
 424         draw#set_foreground (darken colour);
 425         draw#rectangle ~x:(x+2) ~y:(y+2)
 426           ~width:(pkgsizewidth-2) ~height:(height-4)
 427           ~filled:true ();
 428         draw#set_foreground (choose_contrasting_colour colour);
 429         draw#set_line_attributes ~style:`ON_OFF_DASH ();
 430         draw#line (x+pkgsizewidth) (y+2) (x+pkgsizewidth) (y+height-2);
 431         draw#set_line_attributes ~style:`SOLID ()
 432       );
 433       draw#set_foreground (`BLACK);
 434       draw#rectangle ~x:(x+2) ~y:(y+2)
 435         ~width:(width-4) ~height:(height-4)
 436         ~filled:false ()
 437
 438     and draw_pkg_label x y width height colour pkg total increm =
 439       (* How to write text in a drawing area, in case it's not
 440        * obvious, which it certainly is not:
 441        * http://www.math.nagoya-u.ac.jp/~garrigue/soft/olabl/lablgtk-list/120.txt
 442        *)
 443       (* txt1 is the same as the tooltip. *)
 444       let txt1 = lazy (
 445         let txt = pango_large_context#create_layout in
 446         Pango.Layout.set_text txt (
 447           sprintf "%s
 448 Package: %.1f%% %s (%Ld bytes)
 449 Incremental: %.1f%% %s (%Ld bytes)
 450 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
 451 (display_percent pkg.size) (display_size pkg.size) pkg.size
 452 (display_percent increm) (display_size increm) increm
 453 (display_percent total) (display_size total) total
 454         );
 455         txt
 456       )
 457       and txt2 = lazy (
 458         let txt = pango_small_context#create_layout in
 459         Pango.Layout.set_text txt (
 460           sprintf "%s
 461 Package: %.1f%% %s (%Ld bytes)
 462 Incremental: %.1f%% %s (%Ld bytes)
 463 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
 464 (display_percent pkg.size) (display_size pkg.size) pkg.size
 465 (display_percent increm) (display_size increm) increm
 466 (display_percent total) (display_size total) total
 467         );
 468         txt
 469       )
 470       and txt3 = lazy (
 471         let txt = pango_small_context#create_layout in
 472         Pango.Layout.set_text txt (
 473           sprintf "%s
 474 Pkg: %.1f%% %s (%Ld bytes)
 475 Incr: %.1f%% %s (%Ld bytes)
 476 Tot: %.1f%% %s (%Ld bytes)" pkg.name
 477 (display_percent pkg.size) (display_size pkg.size) pkg.size
 478 (display_percent increm) (display_size increm) increm
 479 (display_percent total) (display_size total) total
 480         );
 481         txt
 482       )
 483       and txt4 = lazy (
 484         let txt = pango_small_context#create_layout in
 485         Pango.Layout.set_text txt (
 486           sprintf "%s
 487 Pkg: %.1f%% %s
 488 Incr: %.1f%% %s
 489 Tot: %.1f%% %s" pkg.name
 490 (display_percent pkg.size) (display_size pkg.size)
 491 (display_percent increm) (display_size increm)
 492 (display_percent total) (display_size total)
 493         );
 494         txt
 495       )
 496       and txt5 = lazy (
 497         let txt = pango_small_context#create_layout in
 498         Pango.Layout.set_text txt (
 499           sprintf "%s\nPkg: %.1f%%\nIncr: %.1f%%\nTot: %.1f%%"
 500             pkg.name
 501             (display_percent pkg.size)
 502             (display_percent increm)
 503             (display_percent total)
 504         );
 505         txt
 506       )
 507       and txt6 = lazy (
 508         let txt = pango_small_context#create_layout in
 509         Pango.Layout.set_text txt (
 510           sprintf "%s Pkg: %.1f%% %s Incr: %.1f%% %s Tot: %.1f%% %s" pkg.name
 511             (display_percent pkg.size) (display_size pkg.size)
 512             (display_percent increm) (display_size increm)
 513             (display_percent total) (display_size total)
 514         );
 515         txt
 516       )
 517       and txt7 = lazy (
 518         let txt = pango_small_context#create_layout in
 519         Pango.Layout.set_text txt (
 520           sprintf "%s %.1f%% %.1f%% %.1f%%" pkg.name
 521             (display_percent pkg.size)
 522             (display_percent increm)
 523             (display_percent total)
 524         );
 525         txt
 526       )
 527       and txt8 = lazy (
 528         let txt = pango_small_context#create_layout in
 529         Pango.Layout.set_text txt (
 530           sprintf "%s" pkg.name
 531         );
 532         txt
 533       ) in
 534       let txts = [ txt1; txt2; txt3; txt4; txt5; txt6; txt7; txt8 ] in
 535
 536       let fore = choose_contrasting_colour colour in
 537
 538       let rec loop = function
 539         | [] -> ()
 540         | txt :: txts ->
 541             let txt = Lazy.force txt in
 542             let { Pango.width = txtwidth;
 543                   Pango.height = txtheight } =
 544               Pango.Layout.get_pixel_extent txt in
 545             (* Now with added fudge-factor. *)
 546             if width >= txtwidth + 8 && height >= txtheight + 8 then
 547               draw#put_layout ~x:(x+4) ~y:(y+4) ~fore txt
 548             else loop txts
 549       in
 550       loop txts
 551
 552     and draw_pkg_narrow x y width height colour =
 553       draw#set_foreground colour;
 554       draw#rectangle ~x:(x+2) ~y:(y+2)
 555         ~width:(width-4) ~height:(height-4) ~filled:true ()
 556
 557     and choose_contrasting_colour = function
 558       | `RGB (r, g, b) ->
 559           if r + g + b > 98304 then `BLACK else `WHITE
 560       | _ -> `WHITE
 561
 562     and darken = function
 563       | `RGB (r, g, b) ->
 564           `RGB (r * 9 / 10, g * 9 / 10, b * 9 / 10)
 565       | _ -> `WHITE
 566     in
 567     draw_tree 0. 0 tree;
 568
 569     (* Return false because this is a Gtk event handler. *)
 570     false
 571   in
 572   ignore (da#event#connect#expose ~callback:repaint);
 573
 574   let motion ev =
 575     let x, y = GdkEvent.Motion.x ev, GdkEvent.Motion.y ev in
 576
 577     let kill_tooltip () =
 578       (match !tooltips with
 579        | None -> ()
 580        | Some (tt : GData.tooltips) ->
 581            tt#set_tip ~text:"" (da :> GObj.widget);
 582            tt#disable ()
 583       );
 584       tooltips := None
 585     in
 586
 587     (match get_locn x y with
 588      | None ->
 589          kill_tooltip ()
 590      | Some (colour, pkg, total, increm) ->
 591          (* The only way to make the tooltip follow the mouse is to
 592           * kill the whole tooltips object and recreate it each time ...
 593           *)
 594          kill_tooltip ();
 595          let tt = GData.tooltips ~delay:100 () in
 596          (* Tooltip text is the same as txt1. *)
 597          let text = sprintf "%s
 598 Package: %.1f%% %s (%Ld bytes)
 599 Incremental: %.1f%% %s (%Ld bytes)
 600 Total: %.1f%% %s (%Ld bytes)" pkg.nevra
 601 (display_percent pkg.size) (display_size pkg.size) pkg.size
 602 (display_percent increm) (display_size increm) increm
 603 (display_percent total) (display_size total) total in
 604          tt#set_tip ~text (da :> GObj.widget);
 605          tt#enable ();
 606          tooltips := Some tt
 607     );
 608
 609     (* Return false because this is a Gtk event handler. *)
 610     false
 611   in
 612
 613   ignore (da#event#connect#motion_notify ~callback:motion);
 614
 615   window#show ();
 616   GMain.main ()