X-Git-Url: http://git.annexia.org/?p=libguestfs-talks.git;a=blobdiff_plain;f=2019-fosdem%2Fnbdview%2Fnbdview.tcl;fp=2019-fosdem%2Fnbdview%2Fnbdview.tcl;h=fa6343e55406023f4e9d60617fd5d55800c86696;hp=0000000000000000000000000000000000000000;hb=7fa686e481dcca96f185aea00e75d4f6df6506b8;hpb=eb2549666cdf6a84c26667bbf9daa30fe19dcc5b

diff --git a/2019-fosdem/nbdview/nbdview.tcl b/2019-fosdem/nbdview/nbdview.tcl
new file mode 100755
index 0000000..fa6343e
--- /dev/null
+++ b/2019-fosdem/nbdview/nbdview.tcl
@@ -0,0 +1,84 @@
+#!/usr/bin/env wish
+# Visualize nbdkit activity - read the README file first!
+# Copyright (C) 2018 Red Hat Inc.
+# All rights reserved.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that the following conditions are
+# met:
+#
+# * Redistributions of source code must retain the above copyright
+# notice, this list of conditions and the following disclaimer.
+#
+# * Redistributions in binary form must reproduce the above copyright
+# notice, this list of conditions and the following disclaimer in the
+# documentation and/or other materials provided with the distribution.
+#
+# * Neither the name of Red Hat nor the names of its contributors may be
+# used to endorse or promote products derived from this software without
+# specific prior written permission.
+#
+# THIS SOFTWARE IS PROVIDED BY RED HAT AND CONTRIBUTORS ''AS IS'' AND
+# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+# THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+# PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL RED HAT OR
+# CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+# SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+# LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
+# USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+# ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
+# OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+# SUCH DAMAGE.
+
+package require Tk
+
+source "nbdcanvas.tcl"
+
+set blocksize 4096
+set width 128
+set scale 2
+
+# This is used to store the canvas handle.
+set h ""
+
+# This function polls the log file (every 100 ms).
+proc poll {} {
+    global h
+
+    nbdpoll $h
+    after 100 poll
+}
+
+# Parse command line.
+if { $argc != 2 } {
+    puts "usage: nbdview logfile size"
+    exit 1
+}
+
+set logfile [lindex $argv 0]
+set size [lindex $argv 1]
+
+# Set up the window.
+wm title . "nbdview $logfile"
+
+# Menubar.
+option add *tearOff 0
+menu .menubar
+. configure -menu .menubar
+menu .menubar.file
+.menubar add cascade -menu .menubar.file -label File
+.menubar.file add command -label "Quit" -command { exit }
+
+# Canvas.
+set h [nbdcanvas .c $logfile $size $blocksize $width $scale]
+pack .c -in . -expand 1 -fill both
+
+# Set the width and height of the window.
+set h_ [expr {[nbdheight $h] * $scale + 40}]
+set w [expr {$width * $scale + 16}]
+wm geometry . "${w}x${h_}"
+wm resizable . false false
+
+# Start polling the log file.
+after 100 poll