#!/usr/bin/env wish

# Copyright (C) 2005 Paul Mackerras.  All rights reserved.

# This program is free software; it may be used, copied, modified

# and distributed under the terms of the GNU General Public Licence,

# either version 2, or (at your option) any later version.

proc gitdir {} {

    global env

    if {[info exists env(GIT_DIR)]} {

	return $env(GIT_DIR)

    } else {

	return ".hg"

    }

}

proc getcommits {rargs} {

    global commits commfd phase canv mainfont env

    global startmsecs nextupdate ncmupdate

    global ctext maincursor textcursor leftover

    # check that we can find a .git directory somewhere...

    set gitdir [gitdir]

    if {![file isdirectory $gitdir]} {

	error_popup "Cannot find the git directory \"$gitdir\"."

	exit 1

    }

    set commits {}

    set phase getcommits

    set startmsecs [clock clicks -milliseconds]

    set nextupdate [expr $startmsecs + 100]

    set ncmupdate 1

    set limit 0

    set revargs {}

    for {set i 0} {$i < [llength $rargs]} {incr i} {

	set opt [lindex $rargs $i]

	if {$opt == "--limit"} {

	    incr i

	    set limit [lindex $rargs $i]

	} else {

	    lappend revargs $opt

	}

    }

    if [catch {

	set parse_args [concat --default HEAD $revargs]

	set parse_temp [eval exec hg debug-rev-parse $parse_args]

	regsub -all "\r\n" $parse_temp "\n" parse_temp

	set parsed_args [split $parse_temp "\n"]

    } err] {

	# if git-rev-parse failed for some reason...

	if {$rargs == {}} {

	    set revargs HEAD

	}

	set parsed_args $revargs

    }

    if {$limit > 0} {

	set parsed_args [concat -n $limit $parsed_args]

    }

    if [catch {

	set commfd [open "|hg debug-rev-list --header --topo-order --parents $parsed_args" r]

    } err] {

	puts stderr "Error executing hg debug-rev-list: $err"

	exit 1

    }

    set leftover {}

    fconfigure $commfd -blocking 0 -translation lf

    fileevent $commfd readable [list getcommitlines $commfd]

    $canv delete all

    $canv create text 3 3 -anchor nw -text "Reading commits..." \

	-font $mainfont -tags textitems

    . config -cursor watch

    settextcursor watch

}

proc getcommitlines {commfd}  {

    global commits parents cdate children

    global commitlisted phase commitinfo nextupdate

    global stopped redisplaying leftover

    set stuff [read $commfd]

    if {$stuff == {}} {

	if {![eof $commfd]} return

	# set it blocking so we wait for the process to terminate

	fconfigure $commfd -blocking 1

	if {![catch {close $commfd} err]} {

	    after idle finishcommits

	    return

	}

	if {[string range $err 0 4] == "usage"} {

	    set err \

{Gitk: error reading commits: bad arguments to git-rev-list.

(Note: arguments to gitk are passed to git-rev-list

to allow selection of commits to be displayed.)}

	} else {

	    set err "Error reading commits: $err"

	}

	error_popup $err

	exit 1

    }

    set start 0

    while 1 {

	set i [string first "\0" $stuff $start]

	if {$i < 0} {

	    append leftover [string range $stuff $start end]

	    return

	}

	set cmit [string range $stuff $start [expr {$i - 1}]]

	if {$start == 0} {

	    set cmit "$leftover$cmit"

	    set leftover {}

	}

	set start [expr {$i + 1}]

	regsub -all "\r\n" $cmit "\n" cmit

	set j [string first "\n" $cmit]

	set ok 0

	if {$j >= 0} {

	    set ids [string range $cmit 0 [expr {$j - 1}]]

	    set ok 1

	    foreach id $ids {

		if {![regexp {^[0-9a-f]{12}$} $id]} {

		    set ok 0

		    break

		}

	    }

	}

	if {!$ok} {

	    set shortcmit $cmit

	    if {[string length $shortcmit] > 80} {

		set shortcmit "[string range $shortcmit 0 80]..."

	    }

	    error_popup "Can't parse hg debug-rev-list output: {$shortcmit}"

	    exit 1

	}

	set id [lindex $ids 0]

	set olds [lrange $ids 1 end]

	set cmit [string range $cmit [expr {$j + 1}] end]

	lappend commits $id

	set commitlisted($id) 1

	parsecommit $id $cmit 1 [lrange $ids 1 end]

	drawcommit $id

	if {[clock clicks -milliseconds] >= $nextupdate} {

	    doupdate 1

	}

	while {$redisplaying} {

	    set redisplaying 0

	    if {$stopped == 1} {

		set stopped 0

		set phase "getcommits"

		foreach id $commits {

		    drawcommit $id

		    if {$stopped} break

		    if {[clock clicks -milliseconds] >= $nextupdate} {

			doupdate 1

		    }

		}

	    }

	}

    }

}

