robot.tcl

www工具包

	} else {
		#file webprefs does not exist
		Dialog "		File WebPrefs does not Exist.		
		Create a file WebPrefs in the current directory?		
		Current Directory: [pwd]		"\
		{create default cancel} \
		{"Create File with Default Preferences" "Set default Preferences" "Cancel"} \
		{{SetDefaultPreferences; SavePreferences} SetDefaultPreferences ""}
	}
	Status Done
}

#prefs: create the prefs file to hold the preferences
proc SavePreferences {} {
	set file [open webprefs w 0600]
	puts $file "#This file is created by webbot.tcl"
	puts $file "#It contains the preferences for running the w3c mini robot"
	foreach variable {path source editor webbot webbot-path weblog weblog-path webout webout-path \
		webrules webrules-path trace img ss url} {
		global $variable
		puts $file $variable:[set $variable]
		Log Writing:$variable:[set $variable]
	}
	close $file		
}

#***********************************************************
#nav: Navigation method, and depth
proc SetNav {} {
	frame .nav
	set nav dumb
	label .nav.l1 -text "Navigation method:" -relief ridge
	pack .nav.l1 -side left
	frame .nav.choice
	foreach choice {dumb parallel deep strategic} {
		radiobutton .nav.choice.$choice -text $choice -value $choice -variable nav
		pack .nav.choice.$choice -side left
	}
	pack .nav.choice -side left
	
	#nav: links: Number of links to follow
	frame .nav.links
	label .nav.links.l -text "Depth:" -relief ridge
	set links 0
	set link ""
	entry .nav.links.entry -textvariable links -width 3 -relief flat
	bind .nav.links.entry <KeyRelease> SetLink
	proc SetLink {} {
		global links link
		if {[string compare $links ""] == 0} {
			set link ""
		} elseif {$links != 0} {
			set link ""
			append link "-link " $links
		} else {
			set link ""
		}
	} 
	label .nav.links.show -textvariable link
	foreach packing {l entry show} {
		pack .nav.links.$packing -side left
	}
	pack .nav.links -side left
	pack .nav -side top -fill x
}
	
#***********************************************************
#Trace: Tracing information on the robot
proc SetTrace {} {
	global trace traced
	set trace ""
	frame .trace
	
	#Trace: title, variable, and button for debugging
	frame .trace.title
	label .trace.title.l -text "Trace messages relevant to:" -relief ridge
	button .trace.title.all -text Everything -command TraceAll
	button .trace.title.none -text Nothing -command TraceNone
	pack .trace.title.l .trace.title.all .trace.title.none -side left
	label	.trace.title.display -textvariable trace -justify left -width 10
	foreach whichbutton {l all none display} {
		pack .trace.title.$whichbutton -side left
	}
	
	#***********************************************************
	#Info: Retrieving Information
	frame .trace.title.info
	checkbutton .trace.title.info.version -text Version -command ShowVersion
	
	#Info: Checking the images of the documents
	checkbutton .trace.title.info.img -text "Images" \
		-variable img -onvalue "-img" -offvalue ""
		
	#Info: Date and Time of the job
	checkbutton .trace.title.info.ss -text "Time Log" \
		-variable ss -onvalue "-ss" -offvalue ""
	
	#Info: Packing the buttons
	foreach packing {version img ss} {
		pack .trace.title.info.$packing -side left
	}
	pack .trace.title.info -side left
	pack .trace.title -side top -fill x
	
	#Trace: buttons to choose tracing options
	frame .trace.buttons

	#matching up the names and letters
	array set tracing {a "anchors" b "bindings to local files"
		c "cache" g "SGML" p "protocol" s "sgml/html" t "threads" u "url"}
	foreach letter {a b c g p s t u} {
		checkbutton .trace.buttons.$letter -text $tracing($letter) \
			-variable traced($letter) -command ButtonsToTrace
		pack .trace.buttons.$letter -side left -anchor w
	}
	pack .trace.buttons -side top -fill x -expand true
	pack .trace -side top -fill x
	
	#Trace: tracing everything or nothing
	proc TraceAll {} {
		global traced ss img
		foreach letter {a b c g p s t u} {
			set traced($letter) 1
		}
		ButtonsToTrace
		set img "-img"
		set ss "-ss"
	}
	proc TraceNone {} {
		global traced img ss
		foreach letter {a b c g p s t u} {
			set traced($letter) 0
		}
		ButtonsToTrace
		set img ""
		set ss ""	
	}
}
	
