#!/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

    if [catch {

	set parse_args [concat --default HEAD $rargs]

	set parsed_args [split [eval exec hg debug-rev-parse $parse_args] "\n"]

    }] {

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

	if {$rargs == {}} {

	    set rargs HEAD

	}

	set parsed_args $rargs

    }

    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}]

	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]{40}$} $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 {}

    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)

	}

    }

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

	if {$inhdr} {

	    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 [lrange $line 1 [expr {$x - 1}]]

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

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

		    set comdate [lindex $line $x]

		    set comname [lrange $line 1 [expr {$x - 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]

}

proc readrefs {} {

    global tagids idtags headids idheads tagcontents

    set tags [exec hg tags]

    set lines [split $tags '\n']

    foreach f $lines {

	set f [regexp -all -inline {\S+} $f]

	set direct [lindex $f 0]

	set full [lindex $f 1]

	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]{40}} $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

    menu .bar.file

    .bar.file add command -label "Reread references" -command rereadrefs

    .bar.file add command -label "Quit" -command doquit

    menu .bar.help

    .bar add cascade -label "Help" -menu .bar.help

    .bar.help add command -label "About gitk" -command about

    . configure -menu .bar

    if {![info exists geometry(canv1)]} {

	set geometry(canv1) [expr 45 * $charspc]

	set geometry(canv2) [expr 30 * $charspc]

	set geometry(canv3) [expr 15 * $charspc]

	set geometry(canvh) [expr 25 * $linespc + 4]

	set geometry(ctextw) 80

	set geometry(ctexth) 30

	set geometry(cflistw) 30

    }

    panedwindow .ctop -orient vertical

    if {[info exists geometry(width)]} {

	.ctop conf -width $geometry(width) -height $geometry(height)

	set texth [expr {$geometry(height) - $geometry(canvh) - 56}]

	set geometry(ctexth) [expr {($texth - 8) /

				    [font metrics $textfont -linespace]}]

    }

    frame .ctop.top

    frame .ctop.top.bar

    pack .ctop.top.bar -side bottom -fill x

    set cscroll .ctop.top.csb

    scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0

    pack $cscroll -side right -fill y

    panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4

    pack .ctop.top.clist -side top -fill both -expand 1

    .ctop add .ctop.top

    set canv .ctop.top.clist.canv

    canvas $canv -height $geometry(canvh) -width $geometry(canv1) \

	-bg white -bd 0 \

	-yscrollincr $linespc -yscrollcommand "$cscroll set"

    .ctop.top.clist add $canv

    set canv2 .ctop.top.clist.canv2

    canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \

	-bg white -bd 0 -yscrollincr $linespc

    .ctop.top.clist add $canv2

    set canv3 .ctop.top.clist.canv3

    canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \

	-bg white -bd 0 -yscrollincr $linespc

    .ctop.top.clist add $canv3

    bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}

    set sha1entry .ctop.top.bar.sha1

    set entries $sha1entry

    set sha1but .ctop.top.bar.sha1label

    button $sha1but -text "SHA1 ID: " -state disabled -relief flat \

	-command gotocommit -width 8

    $sha1but conf -disabledforeground [$sha1but cget -foreground]

    pack .ctop.top.bar.sha1label -side left

    entry $sha1entry -width 40 -font $textfont -textvariable sha1string

    trace add variable sha1string write sha1change

    pack $sha1entry -side left -pady 2

    image create bitmap bm-left -data {

	#define left_width 16

	#define left_height 16

	static unsigned char left_bits[] = {

	0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,

	0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,

	0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};

    }

    image create bitmap bm-right -data {

	#define right_width 16

	#define right_height 16

	static unsigned char right_bits[] = {

	0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,

	0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,

	0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};

    }

    button .ctop.top.bar.leftbut -image bm-left -command goback \

	-state disabled -width 26

    pack .ctop.top.bar.leftbut -side left -fill y

    button .ctop.top.bar.rightbut -image bm-right -command goforw \

	-state disabled -width 26

    pack .ctop.top.bar.rightbut -side left -fill y

    button .ctop.top.bar.findbut -text "Find" -command dofind

    pack .ctop.top.bar.findbut -side left

    set findstring {}

    set fstring .ctop.top.bar.findstring

    lappend entries $fstring

    entry $fstring -width 30 -font $textfont -textvariable findstring

    pack $fstring -side left -expand 1 -fill x

    set findtype Exact

    set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \

			  findtype Exact IgnCase Regexp]

    set findloc "All fields"

    tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \

	Comments Author Committer Files Pickaxe

    pack .ctop.top.bar.findloc -side right

    pack .ctop.top.bar.findtype -side right

    # for making sure type==Exact whenever loc==Pickaxe

    trace add variable findloc write findlocchange

    panedwindow .ctop.cdet -orient horizontal

    .ctop add .ctop.cdet

    frame .ctop.cdet.left

    set ctext .ctop.cdet.left.ctext

    text $ctext -bg white -state disabled -font $textfont \

	-width $geometry(ctextw) -height $geometry(ctexth) \

	-yscrollcommand ".ctop.cdet.left.sb set" \

	-xscrollcommand ".ctop.cdet.left.hb set" -wrap none

    scrollbar .ctop.cdet.left.sb -command "$ctext yview"

    scrollbar .ctop.cdet.left.hb -orient horizontal -command "$ctext xview"

    pack .ctop.cdet.left.sb -side right -fill y

    pack .ctop.cdet.left.hb -side bottom -fill x

    pack $ctext -side left -fill both -expand 1

    .ctop.cdet add .ctop.cdet.left

    $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"

    if {$gaudydiff} {

	$ctext tag conf hunksep -back blue -fore white

	$ctext tag conf d0 -back "#ff8080"

	$ctext tag conf d1 -back green

    } else {

	$ctext tag conf hunksep -fore blue

	$ctext tag conf d0 -fore red

	$ctext tag conf d1 -fore "#00a000"

	$ctext tag conf m0 -fore red

	$ctext tag conf m1 -fore blue

	$ctext tag conf m2 -fore green

	$ctext tag conf m3 -fore purple

	$ctext tag conf m4 -fore brown

	$ctext tag conf mmax -fore darkgrey

	set mergemax 5

	$ctext tag conf mresult -font [concat $textfont bold]

	$ctext tag conf msep -font [concat $textfont bold]

	$ctext tag conf found -back yellow

    }

    frame .ctop.cdet.right

    set cflist .ctop.cdet.right.cfiles

    listbox $cflist -bg white -selectmode extended -width $geometry(cflistw) \

	-yscrollcommand ".ctop.cdet.right.sb set"

    scrollbar .ctop.cdet.right.sb -command "$cflist yview"

    pack .ctop.cdet.right.sb -side right -fill y

    pack $cflist -side left -fill both -expand 1

    .ctop.cdet add .ctop.cdet.right

    bind .ctop.cdet <Configure> {resizecdetpanes %W %w}

    pack .ctop -side top -fill both -expand 1

    bindall <1> {selcanvline %W %x %y}

    #bindall <B1-Motion> {selcanvline %W %x %y}

    bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"

    bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"

    bindall <2> "allcanvs scan mark 0 %y"

    bindall <B2-Motion> "allcanvs scan dragto 0 %y"

    bind . <Key-Up> "selnextline -1"

    bind . <Key-Down> "selnextline 1"

    bind . <Key-Prior> "allcanvs yview scroll -1 pages"

    bind . <Key-Next> "allcanvs yview scroll 1 pages"

    bindkey <Key-Delete> "$ctext yview scroll -1 pages"

    bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"

    bindkey <Key-space> "$ctext yview scroll 1 pages"

    bindkey p "selnextline -1"

    bindkey n "selnextline 1"

    bindkey b "$ctext yview scroll -1 pages"

    bindkey d "$ctext yview scroll 18 units"

    bindkey u "$ctext yview scroll -18 units"

    bindkey / {findnext 1}

    bindkey <Key-Return> {findnext 0}

    bindkey ? findprev

    bindkey f nextfile

    bind . <Control-q> doquit

    bind . <Control-w> doquit

    bind . <Control-f> dofind

    bind . <Control-g> {findnext 0}

    bind . <Control-r> findprev

    bind . <Control-equal> {incrfont 1}

    bind . <Control-KP_Add> {incrfont 1}

    bind . <Control-minus> {incrfont -1}

    bind . <Control-KP_Subtract> {incrfont -1}

    bind $cflist <<ListboxSelect>> listboxsel

    bind . <Destroy> {savestuff %W}

    bind . <Button-1> "click %W"

    bind $fstring <Key-Return> dofind

    bind $sha1entry <Key-Return> gotocommit

    bind $sha1entry <<PasteSelection>> clearsha1

    set maincursor [. cget -cursor]

    set textcursor [$ctext cget -cursor]

    set curtextcursor $textcursor

    set rowctxmenu .rowctxmenu

    menu $rowctxmenu -tearoff 0

    $rowctxmenu add command -label "Diff this -> selected" \

	-command {diffvssel 0}

    $rowctxmenu add command -label "Diff selected -> this" \

	-command {diffvssel 1}

    $rowctxmenu add command -label "Make patch" -command mkpatch

    $rowctxmenu add command -label "Create tag" -command mktag

    $rowctxmenu add command -label "Write commit to file" -command writecommit

}

# when we make a key binding for the toplevel, make sure

# it doesn't get triggered when that key is pressed in the

# find string entry widget.

proc bindkey {ev script} {