summaryrefslogtreecommitdiff
path: root/getxbookgui.tcl
blob: 0c5c11635a55b0f9e263ec8ed9db60049f3281d2 (plain)
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
#!/usr/bin/tclsh
# See COPYING file for copyright and license details.
package require Tk

set cmds {{getgbook "Google Book ID / URL" "Google\nBook Preview" \
           "http*://books.google.*/*" {[&?]id=([^&]*)}} \
          {getabook "ISBN 10 / URL" "Amazon Look\nInside The Book" \
           "http*://*amazon*/*" {/([0-9A-Z]{10})/}} \
          {getbnbook "ISBN 13" "Barnes & Noble\nBook Viewer" \
           "http*://www.barnesandnoble.com/*" ""}}
set cmdselected 0
set dling 0
set manual 0

set env(PATH) "[file dirname $::argv0]:$env(PATH)"
set iconpath "[file dirname $::argv0]/icons"

proc updateStatus {chan} {
	global dling
	if {![eof $chan]} {
		set a [gets $chan]
		if { $a != "" } {
			# this string match appears to return true even when it shouldn't on windows
			if { [string match "*%*" "$a"] } {
				# can't rely on the return value of regexp
				if { [regexp {^([0-9]*)} $a m num] && "$num" != "" } {
					.prog coords bar 0 0 [expr $num * 2] 20
				}
			} else { .st configure -text $a }
		}
	} else {
		if { ! [catch {close $chan}] } {
			.st configure -text "[.input.id get] Done"
			.prog coords bar 0 0 200 20
		}
		.dl configure -state normal -text "Download"
		.input.id configure -state normal
		set dling 0
	}
}

proc go {} {
	global dling cmdselected cmds
	if { [.input.id get] == "" } { return }
	set cmd "[lindex [lindex $cmds $cmdselected] 0] [.input.id get]"
	set dling 1
	.dl configure -state disabled -text "Downloading"
	.input.id configure -state readonly
	.st configure -text ""
	.prog configure -bd 1
	.prog itemconfigure bar -state normal
	.prog coords bar 0 0 0 20
	set out [open "|$cmd 2>@1" "r"]
	fileevent $out readable [list updateStatus $out]
}

proc parseurl {url} {
	global cmds
	set newid ""
	set i 0
	foreach b $cmds {
		if { [string match [lindex $b 3] "$url"] } {
			selcmd $i
			set cmdregex [lindex $b 4]
			if {"$cmdregex" != "" && [regexp "$cmdregex" $url m sub]} {
				set newid "$sub"
				.input.id delete 0 end
				.input.id insert 0 "$newid"
			}
		}
		incr i
	}
}

proc checkinput {} {
	if { [string match "http*" [.input.id get]] } {
		parseurl [.input.id get]
	}
}

proc watchsel {} {
	global dling manual

	if { !$dling && !$manual && \
	     ! [catch {set sel "[clipboard get -type UTF8_STRING]"}] } {
		parseurl "$sel"
	}

	after 500 watchsel
}

proc selcmd {sel} {
	global cmds cmdselected

	.cmdfr.$cmdselected configure -relief flat
	set cmdselected $sel
	.cmdfr.$cmdselected configure -relief solid

	.input.lab configure -text [lindex [lindex $cmds $sel] 1]
}

frame .input
label .input.lab
entry .input.id -width 14

frame .cmdfr
set i 0
foreach b $cmds {
	set cmdname [lindex $b 0]
	if { [catch {image create photo im$i -file "$iconpath/$cmdname.gif"}] } {
		image create photo im$i
	}
	button .cmdfr.$i -text [lindex $b 2] -image im$i \
	       -command "selcmd $i" -compound top -relief flat
	pack .cmdfr.$i -side left
	bind .cmdfr.$i <Key> {set manual 1}
	bind .cmdfr.$i <Button> {set manual 1}
	incr i
}
.cmdfr.$cmdselected invoke

button .dl -text "Download" -command go
label .st

canvas .prog -width 200 -height 20 -relief sunken
.prog create rectangle 0 0 0 20 -tags bar -fill black -state hidden

pack .input.lab -side left
pack .input.id

pack .cmdfr .input .dl .prog .st
bind . <Return> go

bind .input.id <Key> {set manual 1; checkinput}
bind .input.id <Button> {set manual 1; checkinput}
bind .input.id <Motion> {checkinput} ;# needed as middle-click pasting isn't passed with <Button>
watchsel