# project.tcl
#
# Global URL management
#

proc Project_Setup {win} {
    global project
    upvar #0 HM$win var
    if ![winfo exists .project] {
	set t [toplevel .project -bd 10]
	set f [frame $t.buttons]
	pack $f -side top -fill x
	button $f.quit -text Dismiss -command [list wm withdraw $t]
	pack $f.quit -side right
	button $f.summary -text "Url Summary" \
		-command [list Project_Summary $win]
	pack $f.summary -side left
	button $f.stop -text "Stop" \
		-command {set project(stop) 1}
	pack $f.stop -side left

	message $t.msg -aspect 2000  -text \
"Enter a URL and WebTk will validate and list all the links.
Links on the same server will be recursively followed."
	pack $t.msg -side top -fill x

	set f [frame $t.dir]
	pack $f -side top -fill x
	label $f.label -text Url:
	entry $f.entry -textvariable project(url)
	bind $f.entry <Return> [list Project_Summary $win]
	pack $f.label $f.entry -side left
	pack $f.entry -fill x -expand true

	set f [frame $t.timeout]
	label $f.text -text "Link Timeout (seconds):"
	pack $f.text -side left
    } else {
	set t .project
	wm deiconify $t
	raise $t
    }
    set project(url) $var(S_url)
}
proc Project_Summary {win} {
    upvar #0 HM$win var
    global project

    if {[string length $project(url)] == 0} {
	set project(url) \
	    file:[fileselect "Select a Web Page" \
		[file join [glob -nocomplain ~] public_html] file]
    }
    if {[string length $project(url)] == 0} {
	return
    }

    set url $project(url)
    set title "Link Map $url"
    set html \
"[Html_Head $title]
<base href=\"$project(url)\">
<body>[H1 [Html_Link $url]]
[H2 "Link Map by [Html_Link http://www.sunlabs.com/research/tcl/webtk/ WebTk]"]
<p>This is a summary of links from:<br>$url
<p>
Non-local links are [Italic [Html_Color green green-italic]]
<p>
Broken links are [Html_Color red red]
<hr>"

    set protocol [UrlResolve $var(S_url) url]
    set project(base) $url	;# Root of the web
    set project(newurls) $url	;# List of outstanding URLS
    set project(oldurls) ""	;# List of processed URLS
    set project(stop) 0
    set project(mid) 0

    # Display fetch queue
    HttpTrace

    # Start a new window with the map - update it as we go along.
    set newwin [Window_New]
    Url_DisplayHtmlBegin $newwin "" $html

    # Hack stop button
    set stopCmd [[winfo toplevel $newwin].tools.browse.stop cget -command]
    [winfo toplevel $newwin].tools.browse.stop config -command [list set project(stop) 1]

    $newwin config -state normal
    bindtags $newwin [list TScroll all]	;# Disable user input to the widget
    Feedback $newwin busy
    $newwin config -cursor watch
    Mark_ReadTags $newwin insert
    update

    while {[llength $project(newurls)]} {
	if {$project(stop)} {
	    break
	}
	ProjectFeedback $newwin
	set url [lindex $project(newurls) 0]
	set project(newurls) [lrange $project(newurls) 1 end]
	lappend project(oldurls) $url
	ProjectFindLinks $newwin $url
    }
    Input_Mode $newwin Browse
    Feedback $newwin "done [llength $project(oldurls)]"
    $newwin config -cursor xterm
    [winfo toplevel $newwin].tools.browse.stop config -command $stopCmd
}
proc ProjectFeedback {win} {
    global project
    FeedbackLoop $win "[llength $project(oldurls)] + [llength $project(newurls)]"
}