#Trace: Showing the Version
proc ShowVersion {} {
	global webbot
	catch {exec $webbot "-version"} results
	Log $results
}

#Trace: setting up the buttons from the variable trace
proc TraceToButtons {} {
	global trace traced
	if {[string compare $trace "-v"] == 0} {set trace -vabcgpstu}
	foreach letter {a b c g p s t u} {
		global traced($letter)
		Log "traced($letter) = [set traced($letter)]"
		if "[string match *$letter* $trace] == 1" {
			set traced($letter) 1
		} else {
			set traced($letter) 0
		}
	}
	if {[string compare $trace "-vabcgpstu"] == 0} {set trace -v}
}

#Trace: calculating what to trace from the user's selections
proc ButtonsToTrace {} {
	global trace traced
	set trace "-v"
	foreach letter {a b c g p s t u} {
		if {$traced($letter)} {
			append trace $letter
		}
	}
	if {[string compare $trace "-v"] == 0} {
		set trace ""
	} elseif {[string compare $trace "-vabcgpstu"] == 0} {
		set trace "-v"
	}
}
	
#***********************************************************
#Webbot: Launch the robot and Url to start from
proc SetWebbot {} {
	frame .webbot
	label .webbot.l -text "URL to start from:"
	entry .webbot.url -textvariable url -foreground red
	pack .webbot.l -side left 
	pack .webbot.url -side left -fill x -expand true
	button .webbot.start -text Webbot -command Start
	button .webbot.exit -text Exit -command exit
	pack .webbot.exit .webbot.start -side right
	pack .webbot -side top -fill x
}

#***********************************************************
#Log: Creating a scrollable window to log the output
proc SetLog {} {
	global log
	frame .log
	set log [text .log.log -width 75 -height 10 -wrap none -borderwidth 2 \
		-relief raised -setgrid true -yscrollcommand {.log.scrolly set} \
		-xscrollcommand {.log.scrollx set}]
	scrollbar .log.scrolly -orient vertical -command {.log.log yview}
	scrollbar .log.scrollx -orient horizontal -command {.log.log xview}
	pack .log.scrolly -side right -fill y
	pack .log.scrollx -side bottom -fill x
	pack .log.log -side left -fill both -expand true
	pack .log -side top -fill both -expand true
	
	#Log: Key Bindings
	bind .log.log <Control-f> FollowUrl
	bind .log.log <Control-u> CopyAndPasteUrl
	bind .log.log <Double-Button-1> FollowUrl
	bind .log.log <Button-2> CopyAndPasteUrl
	bind .log.log <Button-3> CopyAndPasteUrl
}

#Log: Procedure to log results in the log window
proc Log {string} {
	global log
	$log insert end $string\n
	$log see end
}

#Log: procedures to follow URLs from the log
proc FollowUrl {} {
	CopyAndPasteUrl
	Start
}

proc CopyAndPasteUrl {} {
	global log url
	set url [lindex [split [$log get "insert linestart" "insert lineend"] {`'}] 1]
	$log tag add fetched "insert linestart" "insert lineend"
	$log tag configure fetched -foreground red
}

#***********************************************************
#Status: Looking at what's going on
proc SetStatus {} {
	set status Ready
	frame .status
	label .status.l -text "Status:"
	label .status.status -textvariable status -relief sunken -anchor w
	pack .status.l -side left
	pack .status.status -side left -fill x -expand true
	pack .status -side bottom -fill x
}

#Status: procedure status to be called with any number of arguments
proc Status {args} {
	global status
	set status $args
}

#***********************************************************
#Start running the Robot
proc Start {} {
	global webbot img link ss trace url
	Status Running the robot...
	set Space(start) "********************************* $url"
	set Space(end) {}
	Log $Space(start)
        Log "Calling webbot with $webbot $img $link $ss $trace $url"
	catch {eval exec $webbot $img $link $ss $trace $url} results
	Log $results
	Log $Space(end)
	Status Done
}

#***********************************************************
#Main: the main program that calls all of the previous functions
SetWindow
SetMenus
SetNav
SetTrace
SetWebbot
SetLog
SetStatus
SetDefaultPreferences
InitPath