1#!bin/sh
2#the next line restarts using wish \
3exec /usr/local/bin/wish -f "$0" ${1+"$@"}
4
5# robot --
6# This script allows the user of the libwww web robot to issue
7# commands to the robot by checking options and clicking buttons.
8#
9# MK, manoli@w3.org, Manolis Kamvysselis, 96/07/01
10
11#***********************************************************
12#Init = initialization and stuff that changes from platform
13#Init: initial values for variables
14set url "http://www.w3.org/pub/WWW/"
15
16#init: id number for dialog boxes
17set id 0
18
19#Init: Platform and computer dependent variables
20proc InitPath {} {
21	global path webbot weblog webout webrules path source editor \
22			webbot-path weblog-path webout-path webrules-path
23	if [file exists webprefs] {
24		LoadPreferences
25	} else {
26		#prefs file does not exist: prompt user
27		Dialog "File webprefs not found. \n \
28			Would you like to create a new file \
29			in the current directory?" \
30			{create set cancel} \
31			{"Create File with Default Preferences" "Set Default Preferences" "Cancel"} \
32			{{SetDefaultPreferences; SavePreferences} SetDefaultPreferences ""}
33	}
34}
35
36#procedure to create a dialog box displaying a message,
37#defaults to ok and cancel, spelling Ok and Cancel and doing nothing
38proc Dialog {message {buttons {ok cancel}} {names {"ok" "cancel"}} {commands {"" ""}}} {
39	global id
40	set id [expr $id + 1]
41	if {"winfo exists .dialog$id" == 1} {
42		wm withdraw .dialog$id
43	}
44	toplevel .dialog$id
45	wm title .dialog$id "Dialog Box"
46	message .dialog$id.msg -aspect 1000 -text $message
47	pack .dialog$id.msg -side top
48	frame .dialog$id.buttons
49	foreach button $buttons {
50		set name [lindex $names [lsearch -exact $buttons $button]]
51		set command [lindex $commands [lsearch -exact $buttons $button]]
52		button .dialog$id.buttons.$button -text $name -command "wm withdraw .dialog$id; $command"
53		pack .dialog$id.buttons.$button -side left
54	}
55	pack .dialog$id.buttons -side bottom
56}
57
58#Window: name the window and set up bindings
59proc SetWindow {} {
60	wm title . "W3C Web Robot user interface"
61
62	#key bindings equivalents to buttons
63	bind . <Return> Start
64	bind . <Control-x> exit
65	bind . <Control-q> exit
66	bind . <Control-p> AskPreferences
67}
68
69#***********************************************************
70#Menu: preferences for paths, and stuff all in a menu
71proc SetMenus {} {
72	global webbot source
73	#creates three menubuttons File, Edit, About
74	frame .menu
75	foreach which {file edit help} {
76		set Capitalized ""
77		append Capitalized [string toupper [string index $which 0]] \
78			[string range $which 1 end]
79		menubutton .menu.$which -text $Capitalized -menu .menu.$which.menu
80		pack .menu.$which -side left
81	}
82	pack .menu -side top -fill x
83
84	#Menu: Robot: files to be used for output, log, and executable of the robot
85	set mfile [menu .menu.file.menu]
86	$mfile add command -label Run -command Start
87	$mfile add command -label "Edit Source" -command {exec $editor $source}
88	$mfile add separator
89	$mfile add command -label "Load Prefs..." -command {
90		Dialog "Load Preferences: This will discard the current Preferences" \
91		{ok set cancel} \
92		{"Go ahead" "View Current Preferences" "Abort the Mission"} \
93		{LoadPreferences AskPreferences ""}
94	}
95	$mfile add command -label "Save Prefs..." -command {
96		Dialog "Save Preferences: This will discard the Preferences Saved Previously" \
97		{ok set cancel} \
98		{"Go ahead" "View Current Preferences" "Abort the Mission"} \
99		{SavePreferences AskPreferences ""}
100	}
101	$mfile add separator
102	$mfile add command -label Preferences... -command AskPreferences
103	$mfile add separator
104	$mfile add command -label Quit -command exit
105
106	#Menu: edit copy paste and stuff
107	set medit [menu .menu.edit.menu]
108	$medit add command -label "Copy and Paste Url" -command CopyAndPasteUrl
109	$medit add command -label "Follow URL" -command FollowUrl
110
111	#Menu: about: version of the robot, and about the program
112	set mhelp [menu .menu.help.menu]
113	set blablahelp {"		To fetch links from a URL, enter the url and click webbot.
114
115		To follow a URL returned, double click in the log, on the line of the
116
117		URL that you want to follow.
118
119		To simply copy a URL to the URL entry, so you can edit it afterwards,
120
121		click the left then the right button on the corresponding line of the log. 		"}
122	$mhelp add command -label "Using" -command "Dialog $blablahelp ok Cool {}"
123
124	$mhelp add command -label "About the Robot" -command ShowVersion
125	set blablatext {"		Welcome to the W3C mini robot user interface.
126
127		The selections that you make below, or in the preferences, are
128
129		translated and passed on to the W3C mini robot, part of the
130
131		w3c test library.
132
133
134		Have fun!!"}
135	$mhelp add command -label "About this Program" -command "Dialog $blablatext ok Thanx {}"
136}
137
138#***********************************************************
139#Prefs: window to prompt for preferences
140proc AskPreferences {} {
141	global editor source path webbot weblog webrules
142	toplevel .prefs
143	wm title .prefs "W3C WebRobot User Preferences"
144
145	#Editor: Which editor to use to edit the source
146	frame .prefs.editor
147	label .prefs.editor.l -text Editor:
148	entry .prefs.editor.path -textvariable editor
149	pack .prefs.editor.l -side left
150	pack .prefs.editor.path -side left -expand true -fill x
151	pack .prefs.editor -side top -fill x
152
153	#***********************************************************
154	#Edit: where to find the source of robot.tcl and editor to launch
155	frame .prefs.edit
156	label .prefs.edit.l -text Source:
157	entry .prefs.edit.source -textvariable source
158	button .prefs.edit.edit -text Edit -command {exec $editor $source}
159	pack .prefs.edit.l -side left
160	pack .prefs.edit.source -side left -fill x -expand true
161	pack .prefs.edit.edit -side right
162	pack .prefs.edit -side top -fill x
163
164	#***********************************************************
165	#Path: Choose the common path of webbot weblog and webrules
166	frame .prefs.path
167	checkbutton .prefs.path.common -text Common -variable common \
168		-onvalue "Same" -offvalue "Different" -command {SetPath$common}
169	.prefs.path.common select
170	label .prefs.path.l -text Path:
171	entry .prefs.path.webbot -width 50 -relief sunken -textvariable path
172	bind .prefs.path.webbot <KeyRelease> {SetPath$common}
173	pack .prefs.path.common .prefs.path.l -side left
174	pack .prefs.path.webbot -side left -expand true
175	pack .prefs.path -side top -fill x
176
177	#***********************************************************
178	#SetPath*: procedures to set the path
179	proc SetPathSame {} {
180		global path
181		foreach what {bot log rules out} {
182			global web$what web$what-path
183			set web$what ""
184			append web$what $path [set web$what-path]
185		}
186	}
187	proc SetPathDifferent {} {
188		foreach what {bot log rules out} {
189			global web$what web$what-path
190			set web$what [set web$what-path]
191		}
192	}
193
194	#***********************************************************
195	#Log: choose the log file
196	array set Text {bot Webbot: log "Log File:" rules "Rules File:" \
197				out "Output File:"}
198	array set Value {bot webbot.exe log www-log rules www-rule out www-out}
199	foreach what {bot log rules out} {
200		global web$what web$what-path
201		frame .prefs.$what
202		set web$what-path $Value($what)
203		label .prefs.$what.l -text $Text($what)
204		entry .prefs.$what.path -textvariable web$what-path
205		bind .prefs.$what.path <KeyRelease> {
206			global what
207			SetPath$common
208		}
209		label .prefs.$what.show -textvariable web$what -width 30
210		pack .prefs.$what.l -side left
211		pack .prefs.$what.path -side left -expand true -fill x
212		pack .prefs.$what.show -side right -expand true
213		pack .prefs.$what -side top -fill x
214	}
215
216	#***********************************************************
217	#Buttons: What to do once the preferences are set
218	frame .prefs.buttons
219	button .prefs.buttons.set -text "Set" -command ClosePrefsWindow
220	button .prefs.buttons.save -text "Save" -command "SavePreferences; ClosePrefsWindow"
221	button .prefs.buttons.load -text "Load" -command "LoadPreferences; ClosePrefsWindow"
222	button .prefs.buttons.edit -text "Edit" -command "$editor ${path}Webprefs"
223	foreach which {set save load edit} {
224		pack .prefs.buttons.$which -side left
225	}
226	pack .prefs.buttons -side top
227
228	proc ClosePrefsWindow {} {
229		wm withdraw .prefs
230	}
231}
232
233#prefs: initialize preferences, without saving them to a file
234proc SetDefaultPreferences {} {
235	global path source editor webbot-path weblog-path webrules-path webout-path
236	set source ""
237	set path [pwd]\\
238	lappend source $path Robot.tcl
239	set editor "C:\\Program Files\\Accessories\\WordPad.exe"
240	set webbot-path webbot.exe
241	set weblog-path www-log
242	set webrules-path webrules
243	set webout-path www-out
244	foreach what {bot log out rules} {
245		global path web$what web$what-path
246		set web$what ""
247		append web$what $path [set web$what-path]
248	}
249}
250
251#prefs: Load preferences from webprefs
252proc LoadPreferences {} {
253	global editor source path webbot weblog webrules
254	Status Loading Preferences...
255	if [file exists webprefs] {
256		#the file webprefs exists: read the preferences
257		if [catch {open webprefs r} file] {
258			#file can't be read
259			Dialog "File Unreadable" ok "OK" ""
260		} else {
261			#file can be read
262			while {! [eof $file]} {
263				#still lines to read
264				gets $file line
265				if {[string compare # [string index $line 0]] == 0} {
266					#ignores commented lines
267				} else {
268					#assuming line of the form variable:value
269					set pair [split $line :]
270					set variable [lindex $pair 0]
271					set value [join [lrange $pair 1 [llength $pair]] :]
272					global $variable
273					set $variable $value
274					Log "setting $variable to $value"
275				}
276			}
277			close $file
278			TraceToButtons
279		}
280	} else {
281		#file webprefs does not exist
282		Dialog "		File WebPrefs does not Exist.
283		Create a file WebPrefs in the current directory?
284		Current Directory: [pwd]		"\
285		{create default cancel} \
286		{"Create File with Default Preferences" "Set default Preferences" "Cancel"} \
287		{{SetDefaultPreferences; SavePreferences} SetDefaultPreferences ""}
288	}
289	Status Done
290}
291
292#prefs: create the prefs file to hold the preferences
293proc SavePreferences {} {
294	set file [open webprefs w 0600]
295	puts $file "#This file is created by webbot.tcl"
296	puts $file "#It contains the preferences for running the w3c mini robot"
297	foreach variable {path source editor webbot webbot-path weblog weblog-path webout webout-path \
298		webrules webrules-path trace img ss url} {
299		global $variable
300		puts $file $variable:[set $variable]
301		Log Writing:$variable:[set $variable]
302	}
303	close $file
304}
305
306#***********************************************************
307#nav: Navigation method, and depth
308proc SetNav {} {
309	frame .nav
310	set nav dumb
311	label .nav.l1 -text "Navigation method:" -relief ridge
312	pack .nav.l1 -side left
313	frame .nav.choice
314	foreach choice {dumb parallel deep strategic} {
315		radiobutton .nav.choice.$choice -text $choice -value $choice -variable nav
316		pack .nav.choice.$choice -side left
317	}
318	pack .nav.choice -side left
319
320	#nav: links: Number of links to follow
321	frame .nav.links
322	label .nav.links.l -text "Depth:" -relief ridge
323	set links 0
324	set link ""
325	entry .nav.links.entry -textvariable links -width 3 -relief flat
326	bind .nav.links.entry <KeyRelease> SetLink
327	proc SetLink {} {
328		global links link
329		if {[string compare $links ""] == 0} {
330			set link ""
331		} elseif {$links != 0} {
332			set link ""
333			append link "-link " $links
334		} else {
335			set link ""
336		}
337	}
338	label .nav.links.show -textvariable link
339	foreach packing {l entry show} {
340		pack .nav.links.$packing -side left
341	}
342	pack .nav.links -side left
343	pack .nav -side top -fill x
344}
345
346#***********************************************************
347#Trace: Tracing information on the robot
348proc SetTrace {} {
349	global trace traced
350	set trace ""
351	frame .trace
352
353	#Trace: title, variable, and button for debugging
354	frame .trace.title
355	label .trace.title.l -text "Trace messages relevant to:" -relief ridge
356	button .trace.title.all -text Everything -command TraceAll
357	button .trace.title.none -text Nothing -command TraceNone
358	pack .trace.title.l .trace.title.all .trace.title.none -side left
359	label	.trace.title.display -textvariable trace -justify left -width 10
360	foreach whichbutton {l all none display} {
361		pack .trace.title.$whichbutton -side left
362	}
363
364	#***********************************************************
365	#Info: Retrieving Information
366	frame .trace.title.info
367	checkbutton .trace.title.info.version -text Version -command ShowVersion
368
369	#Info: Checking the images of the documents
370	checkbutton .trace.title.info.img -text "Images" \
371		-variable img -onvalue "-img" -offvalue ""
372
373	#Info: Date and Time of the job
374	checkbutton .trace.title.info.ss -text "Time Log" \
375		-variable ss -onvalue "-ss" -offvalue ""
376
377	#Info: Packing the buttons
378	foreach packing {version img ss} {
379		pack .trace.title.info.$packing -side left
380	}
381	pack .trace.title.info -side left
382	pack .trace.title -side top -fill x
383
384	#Trace: buttons to choose tracing options
385	frame .trace.buttons
386
387	#matching up the names and letters
388	array set tracing {a "anchors" b "bindings to local files"
389		c "cache" g "SGML" p "protocol" s "sgml/html" t "threads" u "url"}
390	foreach letter {a b c g p s t u} {
391		checkbutton .trace.buttons.$letter -text $tracing($letter) \
392			-variable traced($letter) -command ButtonsToTrace
393		pack .trace.buttons.$letter -side left -anchor w
394	}
395	pack .trace.buttons -side top -fill x -expand true
396	pack .trace -side top -fill x
397
398	#Trace: tracing everything or nothing
399	proc TraceAll {} {
400		global traced ss img
401		foreach letter {a b c g p s t u} {
402			set traced($letter) 1
403		}
404		ButtonsToTrace
405		set img "-img"
406		set ss "-ss"
407	}
408	proc TraceNone {} {
409		global traced img ss
410		foreach letter {a b c g p s t u} {
411			set traced($letter) 0
412		}
413		ButtonsToTrace
414		set img ""
415		set ss ""
416	}
417}
418
419#Trace: Showing the Version
420proc ShowVersion {} {
421	global webbot
422	catch {exec $webbot "-version"} results
423	Log $results
424}
425
426#Trace: setting up the buttons from the variable trace
427proc TraceToButtons {} {
428	global trace traced
429	if {[string compare $trace "-v"] == 0} {set trace -vabcgpstu}
430	foreach letter {a b c g p s t u} {
431		global traced($letter)
432		Log "traced($letter) = [set traced($letter)]"
433		if "[string match *$letter* $trace] == 1" {
434			set traced($letter) 1
435		} else {
436			set traced($letter) 0
437		}
438	}
439	if {[string compare $trace "-vabcgpstu"] == 0} {set trace -v}
440}
441
442#Trace: calculating what to trace from the user's selections
443proc ButtonsToTrace {} {
444	global trace traced
445	set trace "-v"
446	foreach letter {a b c g p s t u} {
447		if {$traced($letter)} {
448			append trace $letter
449		}
450	}
451	if {[string compare $trace "-v"] == 0} {
452		set trace ""
453	} elseif {[string compare $trace "-vabcgpstu"] == 0} {
454		set trace "-v"
455	}
456}
457
458#***********************************************************
459#Webbot: Launch the robot and Url to start from
460proc SetWebbot {} {
461	frame .webbot
462	label .webbot.l -text "URL to start from:"
463	entry .webbot.url -textvariable url -foreground red
464	pack .webbot.l -side left
465	pack .webbot.url -side left -fill x -expand true
466	button .webbot.start -text Webbot -command Start
467	button .webbot.exit -text Exit -command exit
468	pack .webbot.exit .webbot.start -side right
469	pack .webbot -side top -fill x
470}
471
472#***********************************************************
473#Log: Creating a scrollable window to log the output
474proc SetLog {} {
475	global log
476	frame .log
477	set log [text .log.log -width 75 -height 10 -wrap none -borderwidth 2 \
478		-relief raised -setgrid true -yscrollcommand {.log.scrolly set} \
479		-xscrollcommand {.log.scrollx set}]
480	scrollbar .log.scrolly -orient vertical -command {.log.log yview}
481	scrollbar .log.scrollx -orient horizontal -command {.log.log xview}
482	pack .log.scrolly -side right -fill y
483	pack .log.scrollx -side bottom -fill x
484	pack .log.log -side left -fill both -expand true
485	pack .log -side top -fill both -expand true
486
487	#Log: Key Bindings
488	bind .log.log <Control-f> FollowUrl
489	bind .log.log <Control-u> CopyAndPasteUrl
490	bind .log.log <Double-Button-1> FollowUrl
491	bind .log.log <Button-2> CopyAndPasteUrl
492	bind .log.log <Button-3> CopyAndPasteUrl
493}
494
495#Log: Procedure to log results in the log window
496proc Log {string} {
497	global log
498	$log insert end $string\n
499	$log see end
500}
501
502#Log: procedures to follow URLs from the log
503proc FollowUrl {} {
504	CopyAndPasteUrl
505	Start
506}
507
508proc CopyAndPasteUrl {} {
509	global log url
510	set url [lindex [split [$log get "insert linestart" "insert lineend"] {`'}] 1]
511	$log tag add fetched "insert linestart" "insert lineend"
512	$log tag configure fetched -foreground red
513}
514
515#***********************************************************
516#Status: Looking at what's going on
517proc SetStatus {} {
518	set status Ready
519	frame .status
520	label .status.l -text "Status:"
521	label .status.status -textvariable status -relief sunken -anchor w
522	pack .status.l -side left
523	pack .status.status -side left -fill x -expand true
524	pack .status -side bottom -fill x
525}
526
527#Status: procedure status to be called with any number of arguments
528proc Status {args} {
529	global status
530	set status $args
531}
532
533#***********************************************************
534#Start running the Robot
535proc Start {} {
536	global webbot img link ss trace url
537	Status Running the robot...
538	set Space(start) "********************************* $url"
539	set Space(end) {}
540	Log $Space(start)
541        Log "Calling webbot with $webbot $img $link $ss $trace $url"
542	catch {eval exec $webbot $img $link $ss $trace $url} results
543	Log $results
544	Log $Space(end)
545	Status Done
546}
547
548#***********************************************************
549#Main: the main program that calls all of the previous functions
550SetWindow
551SetMenus
552SetNav
553SetTrace
554SetWebbot
555SetLog
556SetStatus
557SetDefaultPreferences
558InitPath