# Scan a URL for links, validate them, and generate a page about it.
proc ProjectFindLinks { win url } {
    global project

    set project(current) $url
    set pretty $url
    UrlRelative $project(base) pretty
    Html_Insert $win <hr>[H2 [Html_Link $pretty]]
    $win see insert

    if ![regexp {([^:]+):(.*)} $url dummy protocol ext] {
	Html_Insert $win "Unexpected format in url<string>$url</strong>"
	return
    }

    switch -- [string tolower $protocol] {
	http {
	    upvar #0 $url data
	    catch {unset data(valid)}
	    Http_get $url [list ProjectLink $win $url] \
			    [list Url_Progress $win $url]
	    if ![info exists data(valid)] {
		tkwait variable $url\(valid)
	    }
	}
	file {
	    ProjectFile $win $url
	}
	default {
	    # do nothing
	}
    }
}
proc ProjectLink {win url} {
    global project
    upvar #0 $url data

    set summary(state) {}
    set summary(base) $url
    HMparse_html $data(html) [list ProjectScan summary $win] {}
    set data(valid) ok
}
proc ProjectFile {win url} {
    global project

    set summary(state) {}
    set summary(base) $url
    regsub -nocase {^file:} $url {} file
    if ![file exists $file] {
	Html_Insert $win [Html_Color red "File doesn't exist"]
    } elseif {[string match .htm* [file extension $file]]} {
	HMparse_html [UrlGetFile $file] [list ProjectScan summary $win] {}
    }
}
proc ProjectAddUrl {url} {
    global project
    regsub {#.*} $url {} url
    if {([lsearch $project(oldurls) $url] >= 0) ||
	    ([lsearch $project(newurls) $url] >= 0)} {
	return ;# Already processed, or pending
    }
    lappend project(newurls) $url
}
#
# ProjectScan --
# Insert a summary of links and initiate a validation on them.
# When the validation completes, the page is updated.

proc ProjectScan { sumVar win htag not param text } {
    global project
    upvar 2 $sumVar summary	;# ProjectSummary -> HMparse_html -> ProjectScan
    if {$project(stop)} {
	return
    }
    switch -- [string tolower $htag] {
	"a" {
	    if {[info exists summary(href)]} {
		# probably </a>, but could be sucessive <a> tags.
		if ![regexp ^# $summary(href)] {
		    Status $win $summary(href)
		    set absolute [Url_IsChild $project(base) $summary(href)]
		    if {[string length $absolute] == 0} {
			set how HEAD
			set local 0
		    } else {
			set how GET
			ProjectAddUrl $absolute
			set local 1
		    }
		    # Save insert point for later fixup
		    set ix [$win index insert]
		    if {[$win compare $ix == "$ix lineend"] &&
			[$win compare $ix != "$ix linestart"]} {
			set ix [$win index "$ix +1 char"]
		    }
		    set text [string trim $summary(linktext)]
		    if {[string length $text] == 0} {
			set text "(no text)"
			catch {set text "&lt;img $summary(image)&gt;"}
		    }
		    Html_Insert $win [H4 [Html_Link $summary(href) $text]].
		    set mid T[incr project(mid)]
		    $win mark set $mid $ix
		    $win mark gravity $mid right	;# see Note A
		    Url_Validate $summary(base) $summary(href) $how \
			[list ProjectHighlight $win $mid $local]
		    ProjectFeedback $win
		    $win see insert
		}
		unset summary(linktext) summary(href)
		catch {unset summary(image)}
		set summary(state) {}
	    }
	    set href (null)
	    if {[HMextract_param $param href]} {
		set summary(href) $href
		append summary(linktext) $text
		set summary(state) linktext
	    }
	}
	"img" {
	    if {[HMextract_param $param src]} {
		set srcorig $src
		UrlResolve $project(current) src
		regsub $srcorig $param $src param
	    }
	    set summary(image) $param
	}
	"form" {
	}
	default {
	    switch -- $summary(state) {
		linktext {
		    append summary(linktext) $text
		}
	    }
	}
    }

}
# When called there are two lines of html inserted,
# <h3>link</h3>
# "status"
#
# This routine edits those lines to indicate the link status.
proc ProjectHighlight {win mid local href ok status} {
    set state [$win cget -state]
    $win config -state normal
    set ix [$win index $mid]
    $win mark unset $mid
    if $ok {
	if !$local {
	    Text_TagAdd $win H:em $ix "$ix lineend"
	    Text_TagAdd $win {H:color value=green} $ix "$ix lineend"
	}
    } else {
	Text_TagAdd $win {H:color value=red} $ix "$ix lineend"
	set status <strong>$status</strong>
    }
    # Note A
    # This refresh cuts and redisplays a section of text
    Edit_RefreshRange $win $ix "$ix lineend"

    $win mark set insert "$ix +1 line linestart"
    InputSetTags $win force
    Input_Html $win $status

    $win mark set insert end
    Input_Adjust $win
    InputSetTags $win force
    $win config -state $state
}
proc Project_CheckPoint {out} {
    global project
    catch {unset project(html)}
    puts $out "array set project {"
    foreach x [lsort [array names project]] {
	puts $out "[list $x] [list $project($x)]"
    }
    puts $out "}"
}
# Recurse through everything in a directory - not used
proc ProjectFindFiles { dir } {
    global project
    foreach f [lsort [glob -nocomplain $dir/*]] {
	if {[string match .htm* [file extension $f]]} {
	    append project(html) <h2>$f</h2>\n
	    if [catch {open $f} in] {
		append project(html) <b>$in</b>\n
	    } else {
		append project(html) <ul>[ProjectSummary [read $in]]</ul>
		close $in
	    }
	} elseif {[file isdirectory $f]} {
	    ProjectFindFiles $f
	}
    }
}

