From 5ba1b587618ed09c169655f722bd72d9db82343b Mon Sep 17 00:00:00 2001
From: Nick White <git@njw.me.uk>
Date: Tue, 8 Nov 2011 23:01:19 +0000
Subject: Add gui starpack build rule

---
 getxbookgui.tcl | 30 ++++++++++++++++++++++++++++++
 1 file changed, 30 insertions(+)
 create mode 100755 getxbookgui.tcl

(limited to 'getxbookgui.tcl')

diff --git a/getxbookgui.tcl b/getxbookgui.tcl
new file mode 100755
index 0000000..56b6e63
--- /dev/null
+++ b/getxbookgui.tcl
@@ -0,0 +1,30 @@
+#!/usr/bin/tclsh
+# See COPYING file for copyright and license details.
+package require Tk
+
+set bin [list getgbook getabook]
+
+proc go {} {
+	if { [.id get] == "" } { return }
+	set cmd "[.bin get [.bin curselection]] [.id get]"
+	.dl configure -state disabled -text "downloading"
+	update
+	set out [open "|$cmd 2>@1" "r"]
+	while {![eof $out]} {
+		set a [gets $out]
+		if { $a != "" } { .st configure -text $a }
+		update
+	}
+	.dl configure -state normal -text "download"
+	.st configure -text ""
+}
+
+label .lab -text "book id"
+entry .id
+listbox .bin -listvariable bin -exportselection 0
+.bin selection set 0
+button .dl -text "download" -command go
+label .st -relief sunken -width 20
+
+pack .lab .id .bin .dl .st
+bind . <Return> go
-- 
cgit v1.2.3