proc doupdate {reading} {

    global commfd nextupdate numcommits ncmupdate

    if {$reading} {

	fileevent $commfd readable {}

    }

    update

    set nextupdate [expr {[clock clicks -milliseconds] + 100}]

    if {$numcommits < 100} {

	set ncmupdate [expr {$numcommits + 1}]

    } elseif {$numcommits < 10000} {

	set ncmupdate [expr {$numcommits + 10}]

    } else {

	set ncmupdate [expr {$numcommits + 100}]

    }

    if {$reading} {

	fileevent $commfd readable [list getcommitlines $commfd]

    }

}

proc readcommit {id} {

    if [catch {set contents [exec hg debug-cat-file commit $id]}] return

    parsecommit $id $contents 0 {}

}

proc parsecommit {id contents listed olds} {

    global commitinfo children nchildren parents nparents cdate ncleft

    set inhdr 1

    set comment {}

    set headline {}

    set auname {}

    set audate {}

    set comname {}

    set comdate {}

    set rev {}

    if {![info exists nchildren($id)]} {

	set children($id) {}

	set nchildren($id) 0

	set ncleft($id) 0

    }

    set parents($id) $olds

    set nparents($id) [llength $olds]

    foreach p $olds {

	if {![info exists nchildren($p)]} {

	    set children($p) [list $id]

	    set nchildren($p) 1

	    set ncleft($p) 1

	} elseif {[lsearch -exact $children($p) $id] < 0} {

	    lappend children($p) $id

	    incr nchildren($p)

	    incr ncleft($p)

	}

    }

    regsub -all "\r\n" $contents "\n" contents

    foreach line [split $contents "\n"] {

	if {$inhdr} {

	    set line [split $line]

	    if {$line == {}} {

		set inhdr 0

	    } else {

		set tag [lindex $line 0]

		if {$tag == "author"} {

		    set x [expr {[llength $line] - 2}]

		    set audate [lindex $line $x]

		    set auname [join [lrange $line 1 [expr {$x - 1}]]]

		} elseif {$tag == "committer"} {

		    set x [expr {[llength $line] - 2}]

		    set comdate [lindex $line $x]

		    set comname [join [lrange $line 1 [expr {$x - 1}]]]

		} elseif {$tag == "revision"} {

		    set rev [lindex $line 1]

		}

	    }

	} else {

	    if {$comment == {}} {

		set headline [string trim $line]

	    } else {

		append comment "\n"

	    }

	    if {!$listed} {

		# git-rev-list indents the comment by 4 spaces;

		# if we got this via git-cat-file, add the indentation

		append comment "    "

	    }

	    append comment $line

	}

    }

    if {$audate != {}} {

	set audate [clock format $audate -format "%Y-%m-%d %H:%M:%S"]

    }

    if {$comdate != {}} {

	set cdate($id) $comdate

	set comdate [clock format $comdate -format "%Y-%m-%d %H:%M:%S"]

    }

    set commitinfo($id) [list $headline $auname $audate \

			     $comname $comdate $comment $rev]

}

proc readrefs {} {

    global tagids idtags headids idheads tagcontents

    set tags [exec hg tags]

    regsub -all "\r\n" $tags "\n" tags

    set lines [split $tags "\n"]

    foreach f $lines {

	set sha [split $full ':']

	set tag [lindex $sha 1]

	lappend tagids($direct) $tag

	lappend idtags($tag) $direct

    }

}

proc readotherrefs {base dname excl} {

    global otherrefids idotherrefs

    set git [gitdir]

    set files [glob -nocomplain -types f [file join $git $base *]]

    foreach f $files {

	catch {

	    set fd [open $f r]

	    set line [read $fd 40]

	    if {[regexp {^[0-9a-f]{12}} $line id]} {

		set name "$dname[file tail $f]"

		set otherrefids($name) $id

		lappend idotherrefs($id) $name

	    }

	    close $fd

	}

    }

    set dirs [glob -nocomplain -types d [file join $git $base *]]

    foreach d $dirs {

	set dir [file tail $d]

	if {[lsearch -exact $excl $dir] >= 0} continue

	readotherrefs [file join $base $dir] "$dname$dir/" {}

    }

}

proc error_popup msg {

    set w .error

    toplevel $w

    wm transient $w .

    message $w.m -text $msg -justify center -aspect 400

    pack $w.m -side top -fill x -padx 20 -pady 20

    button $w.ok -text OK -command "destroy $w"

    pack $w.ok -side bottom -fill x

    bind $w <Visibility> "grab $w; focus $w"

    tkwait window $w

}

proc makewindow {} {

    global canv canv2 canv3 linespc charspc ctext cflist textfont

    global findtype findtypemenu findloc findstring fstring geometry

    global entries sha1entry sha1string sha1but

    global maincursor textcursor curtextcursor

    global rowctxmenu gaudydiff mergemax

    menu .bar

    .bar add cascade -label "File" -menu .bar.file