gitk

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2005-2006 Paul Mackerras.  All rights reserved.
   6 # This program is free software; it may be used, copied, modified
   7 # and distributed under the terms of the GNU General Public Licence,
   8 # either version 2, or (at your option) any later version.
   9
  10 proc gitdir {} {
  11     global env
  12     if {[info exists env(GIT_DIR)]} {
  13         return $env(GIT_DIR)
  14     } else {
  15         return ".git"
  16     }
  17 }
  18
  19 proc start_rev_list {view} {
  20     global startmsecs nextupdate ncmupdate
  21     global commfd leftover tclencoding datemode
  22     global viewargs viewfiles commitidx
  23
  24     set startmsecs [clock clicks -milliseconds]
  25     set nextupdate [expr {$startmsecs + 100}]
  26     set ncmupdate 1
  27     set commitidx($view) 0
  28     set args $viewargs($view)
  29     if {$viewfiles($view) ne {}} {
  30         set args [concat $args "--" $viewfiles($view)]
  31     }
  32     set order "--topo-order"
  33     if {$datemode} {
  34         set order "--date-order"
  35     }
  36     if {[catch {
  37         set fd [open [concat | git rev-list --header $order \
  38                           --parents --boundary --default HEAD $args] r]
  39     } err]} {
  40         puts stderr "Error executing git rev-list: $err"
  41         exit 1
  42     }
  43     set commfd($view) $fd
  44     set leftover($view) {}
  45     fconfigure $fd -blocking 0 -translation lf
  46     if {$tclencoding != {}} {
  47         fconfigure $fd -encoding $tclencoding
  48     }
  49     fileevent $fd readable [list getcommitlines $fd $view]
  50     nowbusy $view
  51 }
  52
  53 proc stop_rev_list {} {
  54     global commfd curview
  55
  56     if {![info exists commfd($curview)]} return
  57     set fd $commfd($curview)
  58     catch {
  59         set pid [pid $fd]
  60         exec kill $pid
  61     }
  62     catch {close $fd}
  63     unset commfd($curview)
  64 }
  65
  66 proc getcommits {} {
  67     global phase canv mainfont curview
  68
  69     set phase getcommits
  70     initlayout
  71     start_rev_list $curview
  72     show_status "Reading commits..."
  73 }
  74
  75 proc getcommitlines {fd view}  {
  76     global commitlisted nextupdate
  77     global leftover commfd
  78     global displayorder commitidx commitrow commitdata
  79     global parentlist childlist children curview hlview
  80     global vparentlist vchildlist vdisporder vcmitlisted
  81
  82     set stuff [read $fd]
  83     if {$stuff == {}} {
  84         if {![eof $fd]} return
  85         global viewname
  86         unset commfd($view)
  87         notbusy $view
  88         # set it blocking so we wait for the process to terminate
  89         fconfigure $fd -blocking 1
  90         if {[catch {close $fd} err]} {
  91             set fv {}
  92             if {$view != $curview} {
  93                 set fv " for the \"$viewname($view)\" view"
  94             }
  95             if {[string range $err 0 4] == "usage"} {
  96                 set err "Gitk: error reading commits$fv:\
  97                         bad arguments to git rev-list."
  98                 if {$viewname($view) eq "Command line"} {
  99                     append err \
 100                         "  (Note: arguments to gitk are passed to git rev-list\
 101                          to allow selection of commits to be displayed.)"
 102                 }
 103             } else {
 104                 set err "Error reading commits$fv: $err"
 105             }
 106             error_popup $err
 107         }
 108         if {$view == $curview} {
 109             after idle finishcommits
 110         }
 111         return
 112     }
 113     set start 0
 114     set gotsome 0
 115     while 1 {
 116         set i [string first "\0" $stuff $start]
 117         if {$i < 0} {
 118             append leftover($view) [string range $stuff $start end]
 119             break
 120         }
 121         if {$start == 0} {
 122             set cmit $leftover($view)
 123             append cmit [string range $stuff 0 [expr {$i - 1}]]
 124             set leftover($view) {}
 125         } else {
 126             set cmit [string range $stuff $start [expr {$i - 1}]]
 127         }
 128         set start [expr {$i + 1}]
 129         set j [string first "\n" $cmit]
 130         set ok 0
 131         set listed 1
 132         if {$j >= 0} {
 133             set ids [string range $cmit 0 [expr {$j - 1}]]
 134             if {[string range $ids 0 0] == "-"} {
 135                 set listed 0
 136                 set ids [string range $ids 1 end]
 137             }
 138             set ok 1
 139             foreach id $ids {
 140                 if {[string length $id] != 40} {
 141                     set ok 0
 142                     break
 143                 }
 144             }
 145         }
 146         if {!$ok} {
 147             set shortcmit $cmit
 148             if {[string length $shortcmit] > 80} {
 149                 set shortcmit "[string range $shortcmit 0 80]..."
 150             }
 151             error_popup "Can't parse git rev-list output: {$shortcmit}"
 152             exit 1
 153         }
 154         set id [lindex $ids 0]
 155         if {$listed} {
 156             set olds [lrange $ids 1 end]
 157             set i 0
 158             foreach p $olds {
 159                 if {$i == 0 || [lsearch -exact $olds $p] >= $i} {
 160                     lappend children($view,$p) $id
 161                 }
 162                 incr i
 163             }
 164         } else {
 165             set olds {}
 166         }
 167         if {![info exists children($view,$id)]} {
 168             set children($view,$id) {}
 169         }
 170         set commitdata($id) [string range $cmit [expr {$j + 1}] end]
 171         set commitrow($view,$id) $commitidx($view)
 172         incr commitidx($view)
 173         if {$view == $curview} {
 174             lappend parentlist $olds
 175             lappend childlist $children($view,$id)
 176             lappend displayorder $id
 177             lappend commitlisted $listed
 178         } else {
 179             lappend vparentlist($view) $olds
 180             lappend vchildlist($view) $children($view,$id)
 181             lappend vdisporder($view) $id
 182             lappend vcmitlisted($view) $listed
 183         }
 184         set gotsome 1
 185     }
 186     if {$gotsome} {
 187         if {$view == $curview} {
 188             layoutmore
 189         } elseif {[info exists hlview] && $view == $hlview} {
 190             vhighlightmore
 191         }
 192     }
 193     if {[clock clicks -milliseconds] >= $nextupdate} {
 194         doupdate
 195     }
 196 }
 197
 198 proc doupdate {} {
 199     global commfd nextupdate numcommits ncmupdate
 200
 201     foreach v [array names commfd] {
 202         fileevent $commfd($v) readable {}
 203     }
 204     update
 205     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
 206     if {$numcommits < 100} {
 207         set ncmupdate [expr {$numcommits + 1}]
 208     } elseif {$numcommits < 10000} {
 209         set ncmupdate [expr {$numcommits + 10}]
 210     } else {
 211         set ncmupdate [expr {$numcommits + 100}]
 212     }
 213     foreach v [array names commfd] {
 214         set fd $commfd($v)
 215         fileevent $fd readable [list getcommitlines $fd $v]
 216     }
 217 }
 218
 219 proc readcommit {id} {
 220     if {[catch {set contents [exec git cat-file commit $id]}]} return
 221     parsecommit $id $contents 0
 222 }
 223
 224 proc updatecommits {} {
 225     global viewdata curview phase displayorder
 226     global children commitrow selectedline thickerline
 227
 228     if {$phase ne {}} {
 229         stop_rev_list
 230         set phase {}
 231     }
 232     set n $curview
 233     foreach id $displayorder {
 234         catch {unset children($n,$id)}
 235         catch {unset commitrow($n,$id)}
 236     }
 237     set curview -1
 238     catch {unset selectedline}
 239     catch {unset thickerline}
 240     catch {unset viewdata($n)}
 241     discardallcommits
 242     readrefs
 243     showview $n
 244 }
 245
 246 proc parsecommit {id contents listed} {
 247     global commitinfo cdate
 248
 249     set inhdr 1
 250     set comment {}
 251     set headline {}
 252     set auname {}
 253     set audate {}
 254     set comname {}
 255     set comdate {}
 256     set hdrend [string first "\n\n" $contents]
 257     if {$hdrend < 0} {
 258         # should never happen...
 259         set hdrend [string length $contents]
 260     }
 261     set header [string range $contents 0 [expr {$hdrend - 1}]]
 262     set comment [string range $contents [expr {$hdrend + 2}] end]
 263     foreach line [split $header "\n"] {
 264         set tag [lindex $line 0]
 265         if {$tag == "author"} {
 266             set audate [lindex $line end-1]
 267             set auname [lrange $line 1 end-2]
 268         } elseif {$tag == "committer"} {
 269             set comdate [lindex $line end-1]
 270             set comname [lrange $line 1 end-2]
 271         }
 272     }
 273     set headline {}
 274     # take the first line of the comment as the headline
 275     set i [string first "\n" $comment]
 276     if {$i >= 0} {
 277         set headline [string trim [string range $comment 0 $i]]
 278     } else {
 279         set headline $comment
 280     }
 281     if {!$listed} {
 282         # git rev-list indents the comment by 4 spaces;
 283         # if we got this via git cat-file, add the indentation
 284         set newcomment {}
 285         foreach line [split $comment "\n"] {
 286             append newcomment "    "
 287             append newcomment $line
 288             append newcomment "\n"
 289         }
 290         set comment $newcomment
 291     }
 292     if {$comdate != {}} {
 293         set cdate($id) $comdate
 294     }
 295     set commitinfo($id) [list $headline $auname $audate \
 296                              $comname $comdate $comment]
 297 }
 298
 299 proc getcommit {id} {
 300     global commitdata commitinfo
 301
 302     if {[info exists commitdata($id)]} {
 303         parsecommit $id $commitdata($id) 1
 304     } else {
 305         readcommit $id
 306         if {![info exists commitinfo($id)]} {
 307             set commitinfo($id) {"No commit information available"}
 308         }
 309     }
 310     return 1
 311 }
 312
 313 proc readrefs {} {
 314     global tagids idtags headids idheads tagcontents
 315     global otherrefids idotherrefs mainhead
 316
 317     foreach v {tagids idtags headids idheads otherrefids idotherrefs} {
 318         catch {unset $v}
 319     }
 320     set refd [open [list | git ls-remote [gitdir]] r]
 321     while {0 <= [set n [gets $refd line]]} {
 322         if {![regexp {^([0-9a-f]{40})   refs/([^^]*)$} $line \
 323             match id path]} {
 324             continue
 325         }
 326         if {[regexp {^remotes/.*/HEAD$} $path match]} {
 327             continue
 328         }
 329         if {![regexp {^(tags|heads)/(.*)$} $path match type name]} {
 330             set type others
 331             set name $path
 332         }
 333         if {[regexp {^remotes/} $path match]} {
 334             set type heads
 335         }
 336         if {$type == "tags"} {
 337             set tagids($name) $id
 338             lappend idtags($id) $name
 339             set obj {}
 340             set type {}
 341             set tag {}
 342             catch {
 343                 set commit [exec git rev-parse "$id^0"]
 344                 if {$commit != $id} {
 345                     set tagids($name) $commit
 346                     lappend idtags($commit) $name
 347                 }
 348             }
 349             catch {
 350                 set tagcontents($name) [exec git cat-file tag $id]
 351             }
 352         } elseif { $type == "heads" } {
 353             set headids($name) $id
 354             lappend idheads($id) $name
 355         } else {
 356             set otherrefids($name) $id
 357             lappend idotherrefs($id) $name
 358         }
 359     }
 360     close $refd
 361     set mainhead {}
 362     catch {
 363         set thehead [exec git symbolic-ref HEAD]
 364         if {[string match "refs/heads/*" $thehead]} {
 365             set mainhead [string range $thehead 11 end]
 366         }
 367     }
 368 }
 369
 370 proc show_error {w top msg} {
 371     message $w.m -text $msg -justify center -aspect 400
 372     pack $w.m -side top -fill x -padx 20 -pady 20
 373     button $w.ok -text OK -command "destroy $top"
 374     pack $w.ok -side bottom -fill x
 375     bind $top <Visibility> "grab $top; focus $top"
 376     bind $top <Key-Return> "destroy $top"
 377     tkwait window $top
 378 }
 379
 380 proc error_popup msg {
 381     set w .error
 382     toplevel $w
 383     wm transient $w .
 384     show_error $w $w $msg
 385 }
 386
 387 proc confirm_popup msg {
 388     global confirm_ok
 389     set confirm_ok 0
 390     set w .confirm
 391     toplevel $w
 392     wm transient $w .
 393     message $w.m -text $msg -justify center -aspect 400
 394     pack $w.m -side top -fill x -padx 20 -pady 20
 395     button $w.ok -text OK -command "set confirm_ok 1; destroy $w"
 396     pack $w.ok -side left -fill x
 397     button $w.cancel -text Cancel -command "destroy $w"
 398     pack $w.cancel -side right -fill x
 399     bind $w <Visibility> "grab $w; focus $w"
 400     tkwait window $w
 401     return $confirm_ok
 402 }
 403
 404 proc makewindow {} {
 405     global canv canv2 canv3 linespc charspc ctext cflist
 406     global textfont mainfont uifont
 407     global findtype findtypemenu findloc findstring fstring geometry
 408     global entries sha1entry sha1string sha1but
 409     global maincursor textcursor curtextcursor
 410     global rowctxmenu mergemax wrapcomment
 411     global highlight_files gdttype
 412     global searchstring sstring
 413     global bgcolor fgcolor bglist fglist diffcolors
 414     global headctxmenu
 415
 416     menu .bar
 417     .bar add cascade -label "File" -menu .bar.file
 418     .bar configure -font $uifont
 419     menu .bar.file
 420     .bar.file add command -label "Update" -command updatecommits
 421     .bar.file add command -label "Reread references" -command rereadrefs
 422     .bar.file add command -label "Quit" -command doquit
 423     .bar.file configure -font $uifont
 424     menu .bar.edit
 425     .bar add cascade -label "Edit" -menu .bar.edit
 426     .bar.edit add command -label "Preferences" -command doprefs
 427     .bar.edit configure -font $uifont
 428
 429     menu .bar.view -font $uifont
 430     .bar add cascade -label "View" -menu .bar.view
 431     .bar.view add command -label "New view..." -command {newview 0}
 432     .bar.view add command -label "Edit view..." -command editview \
 433         -state disabled
 434     .bar.view add command -label "Delete view" -command delview -state disabled
 435     .bar.view add separator
 436     .bar.view add radiobutton -label "All files" -command {showview 0} \
 437         -variable selectedview -value 0
 438
 439     menu .bar.help
 440     .bar add cascade -label "Help" -menu .bar.help
 441     .bar.help add command -label "About gitk" -command about
 442     .bar.help add command -label "Key bindings" -command keys
 443     .bar.help configure -font $uifont
 444     . configure -menu .bar
 445
 446     if {![info exists geometry(canv1)]} {
 447         set geometry(canv1) [expr {45 * $charspc}]
 448         set geometry(canv2) [expr {30 * $charspc}]
 449         set geometry(canv3) [expr {15 * $charspc}]
 450         set geometry(canvh) [expr {25 * $linespc + 4}]
 451         set geometry(ctextw) 80
 452         set geometry(ctexth) 30
 453         set geometry(cflistw) 30
 454     }
 455     panedwindow .ctop -orient vertical
 456     if {[info exists geometry(width)]} {
 457         .ctop conf -width $geometry(width) -height $geometry(height)
 458         set texth [expr {$geometry(height) - $geometry(canvh) - 56}]
 459         set geometry(ctexth) [expr {($texth - 8) /
 460                                     [font metrics $textfont -linespace]}]
 461     }
 462     frame .ctop.top
 463     frame .ctop.top.bar
 464     frame .ctop.top.lbar
 465     pack .ctop.top.lbar -side bottom -fill x
 466     pack .ctop.top.bar -side bottom -fill x
 467     set cscroll .ctop.top.csb
 468     scrollbar $cscroll -command {allcanvs yview} -highlightthickness 0
 469     pack $cscroll -side right -fill y
 470     panedwindow .ctop.top.clist -orient horizontal -sashpad 0 -handlesize 4
 471     pack .ctop.top.clist -side top -fill both -expand 1
 472     .ctop add .ctop.top
 473     set canv .ctop.top.clist.canv
 474     canvas $canv -height $geometry(canvh) -width $geometry(canv1) \
 475         -background $bgcolor -bd 0 \
 476         -yscrollincr $linespc -yscrollcommand "scrollcanv $cscroll"
 477     .ctop.top.clist add $canv
 478     set canv2 .ctop.top.clist.canv2
 479     canvas $canv2 -height $geometry(canvh) -width $geometry(canv2) \
 480         -background $bgcolor -bd 0 -yscrollincr $linespc
 481     .ctop.top.clist add $canv2
 482     set canv3 .ctop.top.clist.canv3
 483     canvas $canv3 -height $geometry(canvh) -width $geometry(canv3) \
 484         -background $bgcolor -bd 0 -yscrollincr $linespc
 485     .ctop.top.clist add $canv3
 486     bind .ctop.top.clist <Configure> {resizeclistpanes %W %w}
 487     lappend bglist $canv $canv2 $canv3
 488
 489     set sha1entry .ctop.top.bar.sha1
 490     set entries $sha1entry
 491     set sha1but .ctop.top.bar.sha1label
 492     button $sha1but -text "SHA1 ID: " -state disabled -relief flat \
 493         -command gotocommit -width 8 -font $uifont
 494     $sha1but conf -disabledforeground [$sha1but cget -foreground]
 495     pack .ctop.top.bar.sha1label -side left
 496     entry $sha1entry -width 40 -font $textfont -textvariable sha1string
 497     trace add variable sha1string write sha1change
 498     pack $sha1entry -side left -pady 2
 499
 500     image create bitmap bm-left -data {
 501         #define left_width 16
 502         #define left_height 16
 503         static unsigned char left_bits[] = {
 504         0x00, 0x00, 0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0x1c, 0x00,
 505         0x0e, 0x00, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x0e, 0x00, 0x1c, 0x00,
 506         0x38, 0x00, 0x70, 0x00, 0xe0, 0x00, 0xc0, 0x01};
 507     }
 508     image create bitmap bm-right -data {
 509         #define right_width 16
 510         #define right_height 16
 511         static unsigned char right_bits[] = {
 512         0x00, 0x00, 0xc0, 0x01, 0x80, 0x03, 0x00, 0x07, 0x00, 0x0e, 0x00, 0x1c,
 513         0x00, 0x38, 0xff, 0x7f, 0xff, 0x7f, 0xff, 0x7f, 0x00, 0x38, 0x00, 0x1c,
 514         0x00, 0x0e, 0x00, 0x07, 0x80, 0x03, 0xc0, 0x01};
 515     }
 516     button .ctop.top.bar.leftbut -image bm-left -command goback \
 517         -state disabled -width 26
 518     pack .ctop.top.bar.leftbut -side left -fill y
 519     button .ctop.top.bar.rightbut -image bm-right -command goforw \
 520         -state disabled -width 26
 521     pack .ctop.top.bar.rightbut -side left -fill y
 522
 523     button .ctop.top.bar.findbut -text "Find" -command dofind -font $uifont
 524     pack .ctop.top.bar.findbut -side left
 525     set findstring {}
 526     set fstring .ctop.top.bar.findstring
 527     lappend entries $fstring
 528     entry $fstring -width 30 -font $textfont -textvariable findstring
 529     trace add variable findstring write find_change
 530     pack $fstring -side left -expand 1 -fill x
 531     set findtype Exact
 532     set findtypemenu [tk_optionMenu .ctop.top.bar.findtype \
 533                           findtype Exact IgnCase Regexp]
 534     trace add variable findtype write find_change
 535     .ctop.top.bar.findtype configure -font $uifont
 536     .ctop.top.bar.findtype.menu configure -font $uifont
 537     set findloc "All fields"
 538     tk_optionMenu .ctop.top.bar.findloc findloc "All fields" Headline \
 539         Comments Author Committer
 540     trace add variable findloc write find_change
 541     .ctop.top.bar.findloc configure -font $uifont
 542     .ctop.top.bar.findloc.menu configure -font $uifont
 543     pack .ctop.top.bar.findloc -side right
 544     pack .ctop.top.bar.findtype -side right
 545
 546     label .ctop.top.lbar.flabel -text "Highlight:  Commits " \
 547         -font $uifont
 548     pack .ctop.top.lbar.flabel -side left -fill y
 549     set gdttype "touching paths:"
 550     set gm [tk_optionMenu .ctop.top.lbar.gdttype gdttype "touching paths:" \
 551                 "adding/removing string:"]
 552     trace add variable gdttype write hfiles_change
 553     $gm conf -font $uifont
 554     .ctop.top.lbar.gdttype conf -font $uifont
 555     pack .ctop.top.lbar.gdttype -side left -fill y
 556     entry .ctop.top.lbar.fent -width 25 -font $textfont \
 557         -textvariable highlight_files
 558     trace add variable highlight_files write hfiles_change
 559     lappend entries .ctop.top.lbar.fent
 560     pack .ctop.top.lbar.fent -side left -fill x -expand 1
 561     label .ctop.top.lbar.vlabel -text " OR in view" -font $uifont
 562     pack .ctop.top.lbar.vlabel -side left -fill y
 563     global viewhlmenu selectedhlview
 564     set viewhlmenu [tk_optionMenu .ctop.top.lbar.vhl selectedhlview None]
 565     $viewhlmenu entryconf 0 -command delvhighlight
 566     $viewhlmenu conf -font $uifont
 567     .ctop.top.lbar.vhl conf -font $uifont
 568     pack .ctop.top.lbar.vhl -side left -fill y
 569     label .ctop.top.lbar.rlabel -text " OR " -font $uifont
 570     pack .ctop.top.lbar.rlabel -side left -fill y
 571     global highlight_related
 572     set m [tk_optionMenu .ctop.top.lbar.relm highlight_related None \
 573                "Descendent" "Not descendent" "Ancestor" "Not ancestor"]
 574     $m conf -font $uifont
 575     .ctop.top.lbar.relm conf -font $uifont
 576     trace add variable highlight_related write vrel_change
 577     pack .ctop.top.lbar.relm -side left -fill y
 578
 579     panedwindow .ctop.cdet -orient horizontal
 580     .ctop add .ctop.cdet
 581     frame .ctop.cdet.left
 582     frame .ctop.cdet.left.bot
 583     pack .ctop.cdet.left.bot -side bottom -fill x
 584     button .ctop.cdet.left.bot.search -text "Search" -command dosearch \
 585         -font $uifont
 586     pack .ctop.cdet.left.bot.search -side left -padx 5
 587     set sstring .ctop.cdet.left.bot.sstring
 588     entry $sstring -width 20 -font $textfont -textvariable searchstring
 589     lappend entries $sstring
 590     trace add variable searchstring write incrsearch
 591     pack $sstring -side left -expand 1 -fill x
 592     set ctext .ctop.cdet.left.ctext
 593     text $ctext -background $bgcolor -foreground $fgcolor \
 594         -state disabled -font $textfont \
 595         -width $geometry(ctextw) -height $geometry(ctexth) \
 596         -yscrollcommand scrolltext -wrap none
 597     scrollbar .ctop.cdet.left.sb -command "$ctext yview"
 598     pack .ctop.cdet.left.sb -side right -fill y
 599     pack $ctext -side left -fill both -expand 1
 600     .ctop.cdet add .ctop.cdet.left
 601     lappend bglist $ctext
 602     lappend fglist $ctext
 603
 604     $ctext tag conf comment -wrap $wrapcomment
 605     $ctext tag conf filesep -font [concat $textfont bold] -back "#aaaaaa"
 606     $ctext tag conf hunksep -fore [lindex $diffcolors 2]
 607     $ctext tag conf d0 -fore [lindex $diffcolors 0]
 608     $ctext tag conf d1 -fore [lindex $diffcolors 1]
 609     $ctext tag conf m0 -fore red
 610     $ctext tag conf m1 -fore blue
 611     $ctext tag conf m2 -fore green
 612     $ctext tag conf m3 -fore purple
 613     $ctext tag conf m4 -fore brown
 614     $ctext tag conf m5 -fore "#009090"
 615     $ctext tag conf m6 -fore magenta
 616     $ctext tag conf m7 -fore "#808000"
 617     $ctext tag conf m8 -fore "#009000"
 618     $ctext tag conf m9 -fore "#ff0080"
 619     $ctext tag conf m10 -fore cyan
 620     $ctext tag conf m11 -fore "#b07070"
 621     $ctext tag conf m12 -fore "#70b0f0"
 622     $ctext tag conf m13 -fore "#70f0b0"
 623     $ctext tag conf m14 -fore "#f0b070"
 624     $ctext tag conf m15 -fore "#ff70b0"
 625     $ctext tag conf mmax -fore darkgrey
 626     set mergemax 16
 627     $ctext tag conf mresult -font [concat $textfont bold]
 628     $ctext tag conf msep -font [concat $textfont bold]
 629     $ctext tag conf found -back yellow
 630
 631     frame .ctop.cdet.right
 632     frame .ctop.cdet.right.mode
 633     radiobutton .ctop.cdet.right.mode.patch -text "Patch" \
 634         -command reselectline -variable cmitmode -value "patch"
 635     radiobutton .ctop.cdet.right.mode.tree -text "Tree" \
 636         -command reselectline -variable cmitmode -value "tree"
 637     grid .ctop.cdet.right.mode.patch .ctop.cdet.right.mode.tree -sticky ew
 638     pack .ctop.cdet.right.mode -side top -fill x
 639     set cflist .ctop.cdet.right.cfiles
 640     set indent [font measure $mainfont "nn"]
 641     text $cflist -width $geometry(cflistw) \
 642         -background $bgcolor -foreground $fgcolor \
 643         -font $mainfont \
 644         -tabs [list $indent [expr {2 * $indent}]] \
 645         -yscrollcommand ".ctop.cdet.right.sb set" \
 646         -cursor [. cget -cursor] \
 647         -spacing1 1 -spacing3 1
 648     lappend bglist $cflist
 649     lappend fglist $cflist
 650     scrollbar .ctop.cdet.right.sb -command "$cflist yview"
 651     pack .ctop.cdet.right.sb -side right -fill y
 652     pack $cflist -side left -fill both -expand 1
 653     $cflist tag configure highlight \
 654         -background [$cflist cget -selectbackground]
 655     $cflist tag configure bold -font [concat $mainfont bold]
 656     .ctop.cdet add .ctop.cdet.right
 657     bind .ctop.cdet <Configure> {resizecdetpanes %W %w}
 658
 659     pack .ctop -side top -fill both -expand 1
 660
 661     bindall <1> {selcanvline %W %x %y}
 662     #bindall <B1-Motion> {selcanvline %W %x %y}
 663     bindall <ButtonRelease-4> "allcanvs yview scroll -5 units"
 664     bindall <ButtonRelease-5> "allcanvs yview scroll 5 units"
 665     bindall <2> "canvscan mark %W %x %y"
 666     bindall <B2-Motion> "canvscan dragto %W %x %y"
 667     bindkey <Home> selfirstline
 668     bindkey <End> sellastline
 669     bind . <Key-Up> "selnextline -1"
 670     bind . <Key-Down> "selnextline 1"
 671     bind . <Shift-Key-Up> "next_highlight -1"
 672     bind . <Shift-Key-Down> "next_highlight 1"
 673     bindkey <Key-Right> "goforw"
 674     bindkey <Key-Left> "goback"
 675     bind . <Key-Prior> "selnextpage -1"
 676     bind . <Key-Next> "selnextpage 1"
 677     bind . <Control-Home> "allcanvs yview moveto 0.0"
 678     bind . <Control-End> "allcanvs yview moveto 1.0"
 679     bind . <Control-Key-Up> "allcanvs yview scroll -1 units"
 680     bind . <Control-Key-Down> "allcanvs yview scroll 1 units"
 681     bind . <Control-Key-Prior> "allcanvs yview scroll -1 pages"
 682     bind . <Control-Key-Next> "allcanvs yview scroll 1 pages"
 683     bindkey <Key-Delete> "$ctext yview scroll -1 pages"
 684     bindkey <Key-BackSpace> "$ctext yview scroll -1 pages"
 685     bindkey <Key-space> "$ctext yview scroll 1 pages"
 686     bindkey p "selnextline -1"
 687     bindkey n "selnextline 1"
 688     bindkey z "goback"
 689     bindkey x "goforw"
 690     bindkey i "selnextline -1"
 691     bindkey k "selnextline 1"
 692     bindkey j "goback"
 693     bindkey l "goforw"
 694     bindkey b "$ctext yview scroll -1 pages"
 695     bindkey d "$ctext yview scroll 18 units"
 696     bindkey u "$ctext yview scroll -18 units"
 697     bindkey / {findnext 1}
 698     bindkey <Key-Return> {findnext 0}
 699     bindkey ? findprev
 700     bindkey f nextfile
 701     bind . <Control-q> doquit
 702     bind . <Control-f> dofind
 703     bind . <Control-g> {findnext 0}
 704     bind . <Control-r> dosearchback
 705     bind . <Control-s> dosearch
 706     bind . <Control-equal> {incrfont 1}
 707     bind . <Control-KP_Add> {incrfont 1}
 708     bind . <Control-minus> {incrfont -1}
 709     bind . <Control-KP_Subtract> {incrfont -1}
 710     bind . <Destroy> {savestuff %W}
 711     bind . <Button-1> "click %W"
 712     bind $fstring <Key-Return> dofind
 713     bind $sha1entry <Key-Return> gotocommit
 714     bind $sha1entry <<PasteSelection>> clearsha1
 715     bind $cflist <1> {sel_flist %W %x %y; break}
 716     bind $cflist <B1-Motion> {sel_flist %W %x %y; break}
 717     bind $cflist <ButtonRelease-1> {treeclick %W %x %y}
 718
 719     set maincursor [. cget -cursor]
 720     set textcursor [$ctext cget -cursor]
 721     set curtextcursor $textcursor
 722
 723     set rowctxmenu .rowctxmenu
 724     menu $rowctxmenu -tearoff 0
 725     $rowctxmenu add command -label "Diff this -> selected" \
 726         -command {diffvssel 0}
 727     $rowctxmenu add command -label "Diff selected -> this" \
 728         -command {diffvssel 1}
 729     $rowctxmenu add command -label "Make patch" -command mkpatch
 730     $rowctxmenu add command -label "Create tag" -command mktag
 731     $rowctxmenu add command -label "Write commit to file" -command writecommit
 732     $rowctxmenu add command -label "Create new branch" -command mkbranch
 733
 734     set headctxmenu .headctxmenu
 735     menu $headctxmenu -tearoff 0
 736     $headctxmenu add command -label "Check out this branch" \
 737         -command cobranch
 738     $headctxmenu add command -label "Remove this branch" \
 739         -command rmbranch
 740 }
 741
 742 # mouse-2 makes all windows scan vertically, but only the one
 743 # the cursor is in scans horizontally
 744 proc canvscan {op w x y} {
 745     global canv canv2 canv3
 746     foreach c [list $canv $canv2 $canv3] {
 747         if {$c == $w} {
 748             $c scan $op $x $y
 749         } else {
 750             $c scan $op 0 $y
 751         }
 752     }
 753 }
 754
 755 proc scrollcanv {cscroll f0 f1} {
 756     $cscroll set $f0 $f1
 757     drawfrac $f0 $f1
 758     flushhighlights
 759 }
 760
 761 # when we make a key binding for the toplevel, make sure
 762 # it doesn't get triggered when that key is pressed in the
 763 # find string entry widget.
 764 proc bindkey {ev script} {
 765     global entries
 766     bind . $ev $script
 767     set escript [bind Entry $ev]
 768     if {$escript == {}} {
 769         set escript [bind Entry <Key>]
 770     }
 771     foreach e $entries {
 772         bind $e $ev "$escript; break"
 773     }
 774 }
 775
 776 # set the focus back to the toplevel for any click outside
 777 # the entry widgets
 778 proc click {w} {
 779     global entries
 780     foreach e $entries {
 781         if {$w == $e} return
 782     }
 783     focus .
 784 }
 785
 786 proc savestuff {w} {
 787     global canv canv2 canv3 ctext cflist mainfont textfont uifont
 788     global stuffsaved findmergefiles maxgraphpct
 789     global maxwidth showneartags
 790     global viewname viewfiles viewargs viewperm nextviewnum
 791     global cmitmode wrapcomment
 792     global colors bgcolor fgcolor diffcolors
 793
 794     if {$stuffsaved} return
 795     if {![winfo viewable .]} return
 796     catch {
 797         set f [open "~/.gitk-new" w]
 798         puts $f [list set mainfont $mainfont]
 799         puts $f [list set textfont $textfont]
 800         puts $f [list set uifont $uifont]
 801         puts $f [list set findmergefiles $findmergefiles]
 802         puts $f [list set maxgraphpct $maxgraphpct]
 803         puts $f [list set maxwidth $maxwidth]
 804         puts $f [list set cmitmode $cmitmode]
 805         puts $f [list set wrapcomment $wrapcomment]
 806         puts $f [list set showneartags $showneartags]
 807         puts $f [list set bgcolor $bgcolor]
 808         puts $f [list set fgcolor $fgcolor]
 809         puts $f [list set colors $colors]
 810         puts $f [list set diffcolors $diffcolors]
 811         puts $f "set geometry(width) [winfo width .ctop]"
 812         puts $f "set geometry(height) [winfo height .ctop]"
 813         puts $f "set geometry(canv1) [expr {[winfo width $canv]-2}]"
 814         puts $f "set geometry(canv2) [expr {[winfo width $canv2]-2}]"
 815         puts $f "set geometry(canv3) [expr {[winfo width $canv3]-2}]"
 816         puts $f "set geometry(canvh) [expr {[winfo height $canv]-2}]"
 817         set wid [expr {([winfo width $ctext] - 8) \
 818                            / [font measure $textfont "0"]}]
 819         puts $f "set geometry(ctextw) $wid"
 820         set wid [expr {([winfo width $cflist] - 11) \
 821                            / [font measure [$cflist cget -font] "0"]}]
 822         puts $f "set geometry(cflistw) $wid"
 823         puts -nonewline $f "set permviews {"
 824         for {set v 0} {$v < $nextviewnum} {incr v} {
 825             if {$viewperm($v)} {
 826                 puts $f "{[list $viewname($v) $viewfiles($v) $viewargs($v)]}"
 827             }
 828         }
 829         puts $f "}"
 830         close $f
 831         file rename -force "~/.gitk-new" "~/.gitk"
 832     }
 833     set stuffsaved 1
 834 }
 835
 836 proc resizeclistpanes {win w} {
 837     global oldwidth
 838     if {[info exists oldwidth($win)]} {
 839         set s0 [$win sash coord 0]
 840         set s1 [$win sash coord 1]
 841         if {$w < 60} {
 842             set sash0 [expr {int($w/2 - 2)}]
 843             set sash1 [expr {int($w*5/6 - 2)}]
 844         } else {
 845             set factor [expr {1.0 * $w / $oldwidth($win)}]
 846             set sash0 [expr {int($factor * [lindex $s0 0])}]
 847             set sash1 [expr {int($factor * [lindex $s1 0])}]
 848             if {$sash0 < 30} {
 849                 set sash0 30
 850             }
 851             if {$sash1 < $sash0 + 20} {
 852                 set sash1 [expr {$sash0 + 20}]
 853             }
 854             if {$sash1 > $w - 10} {
 855                 set sash1 [expr {$w - 10}]
 856                 if {$sash0 > $sash1 - 20} {
 857                     set sash0 [expr {$sash1 - 20}]
 858                 }
 859             }
 860         }
 861         $win sash place 0 $sash0 [lindex $s0 1]
 862         $win sash place 1 $sash1 [lindex $s1 1]
 863     }
 864     set oldwidth($win) $w
 865 }
 866
 867 proc resizecdetpanes {win w} {
 868     global oldwidth
 869     if {[info exists oldwidth($win)]} {
 870         set s0 [$win sash coord 0]
 871         if {$w < 60} {
 872             set sash0 [expr {int($w*3/4 - 2)}]
 873         } else {
 874             set factor [expr {1.0 * $w / $oldwidth($win)}]
 875             set sash0 [expr {int($factor * [lindex $s0 0])}]
 876             if {$sash0 < 45} {
 877                 set sash0 45
 878             }
 879             if {$sash0 > $w - 15} {
 880                 set sash0 [expr {$w - 15}]
 881             }
 882         }
 883         $win sash place 0 $sash0 [lindex $s0 1]
 884     }
 885     set oldwidth($win) $w
 886 }
 887
 888 proc allcanvs args {
 889     global canv canv2 canv3
 890     eval $canv $args
 891     eval $canv2 $args
 892     eval $canv3 $args
 893 }
 894
 895 proc bindall {event action} {
 896     global canv canv2 canv3
 897     bind $canv $event $action
 898     bind $canv2 $event $action
 899     bind $canv3 $event $action
 900 }
 901
 902 proc about {} {
 903     set w .about
 904     if {[winfo exists $w]} {
 905         raise $w
 906         return
 907     }
 908     toplevel $w
 909     wm title $w "About gitk"
 910     message $w.m -text {
 911 Gitk - a commit viewer for git
 912
 913 Copyright © 2005-2006 Paul Mackerras
 914
 915 Use and redistribute under the terms of the GNU General Public License} \
 916             -justify center -aspect 400
 917     pack $w.m -side top -fill x -padx 20 -pady 20
 918     button $w.ok -text Close -command "destroy $w"
 919     pack $w.ok -side bottom
 920 }
 921
 922 proc keys {} {
 923     set w .keys
 924     if {[winfo exists $w]} {
 925         raise $w
 926         return
 927     }
 928     toplevel $w
 929     wm title $w "Gitk key bindings"
 930     message $w.m -text {
 931 Gitk key bindings:
 932
 933 <Ctrl-Q>                Quit
 934 <Home>          Move to first commit
 935 <End>           Move to last commit
 936 <Up>, p, i      Move up one commit
 937 <Down>, n, k    Move down one commit
 938 <Left>, z, j    Go back in history list
 939 <Right>, x, l   Go forward in history list
 940 <PageUp>        Move up one page in commit list
 941 <PageDown>      Move down one page in commit list
 942 <Ctrl-Home>     Scroll to top of commit list
 943 <Ctrl-End>      Scroll to bottom of commit list
 944 <Ctrl-Up>       Scroll commit list up one line
 945 <Ctrl-Down>     Scroll commit list down one line
 946 <Ctrl-PageUp>   Scroll commit list up one page
 947 <Ctrl-PageDown> Scroll commit list down one page
 948 <Shift-Up>      Move to previous highlighted line
 949 <Shift-Down>    Move to next highlighted line
 950 <Delete>, b     Scroll diff view up one page
 951 <Backspace>     Scroll diff view up one page
 952 <Space>         Scroll diff view down one page
 953 u               Scroll diff view up 18 lines
 954 d               Scroll diff view down 18 lines
 955 <Ctrl-F>                Find
 956 <Ctrl-G>                Move to next find hit
 957 <Return>        Move to next find hit
 958 /               Move to next find hit, or redo find
 959 ?               Move to previous find hit
 960 f               Scroll diff view to next file
 961 <Ctrl-S>                Search for next hit in diff view
 962 <Ctrl-R>                Search for previous hit in diff view
 963 <Ctrl-KP+>      Increase font size
 964 <Ctrl-plus>     Increase font size
 965 <Ctrl-KP->      Decrease font size
 966 <Ctrl-minus>    Decrease font size
 967 } \
 968             -justify left -bg white -border 2 -relief sunken
 969     pack $w.m -side top -fill both
 970     button $w.ok -text Close -command "destroy $w"
 971     pack $w.ok -side bottom
 972 }
 973
 974 # Procedures for manipulating the file list window at the
 975 # bottom right of the overall window.
 976
 977 proc treeview {w l openlevs} {
 978     global treecontents treediropen treeheight treeparent treeindex
 979
 980     set ix 0
 981     set treeindex() 0
 982     set lev 0
 983     set prefix {}
 984     set prefixend -1
 985     set prefendstack {}
 986     set htstack {}
 987     set ht 0
 988     set treecontents() {}
 989     $w conf -state normal
 990     foreach f $l {
 991         while {[string range $f 0 $prefixend] ne $prefix} {
 992             if {$lev <= $openlevs} {
 993                 $w mark set e:$treeindex($prefix) "end -1c"
 994                 $w mark gravity e:$treeindex($prefix) left
 995             }
 996             set treeheight($prefix) $ht
 997             incr ht [lindex $htstack end]
 998             set htstack [lreplace $htstack end end]
 999             set prefixend [lindex $prefendstack end]
1000             set prefendstack [lreplace $prefendstack end end]
1001             set prefix [string range $prefix 0 $prefixend]
1002             incr lev -1
1003         }
1004         set tail [string range $f [expr {$prefixend+1}] end]
1005         while {[set slash [string first "/" $tail]] >= 0} {
1006             lappend htstack $ht
1007             set ht 0
1008             lappend prefendstack $prefixend
1009             incr prefixend [expr {$slash + 1}]
1010             set d [string range $tail 0 $slash]
1011             lappend treecontents($prefix) $d
1012             set oldprefix $prefix
1013             append prefix $d
1014             set treecontents($prefix) {}
1015             set treeindex($prefix) [incr ix]
1016             set treeparent($prefix) $oldprefix
1017             set tail [string range $tail [expr {$slash+1}] end]
1018             if {$lev <= $openlevs} {
1019                 set ht 1
1020                 set treediropen($prefix) [expr {$lev < $openlevs}]
1021                 set bm [expr {$lev == $openlevs? "tri-rt": "tri-dn"}]
1022                 $w mark set d:$ix "end -1c"
1023                 $w mark gravity d:$ix left
1024                 set str "\n"
1025                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1026                 $w insert end $str
1027                 $w image create end -align center -image $bm -padx 1 \
1028                     -name a:$ix
1029                 $w insert end $d [highlight_tag $prefix]
1030                 $w mark set s:$ix "end -1c"
1031                 $w mark gravity s:$ix left
1032             }
1033             incr lev
1034         }
1035         if {$tail ne {}} {
1036             if {$lev <= $openlevs} {
1037                 incr ht
1038                 set str "\n"
1039                 for {set i 0} {$i < $lev} {incr i} {append str "\t"}
1040                 $w insert end $str
1041                 $w insert end $tail [highlight_tag $f]
1042             }
1043             lappend treecontents($prefix) $tail
1044         }
1045     }
1046     while {$htstack ne {}} {
1047         set treeheight($prefix) $ht
1048         incr ht [lindex $htstack end]
1049         set htstack [lreplace $htstack end end]
1050     }
1051     $w conf -state disabled
1052 }
1053
1054 proc linetoelt {l} {
1055     global treeheight treecontents
1056
1057     set y 2
1058     set prefix {}
1059     while {1} {
1060         foreach e $treecontents($prefix) {
1061             if {$y == $l} {
1062                 return "$prefix$e"
1063             }
1064             set n 1
1065             if {[string index $e end] eq "/"} {
1066                 set n $treeheight($prefix$e)
1067                 if {$y + $n > $l} {
1068                     append prefix $e
1069                     incr y
1070                     break
1071                 }
1072             }
1073             incr y $n
1074         }
1075     }
1076 }
1077
1078 proc highlight_tree {y prefix} {
1079     global treeheight treecontents cflist
1080
1081     foreach e $treecontents($prefix) {
1082         set path $prefix$e
1083         if {[highlight_tag $path] ne {}} {
1084             $cflist tag add bold $y.0 "$y.0 lineend"
1085         }
1086         incr y
1087         if {[string index $e end] eq "/" && $treeheight($path) > 1} {
1088             set y [highlight_tree $y $path]
1089         }
1090     }
1091     return $y
1092 }
1093
1094 proc treeclosedir {w dir} {
1095     global treediropen treeheight treeparent treeindex
1096
1097     set ix $treeindex($dir)
1098     $w conf -state normal
1099     $w delete s:$ix e:$ix
1100     set treediropen($dir) 0
1101     $w image configure a:$ix -image tri-rt
1102     $w conf -state disabled
1103     set n [expr {1 - $treeheight($dir)}]
1104     while {$dir ne {}} {
1105         incr treeheight($dir) $n
1106         set dir $treeparent($dir)
1107     }
1108 }
1109
1110 proc treeopendir {w dir} {
1111     global treediropen treeheight treeparent treecontents treeindex
1112
1113     set ix $treeindex($dir)
1114     $w conf -state normal
1115     $w image configure a:$ix -image tri-dn
1116     $w mark set e:$ix s:$ix
1117     $w mark gravity e:$ix right
1118     set lev 0
1119     set str "\n"
1120     set n [llength $treecontents($dir)]
1121     for {set x $dir} {$x ne {}} {set x $treeparent($x)} {
1122         incr lev
1123         append str "\t"
1124         incr treeheight($x) $n
1125     }
1126     foreach e $treecontents($dir) {
1127         set de $dir$e
1128         if {[string index $e end] eq "/"} {
1129             set iy $treeindex($de)
1130             $w mark set d:$iy e:$ix
1131             $w mark gravity d:$iy left
1132             $w insert e:$ix $str
1133             set treediropen($de) 0
1134             $w image create e:$ix -align center -image tri-rt -padx 1 \
1135                 -name a:$iy
1136             $w insert e:$ix $e [highlight_tag $de]
1137             $w mark set s:$iy e:$ix
1138             $w mark gravity s:$iy left
1139             set treeheight($de) 1
1140         } else {
1141             $w insert e:$ix $str
1142             $w insert e:$ix $e [highlight_tag $de]
1143         }
1144     }
1145     $w mark gravity e:$ix left
1146     $w conf -state disabled
1147     set treediropen($dir) 1
1148     set top [lindex [split [$w index @0,0] .] 0]
1149     set ht [$w cget -height]
1150     set l [lindex [split [$w index s:$ix] .] 0]
1151     if {$l < $top} {
1152         $w yview $l.0
1153     } elseif {$l + $n + 1 > $top + $ht} {
1154         set top [expr {$l + $n + 2 - $ht}]
1155         if {$l < $top} {
1156             set top $l
1157         }
1158         $w yview $top.0
1159     }
1160 }
1161
1162 proc treeclick {w x y} {
1163     global treediropen cmitmode ctext cflist cflist_top
1164
1165     if {$cmitmode ne "tree"} return
1166     if {![info exists cflist_top]} return
1167     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1168     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1169     $cflist tag add highlight $l.0 "$l.0 lineend"
1170     set cflist_top $l
1171     if {$l == 1} {
1172         $ctext yview 1.0
1173         return
1174     }
1175     set e [linetoelt $l]
1176     if {[string index $e end] ne "/"} {
1177         showfile $e
1178     } elseif {$treediropen($e)} {
1179         treeclosedir $w $e
1180     } else {
1181         treeopendir $w $e
1182     }
1183 }
1184
1185 proc setfilelist {id} {
1186     global treefilelist cflist
1187
1188     treeview $cflist $treefilelist($id) 0
1189 }
1190
1191 image create bitmap tri-rt -background black -foreground blue -data {
1192     #define tri-rt_width 13
1193     #define tri-rt_height 13
1194     static unsigned char tri-rt_bits[] = {
1195        0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xf0, 0x00,
1196        0xf0, 0x01, 0xf0, 0x00, 0x70, 0x00, 0x30, 0x00, 0x10, 0x00, 0x00, 0x00,
1197        0x00, 0x00};
1198 } -maskdata {
1199     #define tri-rt-mask_width 13
1200     #define tri-rt-mask_height 13
1201     static unsigned char tri-rt-mask_bits[] = {
1202        0x08, 0x00, 0x18, 0x00, 0x38, 0x00, 0x78, 0x00, 0xf8, 0x00, 0xf8, 0x01,
1203        0xf8, 0x03, 0xf8, 0x01, 0xf8, 0x00, 0x78, 0x00, 0x38, 0x00, 0x18, 0x00,
1204        0x08, 0x00};
1205 }
1206 image create bitmap tri-dn -background black -foreground blue -data {
1207     #define tri-dn_width 13
1208     #define tri-dn_height 13
1209     static unsigned char tri-dn_bits[] = {
1210        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xf8, 0x03,
1211        0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
1212        0x00, 0x00};
1213 } -maskdata {
1214     #define tri-dn-mask_width 13
1215     #define tri-dn-mask_height 13
1216     static unsigned char tri-dn-mask_bits[] = {
1217        0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0x1f, 0xfe, 0x0f, 0xfc, 0x07,
1218        0xf8, 0x03, 0xf0, 0x01, 0xe0, 0x00, 0x40, 0x00, 0x00, 0x00, 0x00, 0x00,
1219        0x00, 0x00};
1220 }
1221
1222 proc init_flist {first} {
1223     global cflist cflist_top selectedline difffilestart
1224
1225     $cflist conf -state normal
1226     $cflist delete 0.0 end
1227     if {$first ne {}} {
1228         $cflist insert end $first
1229         set cflist_top 1
1230         $cflist tag add highlight 1.0 "1.0 lineend"
1231     } else {
1232         catch {unset cflist_top}
1233     }
1234     $cflist conf -state disabled
1235     set difffilestart {}
1236 }
1237
1238 proc highlight_tag {f} {
1239     global highlight_paths
1240
1241     foreach p $highlight_paths {
1242         if {[string match $p $f]} {
1243             return "bold"
1244         }
1245     }
1246     return {}
1247 }
1248
1249 proc highlight_filelist {} {
1250     global cmitmode cflist
1251
1252     $cflist conf -state normal
1253     if {$cmitmode ne "tree"} {
1254         set end [lindex [split [$cflist index end] .] 0]
1255         for {set l 2} {$l < $end} {incr l} {
1256             set line [$cflist get $l.0 "$l.0 lineend"]
1257             if {[highlight_tag $line] ne {}} {
1258                 $cflist tag add bold $l.0 "$l.0 lineend"
1259             }
1260         }
1261     } else {
1262         highlight_tree 2 {}
1263     }
1264     $cflist conf -state disabled
1265 }
1266
1267 proc unhighlight_filelist {} {
1268     global cflist
1269
1270     $cflist conf -state normal
1271     $cflist tag remove bold 1.0 end
1272     $cflist conf -state disabled
1273 }
1274
1275 proc add_flist {fl} {
1276     global cflist
1277
1278     $cflist conf -state normal
1279     foreach f $fl {
1280         $cflist insert end "\n"
1281         $cflist insert end $f [highlight_tag $f]
1282     }
1283     $cflist conf -state disabled
1284 }
1285
1286 proc sel_flist {w x y} {
1287     global ctext difffilestart cflist cflist_top cmitmode
1288
1289     if {$cmitmode eq "tree"} return
1290     if {![info exists cflist_top]} return
1291     set l [lindex [split [$w index "@$x,$y"] "."] 0]
1292     $cflist tag remove highlight $cflist_top.0 "$cflist_top.0 lineend"
1293     $cflist tag add highlight $l.0 "$l.0 lineend"
1294     set cflist_top $l
1295     if {$l == 1} {
1296         $ctext yview 1.0
1297     } else {
1298         catch {$ctext yview [lindex $difffilestart [expr {$l - 2}]]}
1299     }
1300 }
1301
1302 # Functions for adding and removing shell-type quoting
1303
1304 proc shellquote {str} {
1305     if {![string match "*\['\"\\ \t]*" $str]} {
1306         return $str
1307     }
1308     if {![string match "*\['\"\\]*" $str]} {
1309         return "\"$str\""
1310     }
1311     if {![string match "*'*" $str]} {
1312         return "'$str'"
1313     }
1314     return "\"[string map {\" \\\" \\ \\\\} $str]\""
1315 }
1316
1317 proc shellarglist {l} {
1318     set str {}
1319     foreach a $l {
1320         if {$str ne {}} {
1321             append str " "
1322         }
1323         append str [shellquote $a]
1324     }
1325     return $str
1326 }
1327
1328 proc shelldequote {str} {
1329     set ret {}
1330     set used -1
1331     while {1} {
1332         incr used
1333         if {![regexp -start $used -indices "\['\"\\\\ \t]" $str first]} {
1334             append ret [string range $str $used end]
1335             set used [string length $str]
1336             break
1337         }
1338         set first [lindex $first 0]
1339         set ch [string index $str $first]
1340         if {$first > $used} {
1341             append ret [string range $str $used [expr {$first - 1}]]
1342             set used $first
1343         }
1344         if {$ch eq " " || $ch eq "\t"} break
1345         incr used
1346         if {$ch eq "'"} {
1347             set first [string first "'" $str $used]
1348             if {$first < 0} {
1349                 error "unmatched single-quote"
1350             }
1351             append ret [string range $str $used [expr {$first - 1}]]
1352             set used $first
1353             continue
1354         }
1355         if {$ch eq "\\"} {
1356             if {$used >= [string length $str]} {
1357                 error "trailing backslash"
1358             }
1359             append ret [string index $str $used]
1360             continue
1361         }
1362         # here ch == "\""
1363         while {1} {
1364             if {![regexp -start $used -indices "\[\"\\\\]" $str first]} {
1365                 error "unmatched double-quote"
1366             }
1367             set first [lindex $first 0]
1368             set ch [string index $str $first]
1369             if {$first > $used} {
1370                 append ret [string range $str $used [expr {$first - 1}]]
1371                 set used $first
1372             }
1373             if {$ch eq "\""} break
1374             incr used
1375             append ret [string index $str $used]
1376             incr used
1377         }
1378     }
1379     return [list $used $ret]
1380 }
1381
1382 proc shellsplit {str} {
1383     set l {}
1384     while {1} {
1385         set str [string trimleft $str]
1386         if {$str eq {}} break
1387         set dq [shelldequote $str]
1388         set n [lindex $dq 0]
1389         set word [lindex $dq 1]
1390         set str [string range $str $n end]
1391         lappend l $word
1392     }
1393     return $l
1394 }
1395
1396 # Code to implement multiple views
1397
1398 proc newview {ishighlight} {
1399     global nextviewnum newviewname newviewperm uifont newishighlight
1400     global newviewargs revtreeargs
1401
1402     set newishighlight $ishighlight
1403     set top .gitkview
1404     if {[winfo exists $top]} {
1405         raise $top
1406         return
1407     }
1408     set newviewname($nextviewnum) "View $nextviewnum"
1409     set newviewperm($nextviewnum) 0
1410     set newviewargs($nextviewnum) [shellarglist $revtreeargs]
1411     vieweditor $top $nextviewnum "Gitk view definition"
1412 }
1413
1414 proc editview {} {
1415     global curview
1416     global viewname viewperm newviewname newviewperm
1417     global viewargs newviewargs
1418
1419     set top .gitkvedit-$curview
1420     if {[winfo exists $top]} {
1421         raise $top
1422         return
1423     }
1424     set newviewname($curview) $viewname($curview)
1425     set newviewperm($curview) $viewperm($curview)
1426     set newviewargs($curview) [shellarglist $viewargs($curview)]
1427     vieweditor $top $curview "Gitk: edit view $viewname($curview)"
1428 }
1429
1430 proc vieweditor {top n title} {
1431     global newviewname newviewperm viewfiles
1432     global uifont
1433
1434     toplevel $top
1435     wm title $top $title
1436     label $top.nl -text "Name" -font $uifont
1437     entry $top.name -width 20 -textvariable newviewname($n)
1438     grid $top.nl $top.name -sticky w -pady 5
1439     checkbutton $top.perm -text "Remember this view" -variable newviewperm($n)
1440     grid $top.perm - -pady 5 -sticky w
1441     message $top.al -aspect 1000 -font $uifont \
1442         -text "Commits to include (arguments to git rev-list):"
1443     grid $top.al - -sticky w -pady 5
1444     entry $top.args -width 50 -textvariable newviewargs($n) \
1445         -background white
1446     grid $top.args - -sticky ew -padx 5
1447     message $top.l -aspect 1000 -font $uifont \
1448         -text "Enter files and directories to include, one per line:"
1449     grid $top.l - -sticky w
1450     text $top.t -width 40 -height 10 -background white
1451     if {[info exists viewfiles($n)]} {
1452         foreach f $viewfiles($n) {
1453             $top.t insert end $f
1454             $top.t insert end "\n"
1455         }
1456         $top.t delete {end - 1c} end
1457         $top.t mark set insert 0.0
1458     }
1459     grid $top.t - -sticky ew -padx 5
1460     frame $top.buts
1461     button $top.buts.ok -text "OK" -command [list newviewok $top $n]
1462     button $top.buts.can -text "Cancel" -command [list destroy $top]
1463     grid $top.buts.ok $top.buts.can
1464     grid columnconfigure $top.buts 0 -weight 1 -uniform a
1465     grid columnconfigure $top.buts 1 -weight 1 -uniform a
1466     grid $top.buts - -pady 10 -sticky ew
1467     focus $top.t
1468 }
1469
1470 proc doviewmenu {m first cmd op argv} {
1471     set nmenu [$m index end]
1472     for {set i $first} {$i <= $nmenu} {incr i} {
1473         if {[$m entrycget $i -command] eq $cmd} {
1474             eval $m $op $i $argv
1475             break
1476         }
1477     }
1478 }
1479
1480 proc allviewmenus {n op args} {
1481     global viewhlmenu
1482
1483     doviewmenu .bar.view 7 [list showview $n] $op $args
1484     doviewmenu $viewhlmenu 1 [list addvhighlight $n] $op $args
1485 }
1486
1487 proc newviewok {top n} {
1488     global nextviewnum newviewperm newviewname newishighlight
1489     global viewname viewfiles viewperm selectedview curview
1490     global viewargs newviewargs viewhlmenu
1491
1492     if {[catch {
1493         set newargs [shellsplit $newviewargs($n)]
1494     } err]} {
1495         error_popup "Error in commit selection arguments: $err"
1496         wm raise $top
1497         focus $top
1498         return
1499     }
1500     set files {}
1501     foreach f [split [$top.t get 0.0 end] "\n"] {
1502         set ft [string trim $f]
1503         if {$ft ne {}} {
1504             lappend files $ft
1505         }
1506     }
1507     if {![info exists viewfiles($n)]} {
1508         # creating a new view
1509         incr nextviewnum
1510         set viewname($n) $newviewname($n)
1511         set viewperm($n) $newviewperm($n)
1512         set viewfiles($n) $files
1513         set viewargs($n) $newargs
1514         addviewmenu $n
1515         if {!$newishighlight} {
1516             after idle showview $n
1517         } else {
1518             after idle addvhighlight $n
1519         }
1520     } else {
1521         # editing an existing view
1522         set viewperm($n) $newviewperm($n)
1523         if {$newviewname($n) ne $viewname($n)} {
1524             set viewname($n) $newviewname($n)
1525             doviewmenu .bar.view 7 [list showview $n] \
1526                 entryconf [list -label $viewname($n)]
1527             doviewmenu $viewhlmenu 1 [list addvhighlight $n] \
1528                 entryconf [list -label $viewname($n) -value $viewname($n)]
1529         }
1530         if {$files ne $viewfiles($n) || $newargs ne $viewargs($n)} {
1531             set viewfiles($n) $files
1532             set viewargs($n) $newargs
1533             if {$curview == $n} {
1534                 after idle updatecommits
1535             }
1536         }
1537     }
1538     catch {destroy $top}
1539 }
1540
1541 proc delview {} {
1542     global curview viewdata viewperm hlview selectedhlview
1543
1544     if {$curview == 0} return
1545     if {[info exists hlview] && $hlview == $curview} {
1546         set selectedhlview None
1547         unset hlview
1548     }
1549     allviewmenus $curview delete
1550     set viewdata($curview) {}
1551     set viewperm($curview) 0
1552     showview 0
1553 }
1554
1555 proc addviewmenu {n} {
1556     global viewname viewhlmenu
1557
1558     .bar.view add radiobutton -label $viewname($n) \
1559         -command [list showview $n] -variable selectedview -value $n
1560     $viewhlmenu add radiobutton -label $viewname($n) \
1561         -command [list addvhighlight $n] -variable selectedhlview
1562 }
1563
1564 proc flatten {var} {
1565     global $var
1566
1567     set ret {}
1568     foreach i [array names $var] {
1569         lappend ret $i [set $var\($i\)]
1570     }
1571     return $ret
1572 }
1573
1574 proc unflatten {var l} {
1575     global $var
1576
1577     catch {unset $var}
1578     foreach {i v} $l {
1579         set $var\($i\) $v
1580     }
1581 }
1582
1583 proc showview {n} {
1584     global curview viewdata viewfiles
1585     global displayorder parentlist childlist rowidlist rowoffsets
1586     global colormap rowtextx commitrow nextcolor canvxmax
1587     global numcommits rowrangelist commitlisted idrowranges
1588     global selectedline currentid canv canvy0
1589     global matchinglines treediffs
1590     global pending_select phase
1591     global commitidx rowlaidout rowoptim linesegends
1592     global commfd nextupdate
1593     global selectedview
1594     global vparentlist vchildlist vdisporder vcmitlisted
1595     global hlview selectedhlview
1596
1597     if {$n == $curview} return
1598     set selid {}
1599     if {[info exists selectedline]} {
1600         set selid $currentid
1601         set y [yc $selectedline]
1602         set ymax [lindex [$canv cget -scrollregion] 3]
1603         set span [$canv yview]
1604         set ytop [expr {[lindex $span 0] * $ymax}]
1605         set ybot [expr {[lindex $span 1] * $ymax}]
1606         if {$ytop < $y && $y < $ybot} {
1607             set yscreen [expr {$y - $ytop}]
1608         } else {
1609             set yscreen [expr {($ybot - $ytop) / 2}]
1610         }
1611     }
1612     unselectline
1613     normalline
1614     stopfindproc
1615     if {$curview >= 0} {
1616         set vparentlist($curview) $parentlist
1617         set vchildlist($curview) $childlist
1618         set vdisporder($curview) $displayorder
1619         set vcmitlisted($curview) $commitlisted
1620         if {$phase ne {}} {
1621             set viewdata($curview) \
1622                 [list $phase $rowidlist $rowoffsets $rowrangelist \
1623                      [flatten idrowranges] [flatten idinlist] \
1624                      $rowlaidout $rowoptim $numcommits $linesegends]
1625         } elseif {![info exists viewdata($curview)]
1626                   || [lindex $viewdata($curview) 0] ne {}} {
1627             set viewdata($curview) \
1628                 [list {} $rowidlist $rowoffsets $rowrangelist]
1629         }
1630     }
1631     catch {unset matchinglines}
1632     catch {unset treediffs}
1633     clear_display
1634     if {[info exists hlview] && $hlview == $n} {
1635         unset hlview
1636         set selectedhlview None
1637     }
1638
1639     set curview $n
1640     set selectedview $n
1641     .bar.view entryconf 2 -state [expr {$n == 0? "disabled": "normal"}]
1642     .bar.view entryconf 3 -state [expr {$n == 0? "disabled": "normal"}]
1643
1644     if {![info exists viewdata($n)]} {
1645         set pending_select $selid
1646         getcommits
1647         return
1648     }
1649
1650     set v $viewdata($n)
1651     set phase [lindex $v 0]
1652     set displayorder $vdisporder($n)
1653     set parentlist $vparentlist($n)
1654     set childlist $vchildlist($n)
1655     set commitlisted $vcmitlisted($n)
1656     set rowidlist [lindex $v 1]
1657     set rowoffsets [lindex $v 2]
1658     set rowrangelist [lindex $v 3]
1659     if {$phase eq {}} {
1660         set numcommits [llength $displayorder]
1661         catch {unset idrowranges}
1662     } else {
1663         unflatten idrowranges [lindex $v 4]
1664         unflatten idinlist [lindex $v 5]
1665         set rowlaidout [lindex $v 6]
1666         set rowoptim [lindex $v 7]
1667         set numcommits [lindex $v 8]
1668         set linesegends [lindex $v 9]
1669     }
1670
1671     catch {unset colormap}
1672     catch {unset rowtextx}
1673     set nextcolor 0
1674     set canvxmax [$canv cget -width]
1675     set curview $n
1676     set row 0
1677     setcanvscroll
1678     set yf 0
1679     set row 0
1680     if {$selid ne {} && [info exists commitrow($n,$selid)]} {
1681         set row $commitrow($n,$selid)
1682         # try to get the selected row in the same position on the screen
1683         set ymax [lindex [$canv cget -scrollregion] 3]
1684         set ytop [expr {[yc $row] - $yscreen}]
1685         if {$ytop < 0} {
1686             set ytop 0
1687         }
1688         set yf [expr {$ytop * 1.0 / $ymax}]
1689     }
1690     allcanvs yview moveto $yf
1691     drawvisible
1692     selectline $row 0
1693     if {$phase ne {}} {
1694         if {$phase eq "getcommits"} {
1695             show_status "Reading commits..."
1696         }
1697         if {[info exists commfd($n)]} {
1698             layoutmore
1699         } else {
1700             finishcommits
1701         }
1702     } elseif {$numcommits == 0} {
1703         show_status "No commits selected"
1704     }
1705 }
1706
1707 # Stuff relating to the highlighting facility
1708
1709 proc ishighlighted {row} {
1710     global vhighlights fhighlights nhighlights rhighlights
1711
1712     if {[info exists nhighlights($row)] && $nhighlights($row) > 0} {
1713         return $nhighlights($row)
1714     }
1715     if {[info exists vhighlights($row)] && $vhighlights($row) > 0} {
1716         return $vhighlights($row)
1717     }
1718     if {[info exists fhighlights($row)] && $fhighlights($row) > 0} {
1719         return $fhighlights($row)
1720     }
1721     if {[info exists rhighlights($row)] && $rhighlights($row) > 0} {
1722         return $rhighlights($row)
1723     }
1724     return 0
1725 }
1726
1727 proc bolden {row font} {
1728     global canv linehtag selectedline boldrows
1729
1730     lappend boldrows $row
1731     $canv itemconf $linehtag($row) -font $font
1732     if {[info exists selectedline] && $row == $selectedline} {
1733         $canv delete secsel
1734         set t [eval $canv create rect [$canv bbox $linehtag($row)] \
1735                    -outline {{}} -tags secsel \
1736                    -fill [$canv cget -selectbackground]]
1737         $canv lower $t
1738     }
1739 }
1740
1741 proc bolden_name {row font} {
1742     global canv2 linentag selectedline boldnamerows
1743
1744     lappend boldnamerows $row
1745     $canv2 itemconf $linentag($row) -font $font
1746     if {[info exists selectedline] && $row == $selectedline} {
1747         $canv2 delete secsel
1748         set t [eval $canv2 create rect [$canv2 bbox $linentag($row)] \
1749                    -outline {{}} -tags secsel \
1750                    -fill [$canv2 cget -selectbackground]]
1751         $canv2 lower $t
1752     }
1753 }
1754
1755 proc unbolden {} {
1756     global mainfont boldrows
1757
1758     set stillbold {}
1759     foreach row $boldrows {
1760         if {![ishighlighted $row]} {
1761             bolden $row $mainfont
1762         } else {
1763             lappend stillbold $row
1764         }
1765     }
1766     set boldrows $stillbold
1767 }
1768
1769 proc addvhighlight {n} {
1770     global hlview curview viewdata vhl_done vhighlights commitidx
1771
1772     if {[info exists hlview]} {
1773         delvhighlight
1774     }
1775     set hlview $n
1776     if {$n != $curview && ![info exists viewdata($n)]} {
1777         set viewdata($n) [list getcommits {{}} {{}} {} {} {} 0 0 0 {}]
1778         set vparentlist($n) {}
1779         set vchildlist($n) {}
1780         set vdisporder($n) {}
1781         set vcmitlisted($n) {}
1782         start_rev_list $n
1783     }
1784     set vhl_done $commitidx($hlview)
1785     if {$vhl_done > 0} {
1786         drawvisible
1787     }
1788 }
1789
1790 proc delvhighlight {} {
1791     global hlview vhighlights
1792
1793     if {![info exists hlview]} return
1794     unset hlview
1795     catch {unset vhighlights}
1796     unbolden
1797 }
1798
1799 proc vhighlightmore {} {
1800     global hlview vhl_done commitidx vhighlights
1801     global displayorder vdisporder curview mainfont
1802
1803     set font [concat $mainfont bold]
1804     set max $commitidx($hlview)
1805     if {$hlview == $curview} {
1806         set disp $displayorder
1807     } else {
1808         set disp $vdisporder($hlview)
1809     }
1810     set vr [visiblerows]
1811     set r0 [lindex $vr 0]
1812     set r1 [lindex $vr 1]
1813     for {set i $vhl_done} {$i < $max} {incr i} {
1814         set id [lindex $disp $i]
1815         if {[info exists commitrow($curview,$id)]} {
1816             set row $commitrow($curview,$id)
1817             if {$r0 <= $row && $row <= $r1} {
1818                 if {![highlighted $row]} {
1819                     bolden $row $font
1820                 }
1821                 set vhighlights($row) 1
1822             }
1823         }
1824     }
1825     set vhl_done $max
1826 }
1827
1828 proc askvhighlight {row id} {
1829     global hlview vhighlights commitrow iddrawn mainfont
1830
1831     if {[info exists commitrow($hlview,$id)]} {
1832         if {[info exists iddrawn($id)] && ![ishighlighted $row]} {
1833             bolden $row [concat $mainfont bold]
1834         }
1835         set vhighlights($row) 1
1836     } else {
1837         set vhighlights($row) 0
1838     }
1839 }
1840
1841 proc hfiles_change {name ix op} {
1842     global highlight_files filehighlight fhighlights fh_serial
1843     global mainfont highlight_paths
1844
1845     if {[info exists filehighlight]} {
1846         # delete previous highlights
1847         catch {close $filehighlight}
1848         unset filehighlight
1849         catch {unset fhighlights}
1850         unbolden
1851         unhighlight_filelist
1852     }
1853     set highlight_paths {}
1854     after cancel do_file_hl $fh_serial
1855     incr fh_serial
1856     if {$highlight_files ne {}} {
1857         after 300 do_file_hl $fh_serial
1858     }
1859 }
1860
1861 proc makepatterns {l} {
1862     set ret {}
1863     foreach e $l {
1864         set ee [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} $e]
1865         if {[string index $ee end] eq "/"} {
1866             lappend ret "$ee*"
1867         } else {
1868             lappend ret $ee
1869             lappend ret "$ee/*"
1870         }
1871     }
1872     return $ret
1873 }
1874
1875 proc do_file_hl {serial} {
1876     global highlight_files filehighlight highlight_paths gdttype fhl_list
1877
1878     if {$gdttype eq "touching paths:"} {
1879         if {[catch {set paths [shellsplit $highlight_files]}]} return
1880         set highlight_paths [makepatterns $paths]
1881         highlight_filelist
1882         set gdtargs [concat -- $paths]
1883     } else {
1884         set gdtargs [list "-S$highlight_files"]
1885     }
1886     set cmd [concat | git-diff-tree -r -s --stdin $gdtargs]
1887     set filehighlight [open $cmd r+]
1888     fconfigure $filehighlight -blocking 0
1889     fileevent $filehighlight readable readfhighlight
1890     set fhl_list {}
1891     drawvisible
1892     flushhighlights
1893 }
1894
1895 proc flushhighlights {} {
1896     global filehighlight fhl_list
1897
1898     if {[info exists filehighlight]} {
1899         lappend fhl_list {}
1900         puts $filehighlight ""
1901         flush $filehighlight
1902     }
1903 }
1904
1905 proc askfilehighlight {row id} {
1906     global filehighlight fhighlights fhl_list
1907
1908     lappend fhl_list $id
1909     set fhighlights($row) -1
1910     puts $filehighlight $id
1911 }
1912
1913 proc readfhighlight {} {
1914     global filehighlight fhighlights commitrow curview mainfont iddrawn
1915     global fhl_list
1916
1917     while {[gets $filehighlight line] >= 0} {
1918         set line [string trim $line]
1919         set i [lsearch -exact $fhl_list $line]
1920         if {$i < 0} continue
1921         for {set j 0} {$j < $i} {incr j} {
1922             set id [lindex $fhl_list $j]
1923             if {[info exists commitrow($curview,$id)]} {
1924                 set fhighlights($commitrow($curview,$id)) 0
1925             }
1926         }
1927         set fhl_list [lrange $fhl_list [expr {$i+1}] end]
1928         if {$line eq {}} continue
1929         if {![info exists commitrow($curview,$line)]} continue
1930         set row $commitrow($curview,$line)
1931         if {[info exists iddrawn($line)] && ![ishighlighted $row]} {
1932             bolden $row [concat $mainfont bold]
1933         }
1934         set fhighlights($row) 1
1935     }
1936     if {[eof $filehighlight]} {
1937         # strange...
1938         puts "oops, git-diff-tree died"
1939         catch {close $filehighlight}
1940         unset filehighlight
1941     }
1942     next_hlcont
1943 }
1944
1945 proc find_change {name ix op} {
1946     global nhighlights mainfont boldnamerows
1947     global findstring findpattern findtype
1948
1949     # delete previous highlights, if any
1950     foreach row $boldnamerows {
1951         bolden_name $row $mainfont
1952     }
1953     set boldnamerows {}
1954     catch {unset nhighlights}
1955     unbolden
1956     if {$findtype ne "Regexp"} {
1957         set e [string map {"*" "\\*" "?" "\\?" "\[" "\\\[" "\\" "\\\\"} \
1958                    $findstring]
1959         set findpattern "*$e*"
1960     }
1961     drawvisible
1962 }
1963
1964 proc askfindhighlight {row id} {
1965     global nhighlights commitinfo iddrawn mainfont
1966     global findstring findtype findloc findpattern
1967
1968     if {![info exists commitinfo($id)]} {
1969         getcommit $id
1970     }
1971     set info $commitinfo($id)
1972     set isbold 0
1973     set fldtypes {Headline Author Date Committer CDate Comments}
1974     foreach f $info ty $fldtypes {
1975         if {$findloc ne "All fields" && $findloc ne $ty} {
1976             continue
1977         }
1978         if {$findtype eq "Regexp"} {
1979             set doesmatch [regexp $findstring $f]
1980         } elseif {$findtype eq "IgnCase"} {
1981             set doesmatch [string match -nocase $findpattern $f]
1982         } else {
1983             set doesmatch [string match $findpattern $f]
1984         }
1985         if {$doesmatch} {
1986             if {$ty eq "Author"} {
1987                 set isbold 2
1988             } else {
1989                 set isbold 1
1990             }
1991         }
1992     }
1993     if {[info exists iddrawn($id)]} {
1994         if {$isbold && ![ishighlighted $row]} {
1995             bolden $row [concat $mainfont bold]
1996         }
1997         if {$isbold >= 2} {
1998             bolden_name $row [concat $mainfont bold]
1999         }
2000     }
2001     set nhighlights($row) $isbold
2002 }
2003
2004 proc vrel_change {name ix op} {
2005     global highlight_related
2006
2007     rhighlight_none
2008     if {$highlight_related ne "None"} {
2009         after idle drawvisible
2010     }
2011 }
2012
2013 # prepare for testing whether commits are descendents or ancestors of a
2014 proc rhighlight_sel {a} {
2015     global descendent desc_todo ancestor anc_todo
2016     global highlight_related rhighlights
2017
2018     catch {unset descendent}
2019     set desc_todo [list $a]
2020     catch {unset ancestor}
2021     set anc_todo [list $a]
2022     if {$highlight_related ne "None"} {
2023         rhighlight_none
2024         after idle drawvisible
2025     }
2026 }
2027
2028 proc rhighlight_none {} {
2029     global rhighlights
2030
2031     catch {unset rhighlights}
2032     unbolden
2033 }
2034
2035 proc is_descendent {a} {
2036     global curview children commitrow descendent desc_todo
2037
2038     set v $curview
2039     set la $commitrow($v,$a)
2040     set todo $desc_todo
2041     set leftover {}
2042     set done 0
2043     for {set i 0} {$i < [llength $todo]} {incr i} {
2044         set do [lindex $todo $i]
2045         if {$commitrow($v,$do) < $la} {
2046             lappend leftover $do
2047             continue
2048         }
2049         foreach nk $children($v,$do) {
2050             if {![info exists descendent($nk)]} {
2051                 set descendent($nk) 1
2052                 lappend todo $nk
2053                 if {$nk eq $a} {
2054                     set done 1
2055                 }
2056             }
2057         }
2058         if {$done} {
2059             set desc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2060             return
2061         }
2062     }
2063     set descendent($a) 0
2064     set desc_todo $leftover
2065 }
2066
2067 proc is_ancestor {a} {
2068     global curview parentlist commitrow ancestor anc_todo
2069
2070     set v $curview
2071     set la $commitrow($v,$a)
2072     set todo $anc_todo
2073     set leftover {}
2074     set done 0
2075     for {set i 0} {$i < [llength $todo]} {incr i} {
2076         set do [lindex $todo $i]
2077         if {![info exists commitrow($v,$do)] || $commitrow($v,$do) > $la} {
2078             lappend leftover $do
2079             continue
2080         }
2081         foreach np [lindex $parentlist $commitrow($v,$do)] {
2082             if {![info exists ancestor($np)]} {
2083                 set ancestor($np) 1
2084                 lappend todo $np
2085                 if {$np eq $a} {
2086                     set done 1
2087                 }
2088             }
2089         }
2090         if {$done} {
2091             set anc_todo [concat $leftover [lrange $todo [expr {$i+1}] end]]
2092             return
2093         }
2094     }
2095     set ancestor($a) 0
2096     set anc_todo $leftover
2097 }
2098
2099 proc askrelhighlight {row id} {
2100     global descendent highlight_related iddrawn mainfont rhighlights
2101     global selectedline ancestor
2102
2103     if {![info exists selectedline]} return
2104     set isbold 0
2105     if {$highlight_related eq "Descendent" ||
2106         $highlight_related eq "Not descendent"} {
2107         if {![info exists descendent($id)]} {
2108             is_descendent $id
2109         }
2110         if {$descendent($id) == ($highlight_related eq "Descendent")} {
2111             set isbold 1
2112         }
2113     } elseif {$highlight_related eq "Ancestor" ||
2114               $highlight_related eq "Not ancestor"} {
2115         if {![info exists ancestor($id)]} {
2116             is_ancestor $id
2117         }
2118         if {$ancestor($id) == ($highlight_related eq "Ancestor")} {
2119             set isbold 1
2120         }
2121     }
2122     if {[info exists iddrawn($id)]} {
2123         if {$isbold && ![ishighlighted $row]} {
2124             bolden $row [concat $mainfont bold]
2125         }
2126     }
2127     set rhighlights($row) $isbold
2128 }
2129
2130 proc next_hlcont {} {
2131     global fhl_row fhl_dirn displayorder numcommits
2132     global vhighlights fhighlights nhighlights rhighlights
2133     global hlview filehighlight findstring highlight_related
2134
2135     if {![info exists fhl_dirn] || $fhl_dirn == 0} return
2136     set row $fhl_row
2137     while {1} {
2138         if {$row < 0 || $row >= $numcommits} {
2139             bell
2140             set fhl_dirn 0
2141             return
2142         }
2143         set id [lindex $displayorder $row]
2144         if {[info exists hlview]} {
2145             if {![info exists vhighlights($row)]} {
2146                 askvhighlight $row $id
2147             }
2148             if {$vhighlights($row) > 0} break
2149         }
2150         if {$findstring ne {}} {
2151             if {![info exists nhighlights($row)]} {
2152                 askfindhighlight $row $id
2153             }
2154             if {$nhighlights($row) > 0} break
2155         }
2156         if {$highlight_related ne "None"} {
2157             if {![info exists rhighlights($row)]} {
2158                 askrelhighlight $row $id
2159             }
2160             if {$rhighlights($row) > 0} break
2161         }
2162         if {[info exists filehighlight]} {
2163             if {![info exists fhighlights($row)]} {
2164                 # ask for a few more while we're at it...
2165                 set r $row
2166                 for {set n 0} {$n < 100} {incr n} {
2167                     if {![info exists fhighlights($r)]} {
2168                         askfilehighlight $r [lindex $displayorder $r]
2169                     }
2170                     incr r $fhl_dirn
2171                     if {$r < 0 || $r >= $numcommits} break
2172                 }
2173                 flushhighlights
2174             }
2175             if {$fhighlights($row) < 0} {
2176                 set fhl_row $row
2177                 return
2178             }
2179             if {$fhighlights($row) > 0} break
2180         }
2181         incr row $fhl_dirn
2182     }
2183     set fhl_dirn 0
2184     selectline $row 1
2185 }
2186
2187 proc next_highlight {dirn} {
2188     global selectedline fhl_row fhl_dirn
2189     global hlview filehighlight findstring highlight_related
2190
2191     if {![info exists selectedline]} return
2192     if {!([info exists hlview] || $findstring ne {} ||
2193           $highlight_related ne "None" || [info exists filehighlight])} return
2194     set fhl_row [expr {$selectedline + $dirn}]
2195     set fhl_dirn $dirn
2196     next_hlcont
2197 }
2198
2199 proc cancel_next_highlight {} {
2200     global fhl_dirn
2201
2202     set fhl_dirn 0
2203 }
2204
2205 # Graph layout functions
2206
2207 proc shortids {ids} {
2208     set res {}
2209     foreach id $ids {
2210         if {[llength $id] > 1} {
2211             lappend res [shortids $id]
2212         } elseif {[regexp {^[0-9a-f]{40}$} $id]} {
2213             lappend res [string range $id 0 7]
2214         } else {
2215             lappend res $id
2216         }
2217     }
2218     return $res
2219 }
2220
2221 proc incrange {l x o} {
2222     set n [llength $l]
2223     while {$x < $n} {
2224         set e [lindex $l $x]
2225         if {$e ne {}} {
2226             lset l $x [expr {$e + $o}]
2227         }
2228         incr x
2229     }
2230     return $l
2231 }
2232
2233 proc ntimes {n o} {
2234     set ret {}
2235     for {} {$n > 0} {incr n -1} {
2236         lappend ret $o
2237     }
2238     return $ret
2239 }
2240
2241 proc usedinrange {id l1 l2} {
2242     global children commitrow childlist curview
2243
2244     if {[info exists commitrow($curview,$id)]} {
2245         set r $commitrow($curview,$id)
2246         if {$l1 <= $r && $r <= $l2} {
2247             return [expr {$r - $l1 + 1}]
2248         }
2249         set kids [lindex $childlist $r]
2250     } else {
2251         set kids $children($curview,$id)
2252     }
2253     foreach c $kids {
2254         set r $commitrow($curview,$c)
2255         if {$l1 <= $r && $r <= $l2} {
2256             return [expr {$r - $l1 + 1}]
2257         }
2258     }
2259     return 0
2260 }
2261
2262 proc sanity {row {full 0}} {
2263     global rowidlist rowoffsets
2264
2265     set col -1
2266     set ids [lindex $rowidlist $row]
2267     foreach id $ids {
2268         incr col
2269         if {$id eq {}} continue
2270         if {$col < [llength $ids] - 1 &&
2271             [lsearch -exact -start [expr {$col+1}] $ids $id] >= 0} {
2272             puts "oops: [shortids $id] repeated in row $row col $col: {[shortids [lindex $rowidlist $row]]}"
2273         }
2274         set o [lindex $rowoffsets $row $col]
2275         set y $row
2276         set x $col
2277         while {$o ne {}} {
2278             incr y -1
2279             incr x $o
2280             if {[lindex $rowidlist $y $x] != $id} {
2281                 puts "oops: rowoffsets wrong at row [expr {$y+1}] col [expr {$x-$o}]"
2282                 puts "  id=[shortids $id] check started at row $row"
2283                 for {set i $row} {$i >= $y} {incr i -1} {
2284                     puts "  row $i ids={[shortids [lindex $rowidlist $i]]} offs={[lindex $rowoffsets $i]}"
2285                 }
2286                 break
2287             }
2288             if {!$full} break
2289             set o [lindex $rowoffsets $y $x]
2290         }
2291     }
2292 }
2293
2294 proc makeuparrow {oid x y z} {
2295     global rowidlist rowoffsets uparrowlen idrowranges
2296
2297     for {set i 1} {$i < $uparrowlen && $y > 1} {incr i} {
2298         incr y -1
2299         incr x $z
2300         set off0 [lindex $rowoffsets $y]
2301         for {set x0 $x} {1} {incr x0} {
2302             if {$x0 >= [llength $off0]} {
2303                 set x0 [llength [lindex $rowoffsets [expr {$y-1}]]]
2304                 break
2305             }
2306             set z [lindex $off0 $x0]
2307             if {$z ne {}} {
2308                 incr x0 $z
2309                 break
2310             }
2311         }
2312         set z [expr {$x0 - $x}]
2313         lset rowidlist $y [linsert [lindex $rowidlist $y] $x $oid]
2314         lset rowoffsets $y [linsert [lindex $rowoffsets $y] $x $z]
2315     }
2316     set tmp [lreplace [lindex $rowoffsets $y] $x $x {}]
2317     lset rowoffsets $y [incrange $tmp [expr {$x+1}] -1]
2318     lappend idrowranges($oid) $y
2319 }
2320
2321 proc initlayout {} {
2322     global rowidlist rowoffsets displayorder commitlisted
2323     global rowlaidout rowoptim
2324     global idinlist rowchk rowrangelist idrowranges
2325     global numcommits canvxmax canv
2326     global nextcolor
2327     global parentlist childlist children
2328     global colormap rowtextx
2329     global linesegends
2330
2331     set numcommits 0
2332     set displayorder {}
2333     set commitlisted {}
2334     set parentlist {}
2335     set childlist {}
2336     set rowrangelist {}
2337     set nextcolor 0
2338     set rowidlist {{}}
2339     set rowoffsets {{}}
2340     catch {unset idinlist}
2341     catch {unset rowchk}
2342     set rowlaidout 0
2343     set rowoptim 0
2344     set canvxmax [$canv cget -width]
2345     catch {unset colormap}
2346     catch {unset rowtextx}
2347     catch {unset idrowranges}
2348     set linesegends {}
2349 }
2350
2351 proc setcanvscroll {} {
2352     global canv canv2 canv3 numcommits linespc canvxmax canvy0
2353
2354     set ymax [expr {$canvy0 + ($numcommits - 0.5) * $linespc + 2}]
2355     $canv conf -scrollregion [list 0 0 $canvxmax $ymax]
2356     $canv2 conf -scrollregion [list 0 0 0 $ymax]
2357     $canv3 conf -scrollregion [list 0 0 0 $ymax]
2358 }
2359
2360 proc visiblerows {} {
2361     global canv numcommits linespc
2362
2363     set ymax [lindex [$canv cget -scrollregion] 3]
2364     if {$ymax eq {} || $ymax == 0} return
2365     set f [$canv yview]
2366     set y0 [expr {int([lindex $f 0] * $ymax)}]
2367     set r0 [expr {int(($y0 - 3) / $linespc) - 1}]
2368     if {$r0 < 0} {
2369         set r0 0
2370     }
2371     set y1 [expr {int([lindex $f 1] * $ymax)}]
2372     set r1 [expr {int(($y1 - 3) / $linespc) + 1}]
2373     if {$r1 >= $numcommits} {
2374         set r1 [expr {$numcommits - 1}]
2375     }
2376     return [list $r0 $r1]
2377 }
2378
2379 proc layoutmore {} {
2380     global rowlaidout rowoptim commitidx numcommits optim_delay
2381     global uparrowlen curview
2382
2383     set row $rowlaidout
2384     set rowlaidout [layoutrows $row $commitidx($curview) 0]
2385     set orow [expr {$rowlaidout - $uparrowlen - 1}]
2386     if {$orow > $rowoptim} {
2387         optimize_rows $rowoptim 0 $orow
2388         set rowoptim $orow
2389     }
2390     set canshow [expr {$rowoptim - $optim_delay}]
2391     if {$canshow > $numcommits} {
2392         showstuff $canshow
2393     }
2394 }
2395
2396 proc showstuff {canshow} {
2397     global numcommits commitrow pending_select selectedline
2398     global linesegends idrowranges idrangedrawn curview
2399
2400     if {$numcommits == 0} {
2401         global phase
2402         set phase "incrdraw"
2403         allcanvs delete all
2404     }
2405     set row $numcommits
2406     set numcommits $canshow
2407     setcanvscroll
2408     set rows [visiblerows]
2409     set r0 [lindex $rows 0]
2410     set r1 [lindex $rows 1]
2411     set selrow -1
2412     for {set r $row} {$r < $canshow} {incr r} {
2413         foreach id [lindex $linesegends [expr {$r+1}]] {
2414             set i -1
2415             foreach {s e} [rowranges $id] {
2416                 incr i
2417                 if {$e ne {} && $e < $numcommits && $s <= $r1 && $e >= $r0
2418                     && ![info exists idrangedrawn($id,$i)]} {
2419                     drawlineseg $id $i
2420                     set idrangedrawn($id,$i) 1
2421                 }
2422             }
2423         }
2424     }
2425     if {$canshow > $r1} {
2426         set canshow $r1
2427     }
2428     while {$row < $canshow} {
2429         drawcmitrow $row
2430         incr row
2431     }
2432     if {[info exists pending_select] &&
2433         [info exists commitrow($curview,$pending_select)] &&
2434         $commitrow($curview,$pending_select) < $numcommits} {
2435         selectline $commitrow($curview,$pending_select) 1
2436     }
2437     if {![info exists selectedline] && ![info exists pending_select]} {
2438         selectline 0 1
2439     }
2440 }
2441
2442 proc layoutrows {row endrow last} {
2443     global rowidlist rowoffsets displayorder
2444     global uparrowlen downarrowlen maxwidth mingaplen
2445     global childlist parentlist
2446     global idrowranges linesegends
2447     global commitidx curview
2448     global idinlist rowchk rowrangelist
2449
2450     set idlist [lindex $rowidlist $row]
2451     set offs [lindex $rowoffsets $row]
2452     while {$row < $endrow} {
2453         set id [lindex $displayorder $row]
2454         set oldolds {}
2455         set newolds {}
2456         foreach p [lindex $parentlist $row] {
2457             if {![info exists idinlist($p)]} {
2458                 lappend newolds $p
2459             } elseif {!$idinlist($p)} {
2460                 lappend oldolds $p
2461             }
2462         }
2463         set lse {}
2464         set nev [expr {[llength $idlist] + [llength $newolds]
2465                        + [llength $oldolds] - $maxwidth + 1}]
2466         if {$nev > 0} {
2467             if {!$last &&
2468                 $row + $uparrowlen + $mingaplen >= $commitidx($curview)} break
2469             for {set x [llength $idlist]} {[incr x -1] >= 0} {} {
2470                 set i [lindex $idlist $x]
2471                 if {![info exists rowchk($i)] || $row >= $rowchk($i)} {
2472                     set r [usedinrange $i [expr {$row - $downarrowlen}] \
2473                                [expr {$row + $uparrowlen + $mingaplen}]]
2474                     if {$r == 0} {
2475                         set idlist [lreplace $idlist $x $x]
2476                         set offs [lreplace $offs $x $x]
2477                         set offs [incrange $offs $x 1]
2478                         set idinlist($i) 0
2479                         set rm1 [expr {$row - 1}]
2480                         lappend lse $i
2481                         lappend idrowranges($i) $rm1
2482                         if {[incr nev -1] <= 0} break
2483                         continue
2484                     }
2485                     set rowchk($id) [expr {$row + $r}]
2486                 }
2487             }
2488             lset rowidlist $row $idlist
2489             lset rowoffsets $row $offs
2490         }
2491         lappend linesegends $lse
2492         set col [lsearch -exact $idlist $id]
2493         if {$col < 0} {
2494             set col [llength $idlist]
2495             lappend idlist $id
2496             lset rowidlist $row $idlist
2497             set z {}
2498             if {[lindex $childlist $row] ne {}} {
2499                 set z [expr {[llength [lindex $rowidlist [expr {$row-1}]]] - $col}]
2500                 unset idinlist($id)
2501             }
2502             lappend offs $z
2503             lset rowoffsets $row $offs
2504             if {$z ne {}} {
2505                 makeuparrow $id $col $row $z
2506             }
2507         } else {
2508             unset idinlist($id)
2509         }
2510         set ranges {}
2511         if {[info exists idrowranges($id)]} {
2512             set ranges $idrowranges($id)
2513             lappend ranges $row
2514             unset idrowranges($id)
2515         }
2516         lappend rowrangelist $ranges
2517         incr row
2518         set offs [ntimes [llength $idlist] 0]
2519         set l [llength $newolds]
2520         set idlist [eval lreplace \$idlist $col $col $newolds]
2521         set o 0
2522         if {$l != 1} {
2523             set offs [lrange $offs 0 [expr {$col - 1}]]
2524             foreach x $newolds {
2525                 lappend offs {}
2526                 incr o -1
2527             }
2528             incr o
2529             set tmp [expr {[llength $idlist] - [llength $offs]}]
2530             if {$tmp > 0} {
2531                 set offs [concat $offs [ntimes $tmp $o]]
2532             }
2533         } else {
2534             lset offs $col {}
2535         }
2536         foreach i $newolds {
2537             set idinlist($i) 1
2538             set idrowranges($i) $row
2539         }
2540         incr col $l
2541         foreach oid $oldolds {
2542             set idinlist($oid) 1
2543             set idlist [linsert $idlist $col $oid]
2544             set offs [linsert $offs $col $o]
2545             makeuparrow $oid $col $row $o
2546             incr col
2547         }
2548         lappend rowidlist $idlist
2549         lappend rowoffsets $offs
2550     }
2551     return $row
2552 }
2553
2554 proc addextraid {id row} {
2555     global displayorder commitrow commitinfo
2556     global commitidx commitlisted
2557     global parentlist childlist children curview
2558
2559     incr commitidx($curview)
2560     lappend displayorder $id
2561     lappend commitlisted 0
2562     lappend parentlist {}
2563     set commitrow($curview,$id) $row
2564     readcommit $id
2565     if {![info exists commitinfo($id)]} {
2566         set commitinfo($id) {"No commit information available"}
2567     }
2568     if {![info exists children($curview,$id)]} {
2569         set children($curview,$id) {}
2570     }
2571     lappend childlist $children($curview,$id)
2572 }
2573
2574 proc layouttail {} {
2575     global rowidlist rowoffsets idinlist commitidx curview
2576     global idrowranges rowrangelist
2577
2578     set row $commitidx($curview)
2579     set idlist [lindex $rowidlist $row]
2580     while {$idlist ne {}} {
2581         set col [expr {[llength $idlist] - 1}]
2582         set id [lindex $idlist $col]
2583         addextraid $id $row
2584         unset idinlist($id)
2585         lappend idrowranges($id) $row
2586         lappend rowrangelist $idrowranges($id)
2587         unset idrowranges($id)
2588         incr row
2589         set offs [ntimes $col 0]
2590         set idlist [lreplace $idlist $col $col]
2591         lappend rowidlist $idlist
2592         lappend rowoffsets $offs
2593     }
2594
2595     foreach id [array names idinlist] {
2596         addextraid $id $row
2597         lset rowidlist $row [list $id]
2598         lset rowoffsets $row 0
2599         makeuparrow $id 0 $row 0
2600         lappend idrowranges($id) $row
2601         lappend rowrangelist $idrowranges($id)
2602         unset idrowranges($id)
2603         incr row
2604         lappend rowidlist {}
2605         lappend rowoffsets {}
2606     }
2607 }
2608
2609 proc insert_pad {row col npad} {
2610     global rowidlist rowoffsets
2611
2612     set pad [ntimes $npad {}]
2613     lset rowidlist $row [eval linsert [list [lindex $rowidlist $row]] $col $pad]
2614     set tmp [eval linsert [list [lindex $rowoffsets $row]] $col $pad]
2615     lset rowoffsets $row [incrange $tmp [expr {$col + $npad}] [expr {-$npad}]]
2616 }
2617
2618 proc optimize_rows {row col endrow} {
2619     global rowidlist rowoffsets idrowranges displayorder
2620
2621     for {} {$row < $endrow} {incr row} {
2622         set idlist [lindex $rowidlist $row]
2623         set offs [lindex $rowoffsets $row]
2624         set haspad 0
2625         for {} {$col < [llength $offs]} {incr col} {
2626             if {[lindex $idlist $col] eq {}} {
2627                 set haspad 1
2628                 continue
2629             }
2630             set z [lindex $offs $col]
2631             if {$z eq {}} continue
2632             set isarrow 0
2633             set x0 [expr {$col + $z}]
2634             set y0 [expr {$row - 1}]
2635             set z0 [lindex $rowoffsets $y0 $x0]
2636             if {$z0 eq {}} {
2637                 set id [lindex $idlist $col]
2638                 set ranges [rowranges $id]
2639                 if {$ranges ne {} && $y0 > [lindex $ranges 0]} {
2640                     set isarrow 1
2641                 }
2642             }
2643             if {$z < -1 || ($z < 0 && $isarrow)} {
2644                 set npad [expr {-1 - $z + $isarrow}]
2645                 set offs [incrange $offs $col $npad]
2646                 insert_pad $y0 $x0 $npad
2647                 if {$y0 > 0} {
2648                     optimize_rows $y0 $x0 $row
2649                 }
2650                 set z [lindex $offs $col]
2651                 set x0 [expr {$col + $z}]
2652                 set z0 [lindex $rowoffsets $y0 $x0]
2653             } elseif {$z > 1 || ($z > 0 && $isarrow)} {
2654                 set npad [expr {$z - 1 + $isarrow}]
2655                 set y1 [expr {$row + 1}]
2656                 set offs2 [lindex $rowoffsets $y1]
2657                 set x1 -1
2658                 foreach z $offs2 {
2659                     incr x1
2660                     if {$z eq {} || $x1 + $z < $col} continue
2661                     if {$x1 + $z > $col} {
2662                         incr npad
2663                     }
2664                     lset rowoffsets $y1 [incrange $offs2 $x1 $npad]
2665                     break
2666                 }
2667                 set pad [ntimes $npad {}]
2668                 set idlist [eval linsert \$idlist $col $pad]
2669                 set tmp [eval linsert \$offs $col $pad]
2670                 incr col $npad
2671                 set offs [incrange $tmp $col [expr {-$npad}]]
2672                 set z [lindex $offs $col]
2673                 set haspad 1
2674             }
2675             if {$z0 eq {} && !$isarrow} {
2676                 # this line links to its first child on row $row-2
2677                 set rm2 [expr {$row - 2}]
2678                 set id [lindex $displayorder $rm2]
2679                 set xc [lsearch -exact [lindex $rowidlist $rm2] $id]
2680                 if {$xc >= 0} {
2681                     set z0 [expr {$xc - $x0}]
2682                 }
2683             }
2684             if {$z0 ne {} && $z < 0 && $z0 > 0} {
2685                 insert_pad $y0 $x0 1
2686                 set offs [incrange $offs $col 1]
2687                 optimize_rows $y0 [expr {$x0 + 1}] $row
2688             }
2689         }
2690         if {!$haspad} {
2691             set o {}
2692             for {set col [llength $idlist]} {[incr col -1] >= 0} {} {
2693                 set o [lindex $offs $col]
2694                 if {$o eq {}} {
2695                     # check if this is the link to the first child
2696                     set id [lindex $idlist $col]
2697                     set ranges [rowranges $id]
2698                     if {$ranges ne {} && $row == [lindex $ranges 0]} {
2699                         # it is, work out offset to child
2700                         set y0 [expr {$row - 1}]
2701                         set id [lindex $displayorder $y0]
2702                         set x0 [lsearch -exact [lindex $rowidlist $y0] $id]
2703                         if {$x0 >= 0} {
2704                             set o [expr {$x0 - $col}]
2705                         }
2706                     }
2707                 }
2708                 if {$o eq {} || $o <= 0} break
2709             }
2710             if {$o ne {} && [incr col] < [llength $idlist]} {
2711                 set y1 [expr {$row + 1}]
2712                 set offs2 [lindex $rowoffsets $y1]
2713                 set x1 -1
2714                 foreach z $offs2 {
2715                     incr x1
2716                     if {$z eq {} || $x1 + $z < $col} continue
2717                     lset rowoffsets $y1 [incrange $offs2 $x1 1]
2718                     break
2719                 }
2720                 set idlist [linsert $idlist $col {}]
2721                 set tmp [linsert $offs $col {}]
2722                 incr col
2723                 set offs [incrange $tmp $col -1]
2724             }
2725         }
2726         lset rowidlist $row $idlist
2727         lset rowoffsets $row $offs
2728         set col 0
2729     }
2730 }
2731
2732 proc xc {row col} {
2733     global canvx0 linespc
2734     return [expr {$canvx0 + $col * $linespc}]
2735 }
2736
2737 proc yc {row} {
2738     global canvy0 linespc
2739     return [expr {$canvy0 + $row * $linespc}]
2740 }
2741
2742 proc linewidth {id} {
2743     global thickerline lthickness
2744
2745     set wid $lthickness
2746     if {[info exists thickerline] && $id eq $thickerline} {
2747         set wid [expr {2 * $lthickness}]
2748     }
2749     return $wid
2750 }
2751
2752 proc rowranges {id} {
2753     global phase idrowranges commitrow rowlaidout rowrangelist curview
2754
2755     set ranges {}
2756     if {$phase eq {} ||
2757         ([info exists commitrow($curview,$id)]
2758          && $commitrow($curview,$id) < $rowlaidout)} {
2759         set ranges [lindex $rowrangelist $commitrow($curview,$id)]
2760     } elseif {[info exists idrowranges($id)]} {
2761         set ranges $idrowranges($id)
2762     }
2763     return $ranges
2764 }
2765
2766 proc drawlineseg {id i} {
2767     global rowoffsets rowidlist
2768     global displayorder
2769     global canv colormap linespc
2770     global numcommits commitrow curview
2771
2772     set ranges [rowranges $id]
2773     set downarrow 1
2774     if {[info exists commitrow($curview,$id)]
2775         && $commitrow($curview,$id) < $numcommits} {
2776         set downarrow [expr {$i < [llength $ranges] / 2 - 1}]
2777     } else {
2778         set downarrow 1
2779     }
2780     set startrow [lindex $ranges [expr {2 * $i}]]
2781     set row [lindex $ranges [expr {2 * $i + 1}]]
2782     if {$startrow == $row} return
2783     assigncolor $id
2784     set coords {}
2785     set col [lsearch -exact [lindex $rowidlist $row] $id]
2786     if {$col < 0} {
2787         puts "oops: drawline: id $id not on row $row"
2788         return
2789     }
2790     set lasto {}
2791     set ns 0
2792     while {1} {
2793         set o [lindex $rowoffsets $row $col]
2794         if {$o eq {}} break
2795         if {$o ne $lasto} {
2796             # changing direction
2797             set x [xc $row $col]
2798             set y [yc $row]
2799             lappend coords $x $y
2800             set lasto $o
2801         }
2802         incr col $o
2803         incr row -1
2804     }
2805     set x [xc $row $col]
2806     set y [yc $row]
2807     lappend coords $x $y
2808     if {$i == 0} {
2809         # draw the link to the first child as part of this line
2810         incr row -1
2811         set child [lindex $displayorder $row]
2812         set ccol [lsearch -exact [lindex $rowidlist $row] $child]
2813         if {$ccol >= 0} {
2814             set x [xc $row $ccol]
2815             set y [yc $row]
2816             if {$ccol < $col - 1} {
2817                 lappend coords [xc $row [expr {$col - 1}]] [yc $row]
2818             } elseif {$ccol > $col + 1} {
2819                 lappend coords [xc $row [expr {$col + 1}]] [yc $row]
2820             }
2821             lappend coords $x $y
2822         }
2823     }
2824     if {[llength $coords] < 4} return
2825     if {$downarrow} {
2826         # This line has an arrow at the lower end: check if the arrow is
2827         # on a diagonal segment, and if so, work around the Tk 8.4
2828         # refusal to draw arrows on diagonal lines.
2829         set x0 [lindex $coords 0]
2830         set x1 [lindex $coords 2]
2831         if {$x0 != $x1} {
2832             set y0 [lindex $coords 1]
2833             set y1 [lindex $coords 3]
2834             if {$y0 - $y1 <= 2 * $linespc && $x1 == [lindex $coords 4]} {
2835                 # we have a nearby vertical segment, just trim off the diag bit
2836                 set coords [lrange $coords 2 end]
2837             } else {
2838                 set slope [expr {($x0 - $x1) / ($y0 - $y1)}]
2839                 set xi [expr {$x0 - $slope * $linespc / 2}]
2840                 set yi [expr {$y0 - $linespc / 2}]
2841                 set coords [lreplace $coords 0 1 $xi $y0 $xi $yi]
2842             }
2843         }
2844     }
2845     set arrow [expr {2 * ($i > 0) + $downarrow}]
2846     set arrow [lindex {none first last both} $arrow]
2847     set t [$canv create line $coords -width [linewidth $id] \
2848                -fill $colormap($id) -tags lines.$id -arrow $arrow]
2849     $canv lower $t
2850     bindline $t $id
2851 }
2852
2853 proc drawparentlinks {id row col olds} {
2854     global rowidlist canv colormap
2855
2856     set row2 [expr {$row + 1}]
2857     set x [xc $row $col]
2858     set y [yc $row]
2859     set y2 [yc $row2]
2860     set ids [lindex $rowidlist $row2]
2861     # rmx = right-most X coord used
2862     set rmx 0
2863     foreach p $olds {
2864         set i [lsearch -exact $ids $p]
2865         if {$i < 0} {
2866             puts "oops, parent $p of $id not in list"
2867             continue
2868         }
2869         set x2 [xc $row2 $i]
2870         if {$x2 > $rmx} {
2871             set rmx $x2
2872         }
2873         set ranges [rowranges $p]
2874         if {$ranges ne {} && $row2 == [lindex $ranges 0]
2875             && $row2 < [lindex $ranges 1]} {
2876             # drawlineseg will do this one for us
2877             continue
2878         }
2879         assigncolor $p
2880         # should handle duplicated parents here...
2881         set coords [list $x $y]
2882         if {$i < $col - 1} {
2883             lappend coords [xc $row [expr {$i + 1}]] $y
2884         } elseif {$i > $col + 1} {
2885             lappend coords [xc $row [expr {$i - 1}]] $y
2886         }
2887         lappend coords $x2 $y2
2888         set t [$canv create line $coords -width [linewidth $p] \
2889                    -fill $colormap($p) -tags lines.$p]
2890         $canv lower $t
2891         bindline $t $p
2892     }
2893     return $rmx
2894 }
2895
2896 proc drawlines {id} {
2897     global colormap canv
2898     global idrangedrawn
2899     global children iddrawn commitrow rowidlist curview
2900
2901     $canv delete lines.$id
2902     set nr [expr {[llength [rowranges $id]] / 2}]
2903     for {set i 0} {$i < $nr} {incr i} {
2904         if {[info exists idrangedrawn($id,$i)]} {
2905             drawlineseg $id $i
2906         }
2907     }
2908     foreach child $children($curview,$id) {
2909         if {[info exists iddrawn($child)]} {
2910             set row $commitrow($curview,$child)
2911             set col [lsearch -exact [lindex $rowidlist $row] $child]
2912             if {$col >= 0} {
2913                 drawparentlinks $child $row $col [list $id]
2914             }
2915         }
2916     }
2917 }
2918
2919 proc drawcmittext {id row col rmx} {
2920     global linespc canv canv2 canv3 canvy0 fgcolor
2921     global commitlisted commitinfo rowidlist
2922     global rowtextx idpos idtags idheads idotherrefs
2923     global linehtag linentag linedtag
2924     global mainfont canvxmax boldrows boldnamerows fgcolor
2925
2926     set ofill [expr {[lindex $commitlisted $row]? "blue": "white"}]
2927     set x [xc $row $col]
2928     set y [yc $row]
2929     set orad [expr {$linespc / 3}]
2930     set t [$canv create oval [expr {$x - $orad}] [expr {$y - $orad}] \
2931                [expr {$x + $orad - 1}] [expr {$y + $orad - 1}] \
2932                -fill $ofill -outline $fgcolor -width 1 -tags circle]
2933     $canv raise $t
2934     $canv bind $t <1> {selcanvline {} %x %y}
2935     set xt [xc $row [llength [lindex $rowidlist $row]]]
2936     if {$xt < $rmx} {
2937         set xt $rmx
2938     }
2939     set rowtextx($row) $xt
2940     set idpos($id) [list $x $xt $y]
2941     if {[info exists idtags($id)] || [info exists idheads($id)]
2942         || [info exists idotherrefs($id)]} {
2943         set xt [drawtags $id $x $xt $y]
2944     }
2945     set headline [lindex $commitinfo($id) 0]
2946     set name [lindex $commitinfo($id) 1]
2947     set date [lindex $commitinfo($id) 2]
2948     set date [formatdate $date]
2949     set font $mainfont
2950     set nfont $mainfont
2951     set isbold [ishighlighted $row]
2952     if {$isbold > 0} {
2953         lappend boldrows $row
2954         lappend font bold
2955         if {$isbold > 1} {
2956             lappend boldnamerows $row
2957             lappend nfont bold
2958         }
2959     }
2960     set linehtag($row) [$canv create text $xt $y -anchor w -fill $fgcolor \
2961                             -text $headline -font $font -tags text]
2962     $canv bind $linehtag($row) <Button-3> "rowmenu %X %Y $id"
2963     set linentag($row) [$canv2 create text 3 $y -anchor w -fill $fgcolor \
2964                             -text $name -font $nfont -tags text]
2965     set linedtag($row) [$canv3 create text 3 $y -anchor w -fill $fgcolor \
2966                             -text $date -font $mainfont -tags text]
2967     set xr [expr {$xt + [font measure $mainfont $headline]}]
2968     if {$xr > $canvxmax} {
2969         set canvxmax $xr
2970         setcanvscroll
2971     }
2972 }
2973
2974 proc drawcmitrow {row} {
2975     global displayorder rowidlist
2976     global idrangedrawn iddrawn
2977     global commitinfo parentlist numcommits
2978     global filehighlight fhighlights findstring nhighlights
2979     global hlview vhighlights
2980     global highlight_related rhighlights
2981
2982     if {$row >= $numcommits} return
2983     foreach id [lindex $rowidlist $row] {
2984         if {$id eq {}} continue
2985         set i -1
2986         foreach {s e} [rowranges $id] {
2987             incr i
2988             if {$row < $s} continue
2989             if {$e eq {}} break
2990             if {$row <= $e} {
2991                 if {$e < $numcommits && ![info exists idrangedrawn($id,$i)]} {
2992                     drawlineseg $id $i
2993                     set idrangedrawn($id,$i) 1
2994                 }
2995                 break
2996             }
2997         }
2998     }
2999
3000     set id [lindex $displayorder $row]
3001     if {[info exists hlview] && ![info exists vhighlights($row)]} {
3002         askvhighlight $row $id
3003     }
3004     if {[info exists filehighlight] && ![info exists fhighlights($row)]} {
3005         askfilehighlight $row $id
3006     }
3007     if {$findstring ne {} && ![info exists nhighlights($row)]} {
3008         askfindhighlight $row $id
3009     }
3010     if {$highlight_related ne "None" && ![info exists rhighlights($row)]} {
3011         askrelhighlight $row $id
3012     }
3013     if {[info exists iddrawn($id)]} return
3014     set col [lsearch -exact [lindex $rowidlist $row] $id]
3015     if {$col < 0} {
3016         puts "oops, row $row id $id not in list"
3017         return
3018     }
3019     if {![info exists commitinfo($id)]} {
3020         getcommit $id
3021     }
3022     assigncolor $id
3023     set olds [lindex $parentlist $row]
3024     if {$olds ne {}} {
3025         set rmx [drawparentlinks $id $row $col $olds]
3026     } else {
3027         set rmx 0
3028     }
3029     drawcmittext $id $row $col $rmx
3030     set iddrawn($id) 1
3031 }
3032
3033 proc drawfrac {f0 f1} {
3034     global numcommits canv
3035     global linespc
3036
3037     set ymax [lindex [$canv cget -scrollregion] 3]
3038     if {$ymax eq {} || $ymax == 0} return
3039     set y0 [expr {int($f0 * $ymax)}]
3040     set row [expr {int(($y0 - 3) / $linespc) - 1}]
3041     if {$row < 0} {
3042         set row 0
3043     }
3044     set y1 [expr {int($f1 * $ymax)}]
3045     set endrow [expr {int(($y1 - 3) / $linespc) + 1}]
3046     if {$endrow >= $numcommits} {
3047         set endrow [expr {$numcommits - 1}]
3048     }
3049     for {} {$row <= $endrow} {incr row} {
3050         drawcmitrow $row
3051     }
3052 }
3053
3054 proc drawvisible {} {
3055     global canv
3056     eval drawfrac [$canv yview]
3057 }
3058
3059 proc clear_display {} {
3060     global iddrawn idrangedrawn
3061     global vhighlights fhighlights nhighlights rhighlights
3062
3063     allcanvs delete all
3064     catch {unset iddrawn}
3065     catch {unset idrangedrawn}
3066     catch {unset vhighlights}
3067     catch {unset fhighlights}
3068     catch {unset nhighlights}
3069     catch {unset rhighlights}
3070 }
3071
3072 proc findcrossings {id} {
3073     global rowidlist parentlist numcommits rowoffsets displayorder
3074
3075     set cross {}
3076     set ccross {}
3077     foreach {s e} [rowranges $id] {
3078         if {$e >= $numcommits} {
3079             set e [expr {$numcommits - 1}]
3080         }
3081         if {$e <= $s} continue
3082         set x [lsearch -exact [lindex $rowidlist $e] $id]
3083         if {$x < 0} {
3084             puts "findcrossings: oops, no [shortids $id] in row $e"
3085             continue
3086         }
3087         for {set row $e} {[incr row -1] >= $s} {} {
3088             set olds [lindex $parentlist $row]
3089             set kid [lindex $displayorder $row]
3090             set kidx [lsearch -exact [lindex $rowidlist $row] $kid]
3091             if {$kidx < 0} continue
3092             set nextrow [lindex $rowidlist [expr {$row + 1}]]
3093             foreach p $olds {
3094                 set px [lsearch -exact $nextrow $p]
3095                 if {$px < 0} continue
3096                 if {($kidx < $x && $x < $px) || ($px < $x && $x < $kidx)} {
3097                     if {[lsearch -exact $ccross $p] >= 0} continue
3098                     if {$x == $px + ($kidx < $px? -1: 1)} {
3099                         lappend ccross $p
3100                     } elseif {[lsearch -exact $cross $p] < 0} {
3101                         lappend cross $p
3102                     }
3103                 }
3104             }
3105             set inc [lindex $rowoffsets $row $x]
3106             if {$inc eq {}} break
3107             incr x $inc
3108         }
3109     }
3110     return [concat $ccross {{}} $cross]
3111 }
3112
3113 proc assigncolor {id} {
3114     global colormap colors nextcolor
3115     global commitrow parentlist children children curview
3116
3117     if {[info exists colormap($id)]} return
3118     set ncolors [llength $colors]
3119     if {[info exists children($curview,$id)]} {
3120         set kids $children($curview,$id)
3121     } else {
3122         set kids {}
3123     }
3124     if {[llength $kids] == 1} {
3125         set child [lindex $kids 0]
3126         if {[info exists colormap($child)]
3127             && [llength [lindex $parentlist $commitrow($curview,$child)]] == 1} {
3128             set colormap($id) $colormap($child)
3129             return
3130         }
3131     }
3132     set badcolors {}
3133     set origbad {}
3134     foreach x [findcrossings $id] {
3135         if {$x eq {}} {
3136             # delimiter between corner crossings and other crossings
3137             if {[llength $badcolors] >= $ncolors - 1} break
3138             set origbad $badcolors
3139         }
3140         if {[info exists colormap($x)]
3141             && [lsearch -exact $badcolors $colormap($x)] < 0} {
3142             lappend badcolors $colormap($x)
3143         }
3144     }
3145     if {[llength $badcolors] >= $ncolors} {
3146         set badcolors $origbad
3147     }
3148     set origbad $badcolors
3149     if {[llength $badcolors] < $ncolors - 1} {
3150         foreach child $kids {
3151             if {[info exists colormap($child)]
3152                 && [lsearch -exact $badcolors $colormap($child)] < 0} {
3153                 lappend badcolors $colormap($child)
3154             }
3155             foreach p [lindex $parentlist $commitrow($curview,$child)] {
3156                 if {[info exists colormap($p)]
3157                     && [lsearch -exact $badcolors $colormap($p)] < 0} {
3158                     lappend badcolors $colormap($p)
3159                 }
3160             }
3161         }
3162         if {[llength $badcolors] >= $ncolors} {
3163             set badcolors $origbad
3164         }
3165     }
3166     for {set i 0} {$i <= $ncolors} {incr i} {
3167         set c [lindex $colors $nextcolor]
3168         if {[incr nextcolor] >= $ncolors} {
3169             set nextcolor 0
3170         }
3171         if {[lsearch -exact $badcolors $c]} break
3172     }
3173     set colormap($id) $c
3174 }
3175
3176 proc bindline {t id} {
3177     global canv
3178
3179     $canv bind $t <Enter> "lineenter %x %y $id"
3180     $canv bind $t <Motion> "linemotion %x %y $id"
3181     $canv bind $t <Leave> "lineleave $id"
3182     $canv bind $t <Button-1> "lineclick %x %y $id 1"
3183 }
3184
3185 proc drawtags {id x xt y1} {
3186     global idtags idheads idotherrefs mainhead
3187     global linespc lthickness
3188     global canv mainfont commitrow rowtextx curview fgcolor bgcolor
3189
3190     set marks {}
3191     set ntags 0
3192     set nheads 0
3193     if {[info exists idtags($id)]} {
3194         set marks $idtags($id)
3195         set ntags [llength $marks]
3196     }
3197     if {[info exists idheads($id)]} {
3198         set marks [concat $marks $idheads($id)]
3199         set nheads [llength $idheads($id)]
3200     }
3201     if {[info exists idotherrefs($id)]} {
3202         set marks [concat $marks $idotherrefs($id)]
3203     }
3204     if {$marks eq {}} {
3205         return $xt
3206     }
3207
3208     set delta [expr {int(0.5 * ($linespc - $lthickness))}]
3209     set yt [expr {$y1 - 0.5 * $linespc}]
3210     set yb [expr {$yt + $linespc - 1}]
3211     set xvals {}
3212     set wvals {}
3213     set i -1
3214     foreach tag $marks {
3215         incr i
3216         if {$i >= $ntags && $i < $ntags + $nheads && $tag eq $mainhead} {
3217             set wid [font measure [concat $mainfont bold] $tag]
3218         } else {
3219             set wid [font measure $mainfont $tag]
3220         }
3221         lappend xvals $xt
3222         lappend wvals $wid
3223         set xt [expr {$xt + $delta + $wid + $lthickness + $linespc}]
3224     }
3225     set t [$canv create line $x $y1 [lindex $xvals end] $y1 \
3226                -width $lthickness -fill black -tags tag.$id]
3227     $canv lower $t
3228     foreach tag $marks x $xvals wid $wvals {
3229         set xl [expr {$x + $delta}]
3230         set xr [expr {$x + $delta + $wid + $lthickness}]
3231         set font $mainfont
3232         if {[incr ntags -1] >= 0} {
3233             # draw a tag
3234             set t [$canv create polygon $x [expr {$yt + $delta}] $xl $yt \
3235                        $xr $yt $xr $yb $xl $yb $x [expr {$yb - $delta}] \
3236                        -width 1 -outline black -fill yellow -tags tag.$id]
3237             $canv bind $t <1> [list showtag $tag 1]
3238             set rowtextx($commitrow($curview,$id)) [expr {$xr + $linespc}]
3239         } else {
3240             # draw a head or other ref
3241             if {[incr nheads -1] >= 0} {
3242                 set col green
3243                 if {$tag eq $mainhead} {
3244                     lappend font bold
3245                 }
3246             } else {
3247                 set col "#ddddff"
3248             }
3249             set xl [expr {$xl - $delta/2}]
3250             $canv create polygon $x $yt $xr $yt $xr $yb $x $yb \
3251                 -width 1 -outline black -fill $col -tags tag.$id
3252             if {[regexp {^(remotes/.*/|remotes/)} $tag match remoteprefix]} {
3253                 set rwid [font measure $mainfont $remoteprefix]
3254                 set xi [expr {$x + 1}]
3255                 set yti [expr {$yt + 1}]
3256                 set xri [expr {$x + $rwid}]
3257                 $canv create polygon $xi $yti $xri $yti $xri $yb $xi $yb \
3258                         -width 0 -fill "#ffddaa" -tags tag.$id
3259             }
3260         }
3261         set t [$canv create text $xl $y1 -anchor w -text $tag -fill $fgcolor \
3262                    -font $font -tags [list tag.$id text]]
3263         if {$ntags >= 0} {
3264             $canv bind $t <1> [list showtag $tag 1]
3265         } elseif {$nheads >= 0} {
3266             $canv bind $t <Button-3> [list headmenu %X %Y $id $tag]
3267         }
3268     }
3269     return $xt
3270 }
3271
3272 proc xcoord {i level ln} {
3273     global canvx0 xspc1 xspc2
3274
3275     set x [expr {$canvx0 + $i * $xspc1($ln)}]
3276     if {$i > 0 && $i == $level} {
3277         set x [expr {$x + 0.5 * ($xspc2 - $xspc1($ln))}]
3278     } elseif {$i > $level} {
3279         set x [expr {$x + $xspc2 - $xspc1($ln)}]
3280     }
3281     return $x
3282 }
3283
3284 proc show_status {msg} {
3285     global canv mainfont fgcolor
3286
3287     clear_display
3288     $canv create text 3 3 -anchor nw -text $msg -font $mainfont \
3289         -tags text -fill $fgcolor
3290 }
3291
3292 proc finishcommits {} {
3293     global commitidx phase curview
3294     global pending_select
3295
3296     if {$commitidx($curview) > 0} {
3297         drawrest
3298     } else {
3299         show_status "No commits selected"
3300     }
3301     set phase {}
3302     catch {unset pending_select}
3303 }
3304
3305 # Don't change the text pane cursor if it is currently the hand cursor,
3306 # showing that we are over a sha1 ID link.
3307 proc settextcursor {c} {
3308     global ctext curtextcursor
3309
3310     if {[$ctext cget -cursor] == $curtextcursor} {
3311         $ctext config -cursor $c
3312     }
3313     set curtextcursor $c
3314 }
3315
3316 proc nowbusy {what} {
3317     global isbusy
3318
3319     if {[array names isbusy] eq {}} {
3320         . config -cursor watch
3321         settextcursor watch
3322     }
3323     set isbusy($what) 1
3324 }
3325
3326 proc notbusy {what} {
3327     global isbusy maincursor textcursor
3328
3329     catch {unset isbusy($what)}
3330     if {[array names isbusy] eq {}} {
3331         . config -cursor $maincursor
3332         settextcursor $textcursor
3333     }
3334 }
3335
3336 proc drawrest {} {
3337     global startmsecs
3338     global rowlaidout commitidx curview
3339     global pending_select
3340
3341     set row $rowlaidout
3342     layoutrows $rowlaidout $commitidx($curview) 1
3343     layouttail
3344     optimize_rows $row 0 $commitidx($curview)
3345     showstuff $commitidx($curview)
3346     if {[info exists pending_select]} {
3347         selectline 0 1
3348     }
3349
3350     set drawmsecs [expr {[clock clicks -milliseconds] - $startmsecs}]
3351     #global numcommits
3352     #puts "overall $drawmsecs ms for $numcommits commits"
3353 }
3354
3355 proc findmatches {f} {
3356     global findtype foundstring foundstrlen
3357     if {$findtype == "Regexp"} {
3358         set matches [regexp -indices -all -inline $foundstring $f]
3359     } else {
3360         if {$findtype == "IgnCase"} {
3361             set str [string tolower $f]
3362         } else {
3363             set str $f
3364         }
3365         set matches {}
3366         set i 0
3367         while {[set j [string first $foundstring $str $i]] >= 0} {
3368             lappend matches [list $j [expr {$j+$foundstrlen-1}]]
3369             set i [expr {$j + $foundstrlen}]
3370         }
3371     }
3372     return $matches
3373 }
3374
3375 proc dofind {} {
3376     global findtype findloc findstring markedmatches commitinfo
3377     global numcommits displayorder linehtag linentag linedtag
3378     global mainfont canv canv2 canv3 selectedline
3379     global matchinglines foundstring foundstrlen matchstring
3380     global commitdata
3381
3382     stopfindproc
3383     unmarkmatches
3384     cancel_next_highlight
3385     focus .
3386     set matchinglines {}
3387     if {$findtype == "IgnCase"} {
3388         set foundstring [string tolower $findstring]
3389     } else {
3390         set foundstring $findstring
3391     }
3392     set foundstrlen [string length $findstring]
3393     if {$foundstrlen == 0} return
3394     regsub -all {[*?\[\\]} $foundstring {\\&} matchstring
3395     set matchstring "*$matchstring*"
3396     if {![info exists selectedline]} {
3397         set oldsel -1
3398     } else {
3399         set oldsel $selectedline
3400     }
3401     set didsel 0
3402     set fldtypes {Headline Author Date Committer CDate Comments}
3403     set l -1
3404     foreach id $displayorder {
3405         set d $commitdata($id)
3406         incr l
3407         if {$findtype == "Regexp"} {
3408             set doesmatch [regexp $foundstring $d]
3409         } elseif {$findtype == "IgnCase"} {
3410             set doesmatch [string match -nocase $matchstring $d]
3411         } else {
3412             set doesmatch [string match $matchstring $d]
3413         }
3414         if {!$doesmatch} continue
3415         if {![info exists commitinfo($id)]} {
3416             getcommit $id
3417         }
3418         set info $commitinfo($id)
3419         set doesmatch 0
3420         foreach f $info ty $fldtypes {
3421             if {$findloc != "All fields" && $findloc != $ty} {
3422                 continue
3423             }
3424             set matches [findmatches $f]
3425             if {$matches == {}} continue
3426             set doesmatch 1
3427             if {$ty == "Headline"} {
3428                 drawcmitrow $l
3429                 markmatches $canv $l $f $linehtag($l) $matches $mainfont
3430             } elseif {$ty == "Author"} {
3431                 drawcmitrow $l
3432                 markmatches $canv2 $l $f $linentag($l) $matches $mainfont
3433             } elseif {$ty == "Date"} {
3434                 drawcmitrow $l
3435                 markmatches $canv3 $l $f $linedtag($l) $matches $mainfont
3436             }
3437         }
3438         if {$doesmatch} {
3439             lappend matchinglines $l
3440             if {!$didsel && $l > $oldsel} {
3441                 findselectline $l
3442                 set didsel 1
3443             }
3444         }
3445     }
3446     if {$matchinglines == {}} {
3447         bell
3448     } elseif {!$didsel} {
3449         findselectline [lindex $matchinglines 0]
3450     }
3451 }
3452
3453 proc findselectline {l} {
3454     global findloc commentend ctext
3455     selectline $l 1
3456     if {$findloc == "All fields" || $findloc == "Comments"} {
3457         # highlight the matches in the comments
3458         set f [$ctext get 1.0 $commentend]
3459         set matches [findmatches $f]
3460         foreach match $matches {
3461             set start [lindex $match 0]
3462             set end [expr {[lindex $match 1] + 1}]
3463             $ctext tag add found "1.0 + $start c" "1.0 + $end c"
3464         }
3465     }
3466 }
3467
3468 proc findnext {restart} {
3469     global matchinglines selectedline
3470     if {![info exists matchinglines]} {
3471         if {$restart} {
3472             dofind
3473         }
3474         return
3475     }
3476     if {![info exists selectedline]} return
3477     foreach l $matchinglines {
3478         if {$l > $selectedline} {
3479             findselectline $l
3480             return
3481         }
3482     }
3483     bell
3484 }
3485
3486 proc findprev {} {
3487     global matchinglines selectedline
3488     if {![info exists matchinglines]} {
3489         dofind
3490         return
3491     }
3492     if {![info exists selectedline]} return
3493     set prev {}
3494     foreach l $matchinglines {
3495         if {$l >= $selectedline} break
3496         set prev $l
3497     }
3498     if {$prev != {}} {
3499         findselectline $prev
3500     } else {
3501         bell
3502     }
3503 }
3504
3505 proc stopfindproc {{done 0}} {
3506     global findprocpid findprocfile findids
3507     global ctext findoldcursor phase maincursor textcursor
3508     global findinprogress
3509
3510     catch {unset findids}
3511     if {[info exists findprocpid]} {
3512         if {!$done} {
3513             catch {exec kill $findprocpid}
3514         }
3515         catch {close $findprocfile}
3516         unset findprocpid
3517     }
3518     catch {unset findinprogress}
3519     notbusy find
3520 }
3521
3522 # mark a commit as matching by putting a yellow background
3523 # behind the headline
3524 proc markheadline {l id} {
3525     global canv mainfont linehtag
3526
3527     drawcmitrow $l
3528     set bbox [$canv bbox $linehtag($l)]
3529     set t [$canv create rect $bbox -outline {} -tags matches -fill yellow]
3530     $canv lower $t
3531 }
3532
3533 # mark the bits of a headline, author or date that match a find string
3534 proc markmatches {canv l str tag matches font} {
3535     set bbox [$canv bbox $tag]
3536     set x0 [lindex $bbox 0]
3537     set y0 [lindex $bbox 1]
3538     set y1 [lindex $bbox 3]
3539     foreach match $matches {
3540         set start [lindex $match 0]
3541         set end [lindex $match 1]
3542         if {$start > $end} continue
3543         set xoff [font measure $font [string range $str 0 [expr {$start-1}]]]
3544         set xlen [font measure $font [string range $str 0 [expr {$end}]]]
3545         set t [$canv create rect [expr {$x0+$xoff}] $y0 \
3546                    [expr {$x0+$xlen+2}] $y1 \
3547                    -outline {} -tags matches -fill yellow]
3548         $canv lower $t
3549     }
3550 }
3551
3552 proc unmarkmatches {} {
3553     global matchinglines findids
3554     allcanvs delete matches
3555     catch {unset matchinglines}
3556     catch {unset findids}
3557 }
3558
3559 proc selcanvline {w x y} {
3560     global canv canvy0 ctext linespc
3561     global rowtextx
3562     set ymax [lindex [$canv cget -scrollregion] 3]
3563     if {$ymax == {}} return
3564     set yfrac [lindex [$canv yview] 0]
3565     set y [expr {$y + $yfrac * $ymax}]
3566     set l [expr {int(($y - $canvy0) / $linespc + 0.5)}]
3567     if {$l < 0} {
3568         set l 0
3569     }
3570     if {$w eq $canv} {
3571         if {![info exists rowtextx($l)] || $x < $rowtextx($l)} return
3572     }
3573     unmarkmatches
3574     selectline $l 1
3575 }
3576
3577 proc commit_descriptor {p} {
3578     global commitinfo
3579     if {![info exists commitinfo($p)]} {
3580         getcommit $p
3581     }
3582     set l "..."
3583     if {[llength $commitinfo($p)] > 1} {
3584         set l [lindex $commitinfo($p) 0]
3585     }
3586     return "$p ($l)\n"
3587 }
3588
3589 # append some text to the ctext widget, and make any SHA1 ID
3590 # that we know about be a clickable link.
3591 proc appendwithlinks {text tags} {
3592     global ctext commitrow linknum curview
3593
3594     set start [$ctext index "end - 1c"]
3595     $ctext insert end $text $tags
3596     set links [regexp -indices -all -inline {[0-9a-f]{40}} $text]
3597     foreach l $links {
3598         set s [lindex $l 0]
3599         set e [lindex $l 1]
3600         set linkid [string range $text $s $e]
3601         if {![info exists commitrow($curview,$linkid)]} continue
3602         incr e
3603         $ctext tag add link "$start + $s c" "$start + $e c"
3604         $ctext tag add link$linknum "$start + $s c" "$start + $e c"
3605         $ctext tag bind link$linknum <1> \
3606             [list selectline $commitrow($curview,$linkid) 1]
3607         incr linknum
3608     }
3609     $ctext tag conf link -foreground blue -underline 1
3610     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
3611     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
3612 }
3613
3614 proc viewnextline {dir} {
3615     global canv linespc
3616
3617     $canv delete hover
3618     set ymax [lindex [$canv cget -scrollregion] 3]
3619     set wnow [$canv yview]
3620     set wtop [expr {[lindex $wnow 0] * $ymax}]
3621     set newtop [expr {$wtop + $dir * $linespc}]
3622     if {$newtop < 0} {
3623         set newtop 0
3624     } elseif {$newtop > $ymax} {
3625         set newtop $ymax
3626     }
3627     allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3628 }
3629
3630 # add a list of tag or branch names at position pos
3631 # returns the number of names inserted
3632 proc appendrefs {pos l var} {
3633     global ctext commitrow linknum curview idtags $var
3634
3635     if {[catch {$ctext index $pos}]} {
3636         return 0
3637     }
3638     set tags {}
3639     foreach id $l {
3640         foreach tag [set $var\($id\)] {
3641             lappend tags [concat $tag $id]
3642         }
3643     }
3644     set tags [lsort -index 1 $tags]
3645     set sep {}
3646     foreach tag $tags {
3647         set name [lindex $tag 0]
3648         set id [lindex $tag 1]
3649         set lk link$linknum
3650         incr linknum
3651         $ctext insert $pos $sep
3652         $ctext insert $pos $name $lk
3653         $ctext tag conf $lk -foreground blue
3654         if {[info exists commitrow($curview,$id)]} {
3655             $ctext tag bind $lk <1> \
3656                 [list selectline $commitrow($curview,$id) 1]
3657             $ctext tag conf $lk -underline 1
3658             $ctext tag bind $lk <Enter> { %W configure -cursor hand2 }
3659             $ctext tag bind $lk <Leave> { %W configure -cursor $curtextcursor }
3660         }
3661         set sep ", "
3662     }
3663     return [llength $tags]
3664 }
3665
3666 # called when we have finished computing the nearby tags
3667 proc dispneartags {} {
3668     global selectedline currentid ctext anc_tags desc_tags showneartags
3669     global desc_heads
3670
3671     if {![info exists selectedline] || !$showneartags} return
3672     set id $currentid
3673     $ctext conf -state normal
3674     if {[info exists desc_heads($id)]} {
3675         if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3676             $ctext insert "branch -2c" "es"
3677         }
3678     }
3679     if {[info exists anc_tags($id)]} {
3680         appendrefs follows $anc_tags($id) idtags
3681     }
3682     if {[info exists desc_tags($id)]} {
3683         appendrefs precedes $desc_tags($id) idtags
3684     }
3685     $ctext conf -state disabled
3686 }
3687
3688 proc selectline {l isnew} {
3689     global canv canv2 canv3 ctext commitinfo selectedline
3690     global displayorder linehtag linentag linedtag
3691     global canvy0 linespc parentlist childlist
3692     global currentid sha1entry
3693     global commentend idtags linknum
3694     global mergemax numcommits pending_select
3695     global cmitmode desc_tags anc_tags showneartags allcommits desc_heads
3696
3697     catch {unset pending_select}
3698     $canv delete hover
3699     normalline
3700     cancel_next_highlight
3701     if {$l < 0 || $l >= $numcommits} return
3702     set y [expr {$canvy0 + $l * $linespc}]
3703     set ymax [lindex [$canv cget -scrollregion] 3]
3704     set ytop [expr {$y - $linespc - 1}]
3705     set ybot [expr {$y + $linespc + 1}]
3706     set wnow [$canv yview]
3707     set wtop [expr {[lindex $wnow 0] * $ymax}]
3708     set wbot [expr {[lindex $wnow 1] * $ymax}]
3709     set wh [expr {$wbot - $wtop}]
3710     set newtop $wtop
3711     if {$ytop < $wtop} {
3712         if {$ybot < $wtop} {
3713             set newtop [expr {$y - $wh / 2.0}]
3714         } else {
3715             set newtop $ytop
3716             if {$newtop > $wtop - $linespc} {
3717                 set newtop [expr {$wtop - $linespc}]
3718             }
3719         }
3720     } elseif {$ybot > $wbot} {
3721         if {$ytop > $wbot} {
3722             set newtop [expr {$y - $wh / 2.0}]
3723         } else {
3724             set newtop [expr {$ybot - $wh}]
3725             if {$newtop < $wtop + $linespc} {
3726                 set newtop [expr {$wtop + $linespc}]
3727             }
3728         }
3729     }
3730     if {$newtop != $wtop} {
3731         if {$newtop < 0} {
3732             set newtop 0
3733         }
3734         allcanvs yview moveto [expr {$newtop * 1.0 / $ymax}]
3735         drawvisible
3736     }
3737
3738     if {![info exists linehtag($l)]} return
3739     $canv delete secsel
3740     set t [eval $canv create rect [$canv bbox $linehtag($l)] -outline {{}} \
3741                -tags secsel -fill [$canv cget -selectbackground]]
3742     $canv lower $t
3743     $canv2 delete secsel
3744     set t [eval $canv2 create rect [$canv2 bbox $linentag($l)] -outline {{}} \
3745                -tags secsel -fill [$canv2 cget -selectbackground]]
3746     $canv2 lower $t
3747     $canv3 delete secsel
3748     set t [eval $canv3 create rect [$canv3 bbox $linedtag($l)] -outline {{}} \
3749                -tags secsel -fill [$canv3 cget -selectbackground]]
3750     $canv3 lower $t
3751
3752     if {$isnew} {
3753         addtohistory [list selectline $l 0]
3754     }
3755
3756     set selectedline $l
3757
3758     set id [lindex $displayorder $l]
3759     set currentid $id
3760     $sha1entry delete 0 end
3761     $sha1entry insert 0 $id
3762     $sha1entry selection from 0
3763     $sha1entry selection to end
3764     rhighlight_sel $id
3765
3766     $ctext conf -state normal
3767     clear_ctext
3768     set linknum 0
3769     set info $commitinfo($id)
3770     set date [formatdate [lindex $info 2]]
3771     $ctext insert end "Author: [lindex $info 1]  $date\n"
3772     set date [formatdate [lindex $info 4]]
3773     $ctext insert end "Committer: [lindex $info 3]  $date\n"
3774     if {[info exists idtags($id)]} {
3775         $ctext insert end "Tags:"
3776         foreach tag $idtags($id) {
3777             $ctext insert end " $tag"
3778         }
3779         $ctext insert end "\n"
3780     }
3781
3782     set headers {}
3783     set olds [lindex $parentlist $l]
3784     if {[llength $olds] > 1} {
3785         set np 0
3786         foreach p $olds {
3787             if {$np >= $mergemax} {
3788                 set tag mmax
3789             } else {
3790                 set tag m$np
3791             }
3792             $ctext insert end "Parent: " $tag
3793             appendwithlinks [commit_descriptor $p] {}
3794             incr np
3795         }
3796     } else {
3797         foreach p $olds {
3798             append headers "Parent: [commit_descriptor $p]"
3799         }
3800     }
3801
3802     foreach c [lindex $childlist $l] {
3803         append headers "Child:  [commit_descriptor $c]"
3804     }
3805
3806     # make anything that looks like a SHA1 ID be a clickable link
3807     appendwithlinks $headers {}
3808     if {$showneartags} {
3809         if {![info exists allcommits]} {
3810             getallcommits
3811         }
3812         $ctext insert end "Branch: "
3813         $ctext mark set branch "end -1c"
3814         $ctext mark gravity branch left
3815         if {[info exists desc_heads($id)]} {
3816             if {[appendrefs branch $desc_heads($id) idheads] > 1} {
3817                 # turn "Branch" into "Branches"
3818                 $ctext insert "branch -2c" "es"
3819             }
3820         }
3821         $ctext insert end "\nFollows: "
3822         $ctext mark set follows "end -1c"
3823         $ctext mark gravity follows left
3824         if {[info exists anc_tags($id)]} {
3825             appendrefs follows $anc_tags($id) idtags
3826         }
3827         $ctext insert end "\nPrecedes: "
3828         $ctext mark set precedes "end -1c"
3829         $ctext mark gravity precedes left
3830         if {[info exists desc_tags($id)]} {
3831             appendrefs precedes $desc_tags($id) idtags
3832         }
3833         $ctext insert end "\n"
3834     }
3835     $ctext insert end "\n"
3836     appendwithlinks [lindex $info 5] {comment}
3837
3838     $ctext tag delete Comments
3839     $ctext tag remove found 1.0 end
3840     $ctext conf -state disabled
3841     set commentend [$ctext index "end - 1c"]
3842
3843     init_flist "Comments"
3844     if {$cmitmode eq "tree"} {
3845         gettree $id
3846     } elseif {[llength $olds] <= 1} {
3847         startdiff $id
3848     } else {
3849         mergediff $id $l
3850     }
3851 }
3852
3853 proc selfirstline {} {
3854     unmarkmatches
3855     selectline 0 1
3856 }
3857
3858 proc sellastline {} {
3859     global numcommits
3860     unmarkmatches
3861     set l [expr {$numcommits - 1}]
3862     selectline $l 1
3863 }
3864
3865 proc selnextline {dir} {
3866     global selectedline
3867     if {![info exists selectedline]} return
3868     set l [expr {$selectedline + $dir}]
3869     unmarkmatches
3870     selectline $l 1
3871 }
3872
3873 proc selnextpage {dir} {
3874     global canv linespc selectedline numcommits
3875
3876     set lpp [expr {([winfo height $canv] - 2) / $linespc}]
3877     if {$lpp < 1} {
3878         set lpp 1
3879     }
3880     allcanvs yview scroll [expr {$dir * $lpp}] units
3881     drawvisible
3882     if {![info exists selectedline]} return
3883     set l [expr {$selectedline + $dir * $lpp}]
3884     if {$l < 0} {
3885         set l 0
3886     } elseif {$l >= $numcommits} {
3887         set l [expr $numcommits - 1]
3888     }
3889     unmarkmatches
3890     selectline $l 1
3891 }
3892
3893 proc unselectline {} {
3894     global selectedline currentid
3895
3896     catch {unset selectedline}
3897     catch {unset currentid}
3898     allcanvs delete secsel
3899     rhighlight_none
3900     cancel_next_highlight
3901 }
3902
3903 proc reselectline {} {
3904     global selectedline
3905
3906     if {[info exists selectedline]} {
3907         selectline $selectedline 0
3908     }
3909 }
3910
3911 proc addtohistory {cmd} {
3912     global history historyindex curview
3913
3914     set elt [list $curview $cmd]
3915     if {$historyindex > 0
3916         && [lindex $history [expr {$historyindex - 1}]] == $elt} {
3917         return
3918     }
3919
3920     if {$historyindex < [llength $history]} {
3921         set history [lreplace $history $historyindex end $elt]
3922     } else {
3923         lappend history $elt
3924     }
3925     incr historyindex
3926     if {$historyindex > 1} {
3927         .ctop.top.bar.leftbut conf -state normal
3928     } else {
3929         .ctop.top.bar.leftbut conf -state disabled
3930     }
3931     .ctop.top.bar.rightbut conf -state disabled
3932 }
3933
3934 proc godo {elt} {
3935     global curview
3936
3937     set view [lindex $elt 0]
3938     set cmd [lindex $elt 1]
3939     if {$curview != $view} {
3940         showview $view
3941     }
3942     eval $cmd
3943 }
3944
3945 proc goback {} {
3946     global history historyindex
3947
3948     if {$historyindex > 1} {
3949         incr historyindex -1
3950         godo [lindex $history [expr {$historyindex - 1}]]
3951         .ctop.top.bar.rightbut conf -state normal
3952     }
3953     if {$historyindex <= 1} {
3954         .ctop.top.bar.leftbut conf -state disabled
3955     }
3956 }
3957
3958 proc goforw {} {
3959     global history historyindex
3960
3961     if {$historyindex < [llength $history]} {
3962         set cmd [lindex $history $historyindex]
3963         incr historyindex
3964         godo $cmd
3965         .ctop.top.bar.leftbut conf -state normal
3966     }
3967     if {$historyindex >= [llength $history]} {
3968         .ctop.top.bar.rightbut conf -state disabled
3969     }
3970 }
3971
3972 proc gettree {id} {
3973     global treefilelist treeidlist diffids diffmergeid treepending
3974
3975     set diffids $id
3976     catch {unset diffmergeid}
3977     if {![info exists treefilelist($id)]} {
3978         if {![info exists treepending]} {
3979             if {[catch {set gtf [open [concat | git ls-tree -r $id] r]}]} {
3980                 return
3981             }
3982             set treepending $id
3983             set treefilelist($id) {}
3984             set treeidlist($id) {}
3985             fconfigure $gtf -blocking 0
3986             fileevent $gtf readable [list gettreeline $gtf $id]
3987         }
3988     } else {
3989         setfilelist $id
3990     }
3991 }
3992
3993 proc gettreeline {gtf id} {
3994     global treefilelist treeidlist treepending cmitmode diffids
3995
3996     while {[gets $gtf line] >= 0} {
3997         if {[lindex $line 1] ne "blob"} continue
3998         set sha1 [lindex $line 2]
3999         set fname [lindex $line 3]
4000         lappend treefilelist($id) $fname
4001         lappend treeidlist($id) $sha1
4002     }
4003     if {![eof $gtf]} return
4004     close $gtf
4005     unset treepending
4006     if {$cmitmode ne "tree"} {
4007         if {![info exists diffmergeid]} {
4008             gettreediffs $diffids
4009         }
4010     } elseif {$id ne $diffids} {
4011         gettree $diffids
4012     } else {
4013         setfilelist $id
4014     }
4015 }
4016
4017 proc showfile {f} {
4018     global treefilelist treeidlist diffids
4019     global ctext commentend
4020
4021     set i [lsearch -exact $treefilelist($diffids) $f]
4022     if {$i < 0} {
4023         puts "oops, $f not in list for id $diffids"
4024         return
4025     }
4026     set blob [lindex $treeidlist($diffids) $i]
4027     if {[catch {set bf [open [concat | git cat-file blob $blob] r]} err]} {
4028         puts "oops, error reading blob $blob: $err"
4029         return
4030     }
4031     fconfigure $bf -blocking 0
4032     fileevent $bf readable [list getblobline $bf $diffids]
4033     $ctext config -state normal
4034     clear_ctext $commentend
4035     $ctext insert end "\n"
4036     $ctext insert end "$f\n" filesep
4037     $ctext config -state disabled
4038     $ctext yview $commentend
4039 }
4040
4041 proc getblobline {bf id} {
4042     global diffids cmitmode ctext
4043
4044     if {$id ne $diffids || $cmitmode ne "tree"} {
4045         catch {close $bf}
4046         return
4047     }
4048     $ctext config -state normal
4049     while {[gets $bf line] >= 0} {
4050         $ctext insert end "$line\n"
4051     }
4052     if {[eof $bf]} {
4053         # delete last newline
4054         $ctext delete "end - 2c" "end - 1c"
4055         close $bf
4056     }
4057     $ctext config -state disabled
4058 }
4059
4060 proc mergediff {id l} {
4061     global diffmergeid diffopts mdifffd
4062     global diffids
4063     global parentlist
4064
4065     set diffmergeid $id
4066     set diffids $id
4067     # this doesn't seem to actually affect anything...
4068     set env(GIT_DIFF_OPTS) $diffopts
4069     set cmd [concat | git diff-tree --no-commit-id --cc $id]
4070     if {[catch {set mdf [open $cmd r]} err]} {
4071         error_popup "Error getting merge diffs: $err"
4072         return
4073     }
4074     fconfigure $mdf -blocking 0
4075     set mdifffd($id) $mdf
4076     set np [llength [lindex $parentlist $l]]
4077     fileevent $mdf readable [list getmergediffline $mdf $id $np]
4078     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4079 }
4080
4081 proc getmergediffline {mdf id np} {
4082     global diffmergeid ctext cflist nextupdate mergemax
4083     global difffilestart mdifffd
4084
4085     set n [gets $mdf line]
4086     if {$n < 0} {
4087         if {[eof $mdf]} {
4088             close $mdf
4089         }
4090         return
4091     }
4092     if {![info exists diffmergeid] || $id != $diffmergeid
4093         || $mdf != $mdifffd($id)} {
4094         return
4095     }
4096     $ctext conf -state normal
4097     if {[regexp {^diff --cc (.*)} $line match fname]} {
4098         # start of a new file
4099         $ctext insert end "\n"
4100         set here [$ctext index "end - 1c"]
4101         lappend difffilestart $here
4102         add_flist [list $fname]
4103         set l [expr {(78 - [string length $fname]) / 2}]
4104         set pad [string range "----------------------------------------" 1 $l]
4105         $ctext insert end "$pad $fname $pad\n" filesep
4106     } elseif {[regexp {^@@} $line]} {
4107         $ctext insert end "$line\n" hunksep
4108     } elseif {[regexp {^[0-9a-f]{40}$} $line] || [regexp {^index} $line]} {
4109         # do nothing
4110     } else {
4111         # parse the prefix - one ' ', '-' or '+' for each parent
4112         set spaces {}
4113         set minuses {}
4114         set pluses {}
4115         set isbad 0
4116         for {set j 0} {$j < $np} {incr j} {
4117             set c [string range $line $j $j]
4118             if {$c == " "} {
4119                 lappend spaces $j
4120             } elseif {$c == "-"} {
4121                 lappend minuses $j
4122             } elseif {$c == "+"} {
4123                 lappend pluses $j
4124             } else {
4125                 set isbad 1
4126                 break
4127             }
4128         }
4129         set tags {}
4130         set num {}
4131         if {!$isbad && $minuses ne {} && $pluses eq {}} {
4132             # line doesn't appear in result, parents in $minuses have the line
4133             set num [lindex $minuses 0]
4134         } elseif {!$isbad && $pluses ne {} && $minuses eq {}} {
4135             # line appears in result, parents in $pluses don't have the line
4136             lappend tags mresult
4137             set num [lindex $spaces 0]
4138         }
4139         if {$num ne {}} {
4140             if {$num >= $mergemax} {
4141                 set num "max"
4142             }
4143             lappend tags m$num
4144         }
4145         $ctext insert end "$line\n" $tags
4146     }
4147     $ctext conf -state disabled
4148     if {[clock clicks -milliseconds] >= $nextupdate} {
4149         incr nextupdate 100
4150         fileevent $mdf readable {}
4151         update
4152         fileevent $mdf readable [list getmergediffline $mdf $id $np]
4153     }
4154 }
4155
4156 proc startdiff {ids} {
4157     global treediffs diffids treepending diffmergeid
4158
4159     set diffids $ids
4160     catch {unset diffmergeid}
4161     if {![info exists treediffs($ids)]} {
4162         if {![info exists treepending]} {
4163             gettreediffs $ids
4164         }
4165     } else {
4166         addtocflist $ids
4167     }
4168 }
4169
4170 proc addtocflist {ids} {
4171     global treediffs cflist
4172     add_flist $treediffs($ids)
4173     getblobdiffs $ids
4174 }
4175
4176 proc gettreediffs {ids} {
4177     global treediff treepending
4178     set treepending $ids
4179     set treediff {}
4180     if {[catch \
4181          {set gdtf [open [concat | git diff-tree --no-commit-id -r $ids] r]} \
4182         ]} return
4183     fconfigure $gdtf -blocking 0
4184     fileevent $gdtf readable [list gettreediffline $gdtf $ids]
4185 }
4186
4187 proc gettreediffline {gdtf ids} {
4188     global treediff treediffs treepending diffids diffmergeid
4189     global cmitmode
4190
4191     set n [gets $gdtf line]
4192     if {$n < 0} {
4193         if {![eof $gdtf]} return
4194         close $gdtf
4195         set treediffs($ids) $treediff
4196         unset treepending
4197         if {$cmitmode eq "tree"} {
4198             gettree $diffids
4199         } elseif {$ids != $diffids} {
4200             if {![info exists diffmergeid]} {
4201                 gettreediffs $diffids
4202             }
4203         } else {
4204             addtocflist $ids
4205         }
4206         return
4207     }
4208     set file [lindex $line 5]
4209     lappend treediff $file
4210 }
4211
4212 proc getblobdiffs {ids} {
4213     global diffopts blobdifffd diffids env curdifftag curtagstart
4214     global nextupdate diffinhdr treediffs
4215
4216     set env(GIT_DIFF_OPTS) $diffopts
4217     set cmd [concat | git diff-tree --no-commit-id -r -p -C $ids]
4218     if {[catch {set bdf [open $cmd r]} err]} {
4219         puts "error getting diffs: $err"
4220         return
4221     }
4222     set diffinhdr 0
4223     fconfigure $bdf -blocking 0
4224     set blobdifffd($ids) $bdf
4225     set curdifftag Comments
4226     set curtagstart 0.0
4227     fileevent $bdf readable [list getblobdiffline $bdf $diffids]
4228     set nextupdate [expr {[clock clicks -milliseconds] + 100}]
4229 }
4230
4231 proc setinlist {var i val} {
4232     global $var
4233
4234     while {[llength [set $var]] < $i} {
4235         lappend $var {}
4236     }
4237     if {[llength [set $var]] == $i} {
4238         lappend $var $val
4239     } else {
4240         lset $var $i $val
4241     }
4242 }
4243
4244 proc getblobdiffline {bdf ids} {
4245     global diffids blobdifffd ctext curdifftag curtagstart
4246     global diffnexthead diffnextnote difffilestart
4247     global nextupdate diffinhdr treediffs
4248
4249     set n [gets $bdf line]
4250     if {$n < 0} {
4251         if {[eof $bdf]} {
4252             close $bdf
4253             if {$ids == $diffids && $bdf == $blobdifffd($ids)} {
4254                 $ctext tag add $curdifftag $curtagstart end
4255             }
4256         }
4257         return
4258     }
4259     if {$ids != $diffids || $bdf != $blobdifffd($ids)} {
4260         return
4261     }
4262     $ctext conf -state normal
4263     if {[regexp {^diff --git a/(.*) b/(.*)} $line match fname newname]} {
4264         # start of a new file
4265         $ctext insert end "\n"
4266         $ctext tag add $curdifftag $curtagstart end
4267         set here [$ctext index "end - 1c"]
4268         set curtagstart $here
4269         set header $newname
4270         set i [lsearch -exact $treediffs($ids) $fname]
4271         if {$i >= 0} {
4272             setinlist difffilestart $i $here
4273         }
4274         if {$newname ne $fname} {
4275             set i [lsearch -exact $treediffs($ids) $newname]
4276             if {$i >= 0} {
4277                 setinlist difffilestart $i $here
4278             }
4279         }
4280         set curdifftag "f:$fname"
4281         $ctext tag delete $curdifftag
4282         set l [expr {(78 - [string length $header]) / 2}]
4283         set pad [string range "----------------------------------------" 1 $l]
4284         $ctext insert end "$pad $header $pad\n" filesep
4285         set diffinhdr 1
4286     } elseif {$diffinhdr && [string compare -length 3 $line "---"] == 0} {
4287         # do nothing
4288     } elseif {$diffinhdr && [string compare -length 3 $line "+++"] == 0} {
4289         set diffinhdr 0
4290     } elseif {[regexp {^@@ -([0-9]+),([0-9]+) \+([0-9]+),([0-9]+) @@(.*)} \
4291                    $line match f1l f1c f2l f2c rest]} {
4292         $ctext insert end "$line\n" hunksep
4293         set diffinhdr 0
4294     } else {
4295         set x [string range $line 0 0]
4296         if {$x == "-" || $x == "+"} {
4297             set tag [expr {$x == "+"}]
4298             $ctext insert end "$line\n" d$tag
4299         } elseif {$x == " "} {
4300             $ctext insert end "$line\n"
4301         } elseif {$diffinhdr || $x == "\\"} {
4302             # e.g. "\ No newline at end of file"
4303             $ctext insert end "$line\n" filesep
4304         } else {
4305             # Something else we don't recognize
4306             if {$curdifftag != "Comments"} {
4307                 $ctext insert end "\n"
4308                 $ctext tag add $curdifftag $curtagstart end
4309                 set curtagstart [$ctext index "end - 1c"]
4310                 set curdifftag Comments
4311             }
4312             $ctext insert end "$line\n" filesep
4313         }
4314     }
4315     $ctext conf -state disabled
4316     if {[clock clicks -milliseconds] >= $nextupdate} {
4317         incr nextupdate 100
4318         fileevent $bdf readable {}
4319         update
4320         fileevent $bdf readable "getblobdiffline $bdf {$ids}"
4321     }
4322 }
4323
4324 proc nextfile {} {
4325     global difffilestart ctext
4326     set here [$ctext index @0,0]
4327     foreach loc $difffilestart {
4328         if {[$ctext compare $loc > $here]} {
4329             $ctext yview $loc
4330         }
4331     }
4332 }
4333
4334 proc clear_ctext {{first 1.0}} {
4335     global ctext smarktop smarkbot
4336
4337     set l [lindex [split $first .] 0]
4338     if {![info exists smarktop] || [$ctext compare $first < $smarktop.0]} {
4339         set smarktop $l
4340     }
4341     if {![info exists smarkbot] || [$ctext compare $first < $smarkbot.0]} {
4342         set smarkbot $l
4343     }
4344     $ctext delete $first end
4345 }
4346
4347 proc incrsearch {name ix op} {
4348     global ctext searchstring searchdirn
4349
4350     $ctext tag remove found 1.0 end
4351     if {[catch {$ctext index anchor}]} {
4352         # no anchor set, use start of selection, or of visible area
4353         set sel [$ctext tag ranges sel]
4354         if {$sel ne {}} {
4355             $ctext mark set anchor [lindex $sel 0]
4356         } elseif {$searchdirn eq "-forwards"} {
4357             $ctext mark set anchor @0,0
4358         } else {
4359             $ctext mark set anchor @0,[winfo height $ctext]
4360         }
4361     }
4362     if {$searchstring ne {}} {
4363         set here [$ctext search $searchdirn -- $searchstring anchor]
4364         if {$here ne {}} {
4365             $ctext see $here
4366         }
4367         searchmarkvisible 1
4368     }
4369 }
4370
4371 proc dosearch {} {
4372     global sstring ctext searchstring searchdirn
4373
4374     focus $sstring
4375     $sstring icursor end
4376     set searchdirn -forwards
4377     if {$searchstring ne {}} {
4378         set sel [$ctext tag ranges sel]
4379         if {$sel ne {}} {
4380             set start "[lindex $sel 0] + 1c"
4381         } elseif {[catch {set start [$ctext index anchor]}]} {
4382             set start "@0,0"
4383         }
4384         set match [$ctext search -count mlen -- $searchstring $start]
4385         $ctext tag remove sel 1.0 end
4386         if {$match eq {}} {
4387             bell
4388             return
4389         }
4390         $ctext see $match
4391         set mend "$match + $mlen c"
4392         $ctext tag add sel $match $mend
4393         $ctext mark unset anchor
4394     }
4395 }
4396
4397 proc dosearchback {} {
4398     global sstring ctext searchstring searchdirn
4399
4400     focus $sstring
4401     $sstring icursor end
4402     set searchdirn -backwards
4403     if {$searchstring ne {}} {
4404         set sel [$ctext tag ranges sel]
4405         if {$sel ne {}} {
4406             set start [lindex $sel 0]
4407         } elseif {[catch {set start [$ctext index anchor]}]} {
4408             set start @0,[winfo height $ctext]
4409         }
4410         set match [$ctext search -backwards -count ml -- $searchstring $start]
4411         $ctext tag remove sel 1.0 end
4412         if {$match eq {}} {
4413             bell
4414             return
4415         }
4416         $ctext see $match
4417         set mend "$match + $ml c"
4418         $ctext tag add sel $match $mend
4419         $ctext mark unset anchor
4420     }
4421 }
4422
4423 proc searchmark {first last} {
4424     global ctext searchstring
4425
4426     set mend $first.0
4427     while {1} {
4428         set match [$ctext search -count mlen -- $searchstring $mend $last.end]
4429         if {$match eq {}} break
4430         set mend "$match + $mlen c"
4431         $ctext tag add found $match $mend
4432     }
4433 }
4434
4435 proc searchmarkvisible {doall} {
4436     global ctext smarktop smarkbot
4437
4438     set topline [lindex [split [$ctext index @0,0] .] 0]
4439     set botline [lindex [split [$ctext index @0,[winfo height $ctext]] .] 0]
4440     if {$doall || $botline < $smarktop || $topline > $smarkbot} {
4441         # no overlap with previous
4442         searchmark $topline $botline
4443         set smarktop $topline
4444         set smarkbot $botline
4445     } else {
4446         if {$topline < $smarktop} {
4447             searchmark $topline [expr {$smarktop-1}]
4448             set smarktop $topline
4449         }
4450         if {$botline > $smarkbot} {
4451             searchmark [expr {$smarkbot+1}] $botline
4452             set smarkbot $botline
4453         }
4454     }
4455 }
4456
4457 proc scrolltext {f0 f1} {
4458     global searchstring
4459
4460     .ctop.cdet.left.sb set $f0 $f1
4461     if {$searchstring ne {}} {
4462         searchmarkvisible 0
4463     }
4464 }
4465
4466 proc setcoords {} {
4467     global linespc charspc canvx0 canvy0 mainfont
4468     global xspc1 xspc2 lthickness
4469
4470     set linespc [font metrics $mainfont -linespace]
4471     set charspc [font measure $mainfont "m"]
4472     set canvy0 [expr {int(3 + 0.5 * $linespc)}]
4473     set canvx0 [expr {int(3 + 0.5 * $linespc)}]
4474     set lthickness [expr {int($linespc / 9) + 1}]
4475     set xspc1(0) $linespc
4476     set xspc2 $linespc
4477 }
4478
4479 proc redisplay {} {
4480     global canv
4481     global selectedline
4482
4483     set ymax [lindex [$canv cget -scrollregion] 3]
4484     if {$ymax eq {} || $ymax == 0} return
4485     set span [$canv yview]
4486     clear_display
4487     setcanvscroll
4488     allcanvs yview moveto [lindex $span 0]
4489     drawvisible
4490     if {[info exists selectedline]} {
4491         selectline $selectedline 0
4492     }
4493 }
4494
4495 proc incrfont {inc} {
4496     global mainfont textfont ctext canv phase
4497     global stopped entries
4498     unmarkmatches
4499     set mainfont [lreplace $mainfont 1 1 [expr {[lindex $mainfont 1] + $inc}]]
4500     set textfont [lreplace $textfont 1 1 [expr {[lindex $textfont 1] + $inc}]]
4501     setcoords
4502     $ctext conf -font $textfont
4503     $ctext tag conf filesep -font [concat $textfont bold]
4504     foreach e $entries {
4505         $e conf -font $mainfont
4506     }
4507     if {$phase eq "getcommits"} {
4508         $canv itemconf textitems -font $mainfont
4509     }
4510     redisplay
4511 }
4512
4513 proc clearsha1 {} {
4514     global sha1entry sha1string
4515     if {[string length $sha1string] == 40} {
4516         $sha1entry delete 0 end
4517     }
4518 }
4519
4520 proc sha1change {n1 n2 op} {
4521     global sha1string currentid sha1but
4522     if {$sha1string == {}
4523         || ([info exists currentid] && $sha1string == $currentid)} {
4524         set state disabled
4525     } else {
4526         set state normal
4527     }
4528     if {[$sha1but cget -state] == $state} return
4529     if {$state == "normal"} {
4530         $sha1but conf -state normal -relief raised -text "Goto: "
4531     } else {
4532         $sha1but conf -state disabled -relief flat -text "SHA1 ID: "
4533     }
4534 }
4535
4536 proc gotocommit {} {
4537     global sha1string currentid commitrow tagids headids
4538     global displayorder numcommits curview
4539
4540     if {$sha1string == {}
4541         || ([info exists currentid] && $sha1string == $currentid)} return
4542     if {[info exists tagids($sha1string)]} {
4543         set id $tagids($sha1string)
4544     } elseif {[info exists headids($sha1string)]} {
4545         set id $headids($sha1string)
4546     } else {
4547         set id [string tolower $sha1string]
4548         if {[regexp {^[0-9a-f]{4,39}$} $id]} {
4549             set matches {}
4550             foreach i $displayorder {
4551                 if {[string match $id* $i]} {
4552                     lappend matches $i
4553                 }
4554             }
4555             if {$matches ne {}} {
4556                 if {[llength $matches] > 1} {
4557                     error_popup "Short SHA1 id $id is ambiguous"
4558                     return
4559                 }
4560                 set id [lindex $matches 0]
4561             }
4562         }
4563     }
4564     if {[info exists commitrow($curview,$id)]} {
4565         selectline $commitrow($curview,$id) 1
4566         return
4567     }
4568     if {[regexp {^[0-9a-fA-F]{4,}$} $sha1string]} {
4569         set type "SHA1 id"
4570     } else {
4571         set type "Tag/Head"
4572     }
4573     error_popup "$type $sha1string is not known"
4574 }
4575
4576 proc lineenter {x y id} {
4577     global hoverx hovery hoverid hovertimer
4578     global commitinfo canv
4579
4580     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4581     set hoverx $x
4582     set hovery $y
4583     set hoverid $id
4584     if {[info exists hovertimer]} {
4585         after cancel $hovertimer
4586     }
4587     set hovertimer [after 500 linehover]
4588     $canv delete hover
4589 }
4590
4591 proc linemotion {x y id} {
4592     global hoverx hovery hoverid hovertimer
4593
4594     if {[info exists hoverid] && $id == $hoverid} {
4595         set hoverx $x
4596         set hovery $y
4597         if {[info exists hovertimer]} {
4598             after cancel $hovertimer
4599         }
4600         set hovertimer [after 500 linehover]
4601     }
4602 }
4603
4604 proc lineleave {id} {
4605     global hoverid hovertimer canv
4606
4607     if {[info exists hoverid] && $id == $hoverid} {
4608         $canv delete hover
4609         if {[info exists hovertimer]} {
4610             after cancel $hovertimer
4611             unset hovertimer
4612         }
4613         unset hoverid
4614     }
4615 }
4616
4617 proc linehover {} {
4618     global hoverx hovery hoverid hovertimer
4619     global canv linespc lthickness
4620     global commitinfo mainfont
4621
4622     set text [lindex $commitinfo($hoverid) 0]
4623     set ymax [lindex [$canv cget -scrollregion] 3]
4624     if {$ymax == {}} return
4625     set yfrac [lindex [$canv yview] 0]
4626     set x [expr {$hoverx + 2 * $linespc}]
4627     set y [expr {$hovery + $yfrac * $ymax - $linespc / 2}]
4628     set x0 [expr {$x - 2 * $lthickness}]
4629     set y0 [expr {$y - 2 * $lthickness}]
4630     set x1 [expr {$x + [font measure $mainfont $text] + 2 * $lthickness}]
4631     set y1 [expr {$y + $linespc + 2 * $lthickness}]
4632     set t [$canv create rectangle $x0 $y0 $x1 $y1 \
4633                -fill \#ffff80 -outline black -width 1 -tags hover]
4634     $canv raise $t
4635     set t [$canv create text $x $y -anchor nw -text $text -tags hover \
4636                -font $mainfont]
4637     $canv raise $t
4638 }
4639
4640 proc clickisonarrow {id y} {
4641     global lthickness
4642
4643     set ranges [rowranges $id]
4644     set thresh [expr {2 * $lthickness + 6}]
4645     set n [expr {[llength $ranges] - 1}]
4646     for {set i 1} {$i < $n} {incr i} {
4647         set row [lindex $ranges $i]
4648         if {abs([yc $row] - $y) < $thresh} {
4649             return $i
4650         }
4651     }
4652     return {}
4653 }
4654
4655 proc arrowjump {id n y} {
4656     global canv
4657
4658     # 1 <-> 2, 3 <-> 4, etc...
4659     set n [expr {(($n - 1) ^ 1) + 1}]
4660     set row [lindex [rowranges $id] $n]
4661     set yt [yc $row]
4662     set ymax [lindex [$canv cget -scrollregion] 3]
4663     if {$ymax eq {} || $ymax <= 0} return
4664     set view [$canv yview]
4665     set yspan [expr {[lindex $view 1] - [lindex $view 0]}]
4666     set yfrac [expr {$yt / $ymax - $yspan / 2}]
4667     if {$yfrac < 0} {
4668         set yfrac 0
4669     }
4670     allcanvs yview moveto $yfrac
4671 }
4672
4673 proc lineclick {x y id isnew} {
4674     global ctext commitinfo children canv thickerline curview
4675
4676     if {![info exists commitinfo($id)] && ![getcommit $id]} return
4677     unmarkmatches
4678     unselectline
4679     normalline
4680     $canv delete hover
4681     # draw this line thicker than normal
4682     set thickerline $id
4683     drawlines $id
4684     if {$isnew} {
4685         set ymax [lindex [$canv cget -scrollregion] 3]
4686         if {$ymax eq {}} return
4687         set yfrac [lindex [$canv yview] 0]
4688         set y [expr {$y + $yfrac * $ymax}]
4689     }
4690     set dirn [clickisonarrow $id $y]
4691     if {$dirn ne {}} {
4692         arrowjump $id $dirn $y
4693         return
4694     }
4695
4696     if {$isnew} {
4697         addtohistory [list lineclick $x $y $id 0]
4698     }
4699     # fill the details pane with info about this line
4700     $ctext conf -state normal
4701     clear_ctext
4702     $ctext tag conf link -foreground blue -underline 1
4703     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4704     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4705     $ctext insert end "Parent:\t"
4706     $ctext insert end $id [list link link0]
4707     $ctext tag bind link0 <1> [list selbyid $id]
4708     set info $commitinfo($id)
4709     $ctext insert end "\n\t[lindex $info 0]\n"
4710     $ctext insert end "\tAuthor:\t[lindex $info 1]\n"
4711     set date [formatdate [lindex $info 2]]
4712     $ctext insert end "\tDate:\t$date\n"
4713     set kids $children($curview,$id)
4714     if {$kids ne {}} {
4715         $ctext insert end "\nChildren:"
4716         set i 0
4717         foreach child $kids {
4718             incr i
4719             if {![info exists commitinfo($child)] && ![getcommit $child]} continue
4720             set info $commitinfo($child)
4721             $ctext insert end "\n\t"
4722             $ctext insert end $child [list link link$i]
4723             $ctext tag bind link$i <1> [list selbyid $child]
4724             $ctext insert end "\n\t[lindex $info 0]"
4725             $ctext insert end "\n\tAuthor:\t[lindex $info 1]"
4726             set date [formatdate [lindex $info 2]]
4727             $ctext insert end "\n\tDate:\t$date\n"
4728         }
4729     }
4730     $ctext conf -state disabled
4731     init_flist {}
4732 }
4733
4734 proc normalline {} {
4735     global thickerline
4736     if {[info exists thickerline]} {
4737         set id $thickerline
4738         unset thickerline
4739         drawlines $id
4740     }
4741 }
4742
4743 proc selbyid {id} {
4744     global commitrow curview
4745     if {[info exists commitrow($curview,$id)]} {
4746         selectline $commitrow($curview,$id) 1
4747     }
4748 }
4749
4750 proc mstime {} {
4751     global startmstime
4752     if {![info exists startmstime]} {
4753         set startmstime [clock clicks -milliseconds]
4754     }
4755     return [format "%.3f" [expr {([clock click -milliseconds] - $startmstime) / 1000.0}]]
4756 }
4757
4758 proc rowmenu {x y id} {
4759     global rowctxmenu commitrow selectedline rowmenuid curview
4760
4761     if {![info exists selectedline]
4762         || $commitrow($curview,$id) eq $selectedline} {
4763         set state disabled
4764     } else {
4765         set state normal
4766     }
4767     $rowctxmenu entryconfigure 0 -state $state
4768     $rowctxmenu entryconfigure 1 -state $state
4769     $rowctxmenu entryconfigure 2 -state $state
4770     set rowmenuid $id
4771     tk_popup $rowctxmenu $x $y
4772 }
4773
4774 proc diffvssel {dirn} {
4775     global rowmenuid selectedline displayorder
4776
4777     if {![info exists selectedline]} return
4778     if {$dirn} {
4779         set oldid [lindex $displayorder $selectedline]
4780         set newid $rowmenuid
4781     } else {
4782         set oldid $rowmenuid
4783         set newid [lindex $displayorder $selectedline]
4784     }
4785     addtohistory [list doseldiff $oldid $newid]
4786     doseldiff $oldid $newid
4787 }
4788
4789 proc doseldiff {oldid newid} {
4790     global ctext
4791     global commitinfo
4792
4793     $ctext conf -state normal
4794     clear_ctext
4795     init_flist "Top"
4796     $ctext insert end "From "
4797     $ctext tag conf link -foreground blue -underline 1
4798     $ctext tag bind link <Enter> { %W configure -cursor hand2 }
4799     $ctext tag bind link <Leave> { %W configure -cursor $curtextcursor }
4800     $ctext tag bind link0 <1> [list selbyid $oldid]
4801     $ctext insert end $oldid [list link link0]
4802     $ctext insert end "\n     "
4803     $ctext insert end [lindex $commitinfo($oldid) 0]
4804     $ctext insert end "\n\nTo   "
4805     $ctext tag bind link1 <1> [list selbyid $newid]
4806     $ctext insert end $newid [list link link1]
4807     $ctext insert end "\n     "
4808     $ctext insert end [lindex $commitinfo($newid) 0]
4809     $ctext insert end "\n"
4810     $ctext conf -state disabled
4811     $ctext tag delete Comments
4812     $ctext tag remove found 1.0 end
4813     startdiff [list $oldid $newid]
4814 }
4815
4816 proc mkpatch {} {
4817     global rowmenuid currentid commitinfo patchtop patchnum
4818
4819     if {![info exists currentid]} return
4820     set oldid $currentid
4821     set oldhead [lindex $commitinfo($oldid) 0]
4822     set newid $rowmenuid
4823     set newhead [lindex $commitinfo($newid) 0]
4824     set top .patch
4825     set patchtop $top
4826     catch {destroy $top}
4827     toplevel $top
4828     label $top.title -text "Generate patch"
4829     grid $top.title - -pady 10
4830     label $top.from -text "From:"
4831     entry $top.fromsha1 -width 40 -relief flat
4832     $top.fromsha1 insert 0 $oldid
4833     $top.fromsha1 conf -state readonly
4834     grid $top.from $top.fromsha1 -sticky w
4835     entry $top.fromhead -width 60 -relief flat
4836     $top.fromhead insert 0 $oldhead
4837     $top.fromhead conf -state readonly
4838     grid x $top.fromhead -sticky w
4839     label $top.to -text "To:"
4840     entry $top.tosha1 -width 40 -relief flat
4841     $top.tosha1 insert 0 $newid
4842     $top.tosha1 conf -state readonly
4843     grid $top.to $top.tosha1 -sticky w
4844     entry $top.tohead -width 60 -relief flat
4845     $top.tohead insert 0 $newhead
4846     $top.tohead conf -state readonly
4847     grid x $top.tohead -sticky w
4848     button $top.rev -text "Reverse" -command mkpatchrev -padx 5
4849     grid $top.rev x -pady 10
4850     label $top.flab -text "Output file:"
4851     entry $top.fname -width 60
4852     $top.fname insert 0 [file normalize "patch$patchnum.patch"]
4853     incr patchnum
4854     grid $top.flab $top.fname -sticky w
4855     frame $top.buts
4856     button $top.buts.gen -text "Generate" -command mkpatchgo
4857     button $top.buts.can -text "Cancel" -command mkpatchcan
4858     grid $top.buts.gen $top.buts.can
4859     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4860     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4861     grid $top.buts - -pady 10 -sticky ew
4862     focus $top.fname
4863 }
4864
4865 proc mkpatchrev {} {
4866     global patchtop
4867
4868     set oldid [$patchtop.fromsha1 get]
4869     set oldhead [$patchtop.fromhead get]
4870     set newid [$patchtop.tosha1 get]
4871     set newhead [$patchtop.tohead get]
4872     foreach e [list fromsha1 fromhead tosha1 tohead] \
4873             v [list $newid $newhead $oldid $oldhead] {
4874         $patchtop.$e conf -state normal
4875         $patchtop.$e delete 0 end
4876         $patchtop.$e insert 0 $v
4877         $patchtop.$e conf -state readonly
4878     }
4879 }
4880
4881 proc mkpatchgo {} {
4882     global patchtop
4883
4884     set oldid [$patchtop.fromsha1 get]
4885     set newid [$patchtop.tosha1 get]
4886     set fname [$patchtop.fname get]
4887     if {[catch {exec git diff-tree -p $oldid $newid >$fname &} err]} {
4888         error_popup "Error creating patch: $err"
4889     }
4890     catch {destroy $patchtop}
4891     unset patchtop
4892 }
4893
4894 proc mkpatchcan {} {
4895     global patchtop
4896
4897     catch {destroy $patchtop}
4898     unset patchtop
4899 }
4900
4901 proc mktag {} {
4902     global rowmenuid mktagtop commitinfo
4903
4904     set top .maketag
4905     set mktagtop $top
4906     catch {destroy $top}
4907     toplevel $top
4908     label $top.title -text "Create tag"
4909     grid $top.title - -pady 10
4910     label $top.id -text "ID:"
4911     entry $top.sha1 -width 40 -relief flat
4912     $top.sha1 insert 0 $rowmenuid
4913     $top.sha1 conf -state readonly
4914     grid $top.id $top.sha1 -sticky w
4915     entry $top.head -width 60 -relief flat
4916     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
4917     $top.head conf -state readonly
4918     grid x $top.head -sticky w
4919     label $top.tlab -text "Tag name:"
4920     entry $top.tag -width 60
4921     grid $top.tlab $top.tag -sticky w
4922     frame $top.buts
4923     button $top.buts.gen -text "Create" -command mktaggo
4924     button $top.buts.can -text "Cancel" -command mktagcan
4925     grid $top.buts.gen $top.buts.can
4926     grid columnconfigure $top.buts 0 -weight 1 -uniform a
4927     grid columnconfigure $top.buts 1 -weight 1 -uniform a
4928     grid $top.buts - -pady 10 -sticky ew
4929     focus $top.tag
4930 }
4931
4932 proc domktag {} {
4933     global mktagtop env tagids idtags
4934
4935     set id [$mktagtop.sha1 get]
4936     set tag [$mktagtop.tag get]
4937     if {$tag == {}} {
4938         error_popup "No tag name specified"
4939         return
4940     }
4941     if {[info exists tagids($tag)]} {
4942         error_popup "Tag \"$tag\" already exists"
4943         return
4944     }
4945     if {[catch {
4946         set dir [gitdir]
4947         set fname [file join $dir "refs/tags" $tag]
4948         set f [open $fname w]
4949         puts $f $id
4950         close $f
4951     } err]} {
4952         error_popup "Error creating tag: $err"
4953         return
4954     }
4955
4956     set tagids($tag) $id
4957     lappend idtags($id) $tag
4958     redrawtags $id
4959 }
4960
4961 proc redrawtags {id} {
4962     global canv linehtag commitrow idpos selectedline curview
4963     global mainfont canvxmax
4964
4965     if {![info exists commitrow($curview,$id)]} return
4966     drawcmitrow $commitrow($curview,$id)
4967     $canv delete tag.$id
4968     set xt [eval drawtags $id $idpos($id)]
4969     $canv coords $linehtag($commitrow($curview,$id)) $xt [lindex $idpos($id) 2]
4970     set text [$canv itemcget $linehtag($commitrow($curview,$id)) -text]
4971     set xr [expr {$xt + [font measure $mainfont $text]}]
4972     if {$xr > $canvxmax} {
4973         set canvxmax $xr
4974         setcanvscroll
4975     }
4976     if {[info exists selectedline]
4977         && $selectedline == $commitrow($curview,$id)} {
4978         selectline $selectedline 0
4979     }
4980 }
4981
4982 proc mktagcan {} {
4983     global mktagtop
4984
4985     catch {destroy $mktagtop}
4986     unset mktagtop
4987 }
4988
4989 proc mktaggo {} {
4990     domktag
4991     mktagcan
4992 }
4993
4994 proc writecommit {} {
4995     global rowmenuid wrcomtop commitinfo wrcomcmd
4996
4997     set top .writecommit
4998     set wrcomtop $top
4999     catch {destroy $top}
5000     toplevel $top
5001     label $top.title -text "Write commit to file"
5002     grid $top.title - -pady 10
5003     label $top.id -text "ID:"
5004     entry $top.sha1 -width 40 -relief flat
5005     $top.sha1 insert 0 $rowmenuid
5006     $top.sha1 conf -state readonly
5007     grid $top.id $top.sha1 -sticky w
5008     entry $top.head -width 60 -relief flat
5009     $top.head insert 0 [lindex $commitinfo($rowmenuid) 0]
5010     $top.head conf -state readonly
5011     grid x $top.head -sticky w
5012     label $top.clab -text "Command:"
5013     entry $top.cmd -width 60 -textvariable wrcomcmd
5014     grid $top.clab $top.cmd -sticky w -pady 10
5015     label $top.flab -text "Output file:"
5016     entry $top.fname -width 60
5017     $top.fname insert 0 [file normalize "commit-[string range $rowmenuid 0 6]"]
5018     grid $top.flab $top.fname -sticky w
5019     frame $top.buts
5020     button $top.buts.gen -text "Write" -command wrcomgo
5021     button $top.buts.can -text "Cancel" -command wrcomcan
5022     grid $top.buts.gen $top.buts.can
5023     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5024     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5025     grid $top.buts - -pady 10 -sticky ew
5026     focus $top.fname
5027 }
5028
5029 proc wrcomgo {} {
5030     global wrcomtop
5031
5032     set id [$wrcomtop.sha1 get]
5033     set cmd "echo $id | [$wrcomtop.cmd get]"
5034     set fname [$wrcomtop.fname get]
5035     if {[catch {exec sh -c $cmd >$fname &} err]} {
5036         error_popup "Error writing commit: $err"
5037     }
5038     catch {destroy $wrcomtop}
5039     unset wrcomtop
5040 }
5041
5042 proc wrcomcan {} {
5043     global wrcomtop
5044
5045     catch {destroy $wrcomtop}
5046     unset wrcomtop
5047 }
5048
5049 proc mkbranch {} {
5050     global rowmenuid mkbrtop
5051
5052     set top .makebranch
5053     catch {destroy $top}
5054     toplevel $top
5055     label $top.title -text "Create new branch"
5056     grid $top.title - -pady 10
5057     label $top.id -text "ID:"
5058     entry $top.sha1 -width 40 -relief flat
5059     $top.sha1 insert 0 $rowmenuid
5060     $top.sha1 conf -state readonly
5061     grid $top.id $top.sha1 -sticky w
5062     label $top.nlab -text "Name:"
5063     entry $top.name -width 40
5064     grid $top.nlab $top.name -sticky w
5065     frame $top.buts
5066     button $top.buts.go -text "Create" -command [list mkbrgo $top]
5067     button $top.buts.can -text "Cancel" -command "catch {destroy $top}"
5068     grid $top.buts.go $top.buts.can
5069     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5070     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5071     grid $top.buts - -pady 10 -sticky ew
5072     focus $top.name
5073 }
5074
5075 proc mkbrgo {top} {
5076     global headids idheads
5077
5078     set name [$top.name get]
5079     set id [$top.sha1 get]
5080     if {$name eq {}} {
5081         error_popup "Please specify a name for the new branch"
5082         return
5083     }
5084     catch {destroy $top}
5085     nowbusy newbranch
5086     update
5087     if {[catch {
5088         exec git branch $name $id
5089     } err]} {
5090         notbusy newbranch
5091         error_popup $err
5092     } else {
5093         set headids($name) $id
5094         if {![info exists idheads($id)]} {
5095             addedhead $id
5096         }
5097         lappend idheads($id) $name
5098         # XXX should update list of heads displayed for selected commit
5099         notbusy newbranch
5100         redrawtags $id
5101     }
5102 }
5103
5104 # context menu for a head
5105 proc headmenu {x y id head} {
5106     global headmenuid headmenuhead headctxmenu
5107
5108     set headmenuid $id
5109     set headmenuhead $head
5110     tk_popup $headctxmenu $x $y
5111 }
5112
5113 proc cobranch {} {
5114     global headmenuid headmenuhead mainhead headids
5115
5116     # check the tree is clean first??
5117     set oldmainhead $mainhead
5118     nowbusy checkout
5119     update
5120     if {[catch {
5121         exec git checkout $headmenuhead
5122     } err]} {
5123         notbusy checkout
5124         error_popup $err
5125     } else {
5126         notbusy checkout
5127         set maainhead $headmenuhead
5128         if {[info exists headids($oldmainhead)]} {
5129             redrawtags $headids($oldmainhead)
5130         }
5131         redrawtags $headmenuid
5132     }
5133 }
5134
5135 proc rmbranch {} {
5136     global desc_heads headmenuid headmenuhead mainhead
5137     global headids idheads
5138
5139     set head $headmenuhead
5140     set id $headmenuid
5141     if {$head eq $mainhead} {
5142         error_popup "Cannot delete the currently checked-out branch"
5143         return
5144     }
5145     if {$desc_heads($id) eq $id} {
5146         # the stuff on this branch isn't on any other branch
5147         if {![confirm_popup "The commits on branch $head aren't on any other\
5148                         branch.\nReally delete branch $head?"]} return
5149     }
5150     nowbusy rmbranch
5151     update
5152     if {[catch {exec git branch -D $head} err]} {
5153         notbusy rmbranch
5154         error_popup $err
5155         return
5156     }
5157     unset headids($head)
5158     if {$idheads($id) eq $head} {
5159         unset idheads($id)
5160         removedhead $id
5161     } else {
5162         set i [lsearch -exact $idheads($id) $head]
5163         if {$i >= 0} {
5164             set idheads($id) [lreplace $idheads($id) $i $i]
5165         }
5166     }
5167     redrawtags $id
5168     notbusy rmbranch
5169 }
5170
5171 # Stuff for finding nearby tags
5172 proc getallcommits {} {
5173     global allcstart allcommits allcfd allids
5174
5175     set allids {}
5176     set fd [open [concat | git rev-list --all --topo-order --parents] r]
5177     set allcfd $fd
5178     fconfigure $fd -blocking 0
5179     set allcommits "reading"
5180     nowbusy allcommits
5181     restartgetall $fd
5182 }
5183
5184 proc discardallcommits {} {
5185     global allparents allchildren allcommits allcfd
5186     global desc_tags anc_tags alldtags tagisdesc allids desc_heads
5187
5188     if {![info exists allcommits]} return
5189     if {$allcommits eq "reading"} {
5190         catch {close $allcfd}
5191     }
5192     foreach v {allcommits allchildren allparents allids desc_tags anc_tags
5193                 alldtags tagisdesc desc_heads} {
5194         catch {unset $v}
5195     }
5196 }
5197
5198 proc restartgetall {fd} {
5199     global allcstart
5200
5201     fileevent $fd readable [list getallclines $fd]
5202     set allcstart [clock clicks -milliseconds]
5203 }
5204
5205 proc combine_dtags {l1 l2} {
5206     global tagisdesc notfirstd
5207
5208     set res [lsort -unique [concat $l1 $l2]]
5209     for {set i 0} {$i < [llength $res]} {incr i} {
5210         set x [lindex $res $i]
5211         for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5212             set y [lindex $res $j]
5213             if {[info exists tagisdesc($x,$y)]} {
5214                 if {$tagisdesc($x,$y) > 0} {
5215                     # x is a descendent of y, exclude x
5216                     set res [lreplace $res $i $i]
5217                     incr i -1
5218                     break
5219                 } else {
5220                     # y is a descendent of x, exclude y
5221                     set res [lreplace $res $j $j]
5222                 }
5223             } else {
5224                 # no relation, keep going
5225                 incr j
5226             }
5227         }
5228     }
5229     return $res
5230 }
5231
5232 proc combine_atags {l1 l2} {
5233     global tagisdesc
5234
5235     set res [lsort -unique [concat $l1 $l2]]
5236     for {set i 0} {$i < [llength $res]} {incr i} {
5237         set x [lindex $res $i]
5238         for {set j [expr {$i+1}]} {$j < [llength $res]} {} {
5239             set y [lindex $res $j]
5240             if {[info exists tagisdesc($x,$y)]} {
5241                 if {$tagisdesc($x,$y) < 0} {
5242                     # x is an ancestor of y, exclude x
5243                     set res [lreplace $res $i $i]
5244                     incr i -1
5245                     break
5246                 } else {
5247                     # y is an ancestor of x, exclude y
5248                     set res [lreplace $res $j $j]
5249                 }
5250             } else {
5251                 # no relation, keep going
5252                 incr j
5253             }
5254         }
5255     }
5256     return $res
5257 }
5258
5259 proc forward_pass {id children} {
5260     global idtags desc_tags idheads desc_heads alldtags tagisdesc
5261
5262     set dtags {}
5263     set dheads {}
5264     foreach child $children {
5265         if {[info exists idtags($child)]} {
5266             set ctags [list $child]
5267         } else {
5268             set ctags $desc_tags($child)
5269         }
5270         if {$dtags eq {}} {
5271             set dtags $ctags
5272         } elseif {$ctags ne $dtags} {
5273             set dtags [combine_dtags $dtags $ctags]
5274         }
5275         set cheads $desc_heads($child)
5276         if {$dheads eq {}} {
5277             set dheads $cheads
5278         } elseif {$cheads ne $dheads} {
5279             set dheads [lsort -unique [concat $dheads $cheads]]
5280         }
5281     }
5282     set desc_tags($id) $dtags
5283     if {[info exists idtags($id)]} {
5284         set adt $dtags
5285         foreach tag $dtags {
5286             set adt [concat $adt $alldtags($tag)]
5287         }
5288         set adt [lsort -unique $adt]
5289         set alldtags($id) $adt
5290         foreach tag $adt {
5291             set tagisdesc($id,$tag) -1
5292             set tagisdesc($tag,$id) 1
5293         }
5294     }
5295     if {[info exists idheads($id)]} {
5296         lappend dheads $id
5297     }
5298     set desc_heads($id) $dheads
5299 }
5300
5301 proc getallclines {fd} {
5302     global allparents allchildren allcommits allcstart
5303     global desc_tags anc_tags idtags tagisdesc allids
5304     global desc_heads idheads travindex
5305
5306     while {[gets $fd line] >= 0} {
5307         set id [lindex $line 0]
5308         lappend allids $id
5309         set olds [lrange $line 1 end]
5310         set allparents($id) $olds
5311         if {![info exists allchildren($id)]} {
5312             set allchildren($id) {}
5313         }
5314         foreach p $olds {
5315             lappend allchildren($p) $id
5316         }
5317         # compute nearest tagged descendents as we go
5318         # also compute descendent heads
5319         forward_pass $id $allchildren($id)
5320         if {[clock clicks -milliseconds] - $allcstart >= 50} {
5321             fileevent $fd readable {}
5322             after idle restartgetall $fd
5323             return
5324         }
5325     }
5326     if {[eof $fd]} {
5327         set travindex [llength $allids]
5328         set allcommits "traversing"
5329         after idle restartatags
5330         if {[catch {close $fd} err]} {
5331             error_popup "Error reading full commit graph: $err.\n\
5332                          Results may be incomplete."
5333         }
5334     }
5335 }
5336
5337 # walk backward through the tree and compute nearest tagged ancestors
5338 proc restartatags {} {
5339     global allids allparents idtags anc_tags travindex
5340
5341     set t0 [clock clicks -milliseconds]
5342     set i $travindex
5343     while {[incr i -1] >= 0} {
5344         set id [lindex $allids $i]
5345         set atags {}
5346         foreach p $allparents($id) {
5347             if {[info exists idtags($p)]} {
5348                 set ptags [list $p]
5349             } else {
5350                 set ptags $anc_tags($p)
5351             }
5352             if {$atags eq {}} {
5353                 set atags $ptags
5354             } elseif {$ptags ne $atags} {
5355                 set atags [combine_atags $atags $ptags]
5356             }
5357         }
5358         set anc_tags($id) $atags
5359         if {[clock clicks -milliseconds] - $t0 >= 50} {
5360             set travindex $i
5361             after idle restartatags
5362             return
5363         }
5364     }
5365     set allcommits "done"
5366     set travindex 0
5367     notbusy allcommits
5368     dispneartags
5369 }
5370
5371 # update the desc_heads array for a new head just added
5372 proc addedhead {hid} {
5373     global desc_heads allparents
5374
5375     set todo [list $hid]
5376     while {$todo ne {}} {
5377         set do [lindex $todo 0]
5378         set todo [lrange $todo 1 end]
5379         if {![info exists desc_heads($do)] ||
5380             [lsearch -exact $desc_heads($do) $hid] >= 0} continue
5381         set oldheads $desc_heads($do)
5382         lappend desc_heads($do) $hid
5383         set heads $desc_heads($do)
5384         while {1} {
5385             set p $allparents($do)
5386             if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5387                 $desc_heads($p) ne $oldheads} break
5388             set do $p
5389             set desc_heads($do) $heads
5390         }
5391         set todo [concat $todo $p]
5392     }
5393 }
5394
5395 # update the desc_heads array for a head just removed
5396 proc removedhead {hid} {
5397     global desc_heads allparents
5398
5399     set todo [list $hid]
5400     while {$todo ne {}} {
5401         set do [lindex $todo 0]
5402         set todo [lrange $todo 1 end]
5403         if {![info exists desc_heads($do)]} continue
5404         set i [lsearch -exact $desc_heads($do) $hid]
5405         if {$i < 0} continue
5406         set oldheads $desc_heads($do)
5407         set heads [lreplace $desc_heads($do) $i $i]
5408         while {1} {
5409             set desc_heads($do) $heads
5410             set p $allparents($do)
5411             if {[llength $p] != 1 || ![info exists desc_heads($p)] ||
5412                 $desc_heads($p) ne $oldheads} break
5413             set do $p
5414         }
5415         set todo [concat $todo $p]
5416     }
5417 }
5418
5419 proc changedrefs {} {
5420     global desc_heads desc_tags anc_tags allcommits allids
5421     global allchildren allparents idtags travindex
5422
5423     if {![info exists allcommits]} return
5424     catch {unset desc_heads}
5425     catch {unset desc_tags}
5426     catch {unset anc_tags}
5427     catch {unset alldtags}
5428     catch {unset tagisdesc}
5429     foreach id $allids {
5430         forward_pass $id $allchildren($id)
5431     }
5432     if {$allcommits ne "reading"} {
5433         set travindex [llength $allids]
5434         if {$allcommits ne "traversing"} {
5435             set allcommits "traversing"
5436             after idle restartatags
5437         }
5438     }
5439 }
5440
5441 proc rereadrefs {} {
5442     global idtags idheads idotherrefs mainhead
5443
5444     set refids [concat [array names idtags] \
5445                     [array names idheads] [array names idotherrefs]]
5446     foreach id $refids {
5447         if {![info exists ref($id)]} {
5448             set ref($id) [listrefs $id]
5449         }
5450     }
5451     set oldmainhead $mainhead
5452     readrefs
5453     changedrefs
5454     set refids [lsort -unique [concat $refids [array names idtags] \
5455                         [array names idheads] [array names idotherrefs]]]
5456     foreach id $refids {
5457         set v [listrefs $id]
5458         if {![info exists ref($id)] || $ref($id) != $v ||
5459             ($id eq $oldmainhead && $id ne $mainhead) ||
5460             ($id eq $mainhead && $id ne $oldmainhead)} {
5461             redrawtags $id
5462         }
5463     }
5464 }
5465
5466 proc listrefs {id} {
5467     global idtags idheads idotherrefs
5468
5469     set x {}
5470     if {[info exists idtags($id)]} {
5471         set x $idtags($id)
5472     }
5473     set y {}
5474     if {[info exists idheads($id)]} {
5475         set y $idheads($id)
5476     }
5477     set z {}
5478     if {[info exists idotherrefs($id)]} {
5479         set z $idotherrefs($id)
5480     }
5481     return [list $x $y $z]
5482 }
5483
5484 proc showtag {tag isnew} {
5485     global ctext tagcontents tagids linknum
5486
5487     if {$isnew} {
5488         addtohistory [list showtag $tag 0]
5489     }
5490     $ctext conf -state normal
5491     clear_ctext
5492     set linknum 0
5493     if {[info exists tagcontents($tag)]} {
5494         set text $tagcontents($tag)
5495     } else {
5496         set text "Tag: $tag\nId:  $tagids($tag)"
5497     }
5498     appendwithlinks $text {}
5499     $ctext conf -state disabled
5500     init_flist {}
5501 }
5502
5503 proc doquit {} {
5504     global stopped
5505     set stopped 100
5506     destroy .
5507 }
5508
5509 proc doprefs {} {
5510     global maxwidth maxgraphpct diffopts
5511     global oldprefs prefstop showneartags
5512     global bgcolor fgcolor ctext diffcolors
5513
5514     set top .gitkprefs
5515     set prefstop $top
5516     if {[winfo exists $top]} {
5517         raise $top
5518         return
5519     }
5520     foreach v {maxwidth maxgraphpct diffopts showneartags} {
5521         set oldprefs($v) [set $v]
5522     }
5523     toplevel $top
5524     wm title $top "Gitk preferences"
5525     label $top.ldisp -text "Commit list display options"
5526     grid $top.ldisp - -sticky w -pady 10
5527     label $top.spacer -text " "
5528     label $top.maxwidthl -text "Maximum graph width (lines)" \
5529         -font optionfont
5530     spinbox $top.maxwidth -from 0 -to 100 -width 4 -textvariable maxwidth
5531     grid $top.spacer $top.maxwidthl $top.maxwidth -sticky w
5532     label $top.maxpctl -text "Maximum graph width (% of pane)" \
5533         -font optionfont
5534     spinbox $top.maxpct -from 1 -to 100 -width 4 -textvariable maxgraphpct
5535     grid x $top.maxpctl $top.maxpct -sticky w
5536
5537     label $top.ddisp -text "Diff display options"
5538     grid $top.ddisp - -sticky w -pady 10
5539     label $top.diffoptl -text "Options for diff program" \
5540         -font optionfont
5541     entry $top.diffopt -width 20 -textvariable diffopts
5542     grid x $top.diffoptl $top.diffopt -sticky w
5543     frame $top.ntag
5544     label $top.ntag.l -text "Display nearby tags" -font optionfont
5545     checkbutton $top.ntag.b -variable showneartags
5546     pack $top.ntag.b $top.ntag.l -side left
5547     grid x $top.ntag -sticky w
5548
5549     label $top.cdisp -text "Colors: press to choose"
5550     grid $top.cdisp - -sticky w -pady 10
5551     label $top.bg -padx 40 -relief sunk -background $bgcolor
5552     button $top.bgbut -text "Background" -font optionfont \
5553         -command [list choosecolor bgcolor 0 $top.bg background setbg]
5554     grid x $top.bgbut $top.bg -sticky w
5555     label $top.fg -padx 40 -relief sunk -background $fgcolor
5556     button $top.fgbut -text "Foreground" -font optionfont \
5557         -command [list choosecolor fgcolor 0 $top.fg foreground setfg]
5558     grid x $top.fgbut $top.fg -sticky w
5559     label $top.diffold -padx 40 -relief sunk -background [lindex $diffcolors 0]
5560     button $top.diffoldbut -text "Diff: old lines" -font optionfont \
5561         -command [list choosecolor diffcolors 0 $top.diffold "diff old lines" \
5562                       [list $ctext tag conf d0 -foreground]]
5563     grid x $top.diffoldbut $top.diffold -sticky w
5564     label $top.diffnew -padx 40 -relief sunk -background [lindex $diffcolors 1]
5565     button $top.diffnewbut -text "Diff: new lines" -font optionfont \
5566         -command [list choosecolor diffcolors 1 $top.diffnew "diff new lines" \
5567                       [list $ctext tag conf d1 -foreground]]
5568     grid x $top.diffnewbut $top.diffnew -sticky w
5569     label $top.hunksep -padx 40 -relief sunk -background [lindex $diffcolors 2]
5570     button $top.hunksepbut -text "Diff: hunk header" -font optionfont \
5571         -command [list choosecolor diffcolors 2 $top.hunksep \
5572                       "diff hunk header" \
5573                       [list $ctext tag conf hunksep -foreground]]
5574     grid x $top.hunksepbut $top.hunksep -sticky w
5575
5576     frame $top.buts
5577     button $top.buts.ok -text "OK" -command prefsok
5578     button $top.buts.can -text "Cancel" -command prefscan
5579     grid $top.buts.ok $top.buts.can
5580     grid columnconfigure $top.buts 0 -weight 1 -uniform a
5581     grid columnconfigure $top.buts 1 -weight 1 -uniform a
5582     grid $top.buts - - -pady 10 -sticky ew
5583 }
5584
5585 proc choosecolor {v vi w x cmd} {
5586     global $v
5587
5588     set c [tk_chooseColor -initialcolor [lindex [set $v] $vi] \
5589                -title "Gitk: choose color for $x"]
5590     if {$c eq {}} return
5591     $w conf -background $c
5592     lset $v $vi $c
5593     eval $cmd $c
5594 }
5595
5596 proc setbg {c} {
5597     global bglist
5598
5599     foreach w $bglist {
5600         $w conf -background $c
5601     }
5602 }
5603
5604 proc setfg {c} {
5605     global fglist canv
5606
5607     foreach w $fglist {
5608         $w conf -foreground $c
5609     }
5610     allcanvs itemconf text -fill $c
5611     $canv itemconf circle -outline $c
5612 }
5613
5614 proc prefscan {} {
5615     global maxwidth maxgraphpct diffopts
5616     global oldprefs prefstop showneartags
5617
5618     foreach v {maxwidth maxgraphpct diffopts showneartags} {
5619         set $v $oldprefs($v)
5620     }
5621     catch {destroy $prefstop}
5622     unset prefstop
5623 }
5624
5625 proc prefsok {} {
5626     global maxwidth maxgraphpct
5627     global oldprefs prefstop showneartags
5628
5629     catch {destroy $prefstop}
5630     unset prefstop
5631     if {$maxwidth != $oldprefs(maxwidth)
5632         || $maxgraphpct != $oldprefs(maxgraphpct)} {
5633         redisplay
5634     } elseif {$showneartags != $oldprefs(showneartags)} {
5635         reselectline
5636     }
5637 }
5638
5639 proc formatdate {d} {
5640     return [clock format $d -format "%Y-%m-%d %H:%M:%S"]
5641 }
5642
5643 # This list of encoding names and aliases is distilled from
5644 # http://www.iana.org/assignments/character-sets.
5645 # Not all of them are supported by Tcl.
5646 set encoding_aliases {
5647     { ANSI_X3.4-1968 iso-ir-6 ANSI_X3.4-1986 ISO_646.irv:1991 ASCII
5648       ISO646-US US-ASCII us IBM367 cp367 csASCII }
5649     { ISO-10646-UTF-1 csISO10646UTF1 }
5650     { ISO_646.basic:1983 ref csISO646basic1983 }
5651     { INVARIANT csINVARIANT }
5652     { ISO_646.irv:1983 iso-ir-2 irv csISO2IntlRefVersion }
5653     { BS_4730 iso-ir-4 ISO646-GB gb uk csISO4UnitedKingdom }
5654     { NATS-SEFI iso-ir-8-1 csNATSSEFI }
5655     { NATS-SEFI-ADD iso-ir-8-2 csNATSSEFIADD }
5656     { NATS-DANO iso-ir-9-1 csNATSDANO }
5657     { NATS-DANO-ADD iso-ir-9-2 csNATSDANOADD }
5658     { SEN_850200_B iso-ir-10 FI ISO646-FI ISO646-SE se csISO10Swedish }
5659     { SEN_850200_C iso-ir-11 ISO646-SE2 se2 csISO11SwedishForNames }
5660     { KS_C_5601-1987 iso-ir-149 KS_C_5601-1989 KSC_5601 korean csKSC56011987 }
5661     { ISO-2022-KR csISO2022KR }
5662     { EUC-KR csEUCKR }
5663     { ISO-2022-JP csISO2022JP }
5664     { ISO-2022-JP-2 csISO2022JP2 }
5665     { JIS_C6220-1969-jp JIS_C6220-1969 iso-ir-13 katakana x0201-7
5666       csISO13JISC6220jp }
5667     { JIS_C6220-1969-ro iso-ir-14 jp ISO646-JP csISO14JISC6220ro }
5668     { IT iso-ir-15 ISO646-IT csISO15Italian }
5669     { PT iso-ir-16 ISO646-PT csISO16Portuguese }
5670     { ES iso-ir-17 ISO646-ES csISO17Spanish }
5671     { greek7-old iso-ir-18 csISO18Greek7Old }
5672     { latin-greek iso-ir-19 csISO19LatinGreek }
5673     { DIN_66003 iso-ir-21 de ISO646-DE csISO21German }
5674     { NF_Z_62-010_(1973) iso-ir-25 ISO646-FR1 csISO25French }
5675     { Latin-greek-1 iso-ir-27 csISO27LatinGreek1 }
5676     { ISO_5427 iso-ir-37 csISO5427Cyrillic }
5677     { JIS_C6226-1978 iso-ir-42 csISO42JISC62261978 }
5678     { BS_viewdata iso-ir-47 csISO47BSViewdata }
5679     { INIS iso-ir-49 csISO49INIS }
5680     { INIS-8 iso-ir-50 csISO50INIS8 }
5681     { INIS-cyrillic iso-ir-51 csISO51INISCyrillic }
5682     { ISO_5427:1981 iso-ir-54 ISO5427Cyrillic1981 }
5683     { ISO_5428:1980 iso-ir-55 csISO5428Greek }
5684     { GB_1988-80 iso-ir-57 cn ISO646-CN csISO57GB1988 }
5685     { GB_2312-80 iso-ir-58 chinese csISO58GB231280 }
5686     { NS_4551-1 iso-ir-60 ISO646-NO no csISO60DanishNorwegian
5687       csISO60Norwegian1 }
5688     { NS_4551-2 ISO646-NO2 iso-ir-61 no2 csISO61Norwegian2 }
5689     { NF_Z_62-010 iso-ir-69 ISO646-FR fr csISO69French }
5690     { videotex-suppl iso-ir-70 csISO70VideotexSupp1 }
5691     { PT2 iso-ir-84 ISO646-PT2 csISO84Portuguese2 }
5692     { ES2 iso-ir-85 ISO646-ES2 csISO85Spanish2 }
5693     { MSZ_7795.3 iso-ir-86 ISO646-HU hu csISO86Hungarian }
5694     { JIS_C6226-1983 iso-ir-87 x0208 JIS_X0208-1983 csISO87JISX0208 }
5695     { greek7 iso-ir-88 csISO88Greek7 }
5696     { ASMO_449 ISO_9036 arabic7 iso-ir-89 csISO89ASMO449 }
5697     { iso-ir-90 csISO90 }
5698     { JIS_C6229-1984-a iso-ir-91 jp-ocr-a csISO91JISC62291984a }
5699     { JIS_C6229-1984-b iso-ir-92 ISO646-JP-OCR-B jp-ocr-b
5700       csISO92JISC62991984b }
5701     { JIS_C6229-1984-b-add iso-ir-93 jp-ocr-b-add csISO93JIS62291984badd }
5702     { JIS_C6229-1984-hand iso-ir-94 jp-ocr-hand csISO94JIS62291984hand }
5703     { JIS_C6229-1984-hand-add iso-ir-95 jp-ocr-hand-add
5704       csISO95JIS62291984handadd }
5705     { JIS_C6229-1984-kana iso-ir-96 csISO96JISC62291984kana }
5706     { ISO_2033-1983 iso-ir-98 e13b csISO2033 }
5707     { ANSI_X3.110-1983 iso-ir-99 CSA_T500-1983 NAPLPS csISO99NAPLPS }
5708     { ISO_8859-1:1987 iso-ir-100 ISO_8859-1 ISO-8859-1 latin1 l1 IBM819
5709       CP819 csISOLatin1 }
5710     { ISO_8859-2:1987 iso-ir-101 ISO_8859-2 ISO-8859-2 latin2 l2 csISOLatin2 }
5711     { T.61-7bit iso-ir-102 csISO102T617bit }
5712     { T.61-8bit T.61 iso-ir-103 csISO103T618bit }
5713     { ISO_8859-3:1988 iso-ir-109 ISO_8859-3 ISO-8859-3 latin3 l3 csISOLatin3 }
5714     { ISO_8859-4:1988 iso-ir-110 ISO_8859-4 ISO-8859-4 latin4 l4 csISOLatin4 }
5715     { ECMA-cyrillic iso-ir-111 KOI8-E csISO111ECMACyrillic }
5716     { CSA_Z243.4-1985-1 iso-ir-121 ISO646-CA csa7-1 ca csISO121Canadian1 }
5717     { CSA_Z243.4-1985-2 iso-ir-122 ISO646-CA2 csa7-2 csISO122Canadian2 }
5718     { CSA_Z243.4-1985-gr iso-ir-123 csISO123CSAZ24341985gr }
5719     { ISO_8859-6:1987 iso-ir-127 ISO_8859-6 ISO-8859-6 ECMA-114 ASMO-708
5720       arabic csISOLatinArabic }
5721     { ISO_8859-6-E csISO88596E ISO-8859-6-E }
5722     { ISO_8859-6-I csISO88596I ISO-8859-6-I }
5723     { ISO_8859-7:1987 iso-ir-126 ISO_8859-7 ISO-8859-7 ELOT_928 ECMA-118
5724       greek greek8 csISOLatinGreek }
5725     { T.101-G2 iso-ir-128 csISO128T101G2 }
5726     { ISO_8859-8:1988 iso-ir-138 ISO_8859-8 ISO-8859-8 hebrew
5727       csISOLatinHebrew }
5728     { ISO_8859-8-E csISO88598E ISO-8859-8-E }
5729     { ISO_8859-8-I csISO88598I ISO-8859-8-I }
5730     { CSN_369103 iso-ir-139 csISO139CSN369103 }
5731     { JUS_I.B1.002 iso-ir-141 ISO646-YU js yu csISO141JUSIB1002 }
5732     { ISO_6937-2-add iso-ir-142 csISOTextComm }
5733     { IEC_P27-1 iso-ir-143 csISO143IECP271 }
5734     { ISO_8859-5:1988 iso-ir-144 ISO_8859-5 ISO-8859-5 cyrillic
5735       csISOLatinCyrillic }
5736     { JUS_I.B1.003-serb iso-ir-146 serbian csISO146Serbian }
5737     { JUS_I.B1.003-mac macedonian iso-ir-147 csISO147Macedonian }
5738     { ISO_8859-9:1989 iso-ir-148 ISO_8859-9 ISO-8859-9 latin5 l5 csISOLatin5 }
5739     { greek-ccitt iso-ir-150 csISO150 csISO150GreekCCITT }
5740     { NC_NC00-10:81 cuba iso-ir-151 ISO646-CU csISO151Cuba }
5741     { ISO_6937-2-25 iso-ir-152 csISO6937Add }
5742     { GOST_19768-74 ST_SEV_358-88 iso-ir-153 csISO153GOST1976874 }
5743     { ISO_8859-supp iso-ir-154 latin1-2-5 csISO8859Supp }
5744     { ISO_10367-box iso-ir-155 csISO10367Box }
5745     { ISO-8859-10 iso-ir-157 l6 ISO_8859-10:1992 csISOLatin6 latin6 }
5746     { latin-lap lap iso-ir-158 csISO158Lap }
5747     { JIS_X0212-1990 x0212 iso-ir-159 csISO159JISX02121990 }
5748     { DS_2089 DS2089 ISO646-DK dk csISO646Danish }
5749     { us-dk csUSDK }
5750     { dk-us csDKUS }
5751     { JIS_X0201 X0201 csHalfWidthKatakana }
5752     { KSC5636 ISO646-KR csKSC5636 }
5753     { ISO-10646-UCS-2 csUnicode }
5754     { ISO-10646-UCS-4 csUCS4 }
5755     { DEC-MCS dec csDECMCS }
5756     { hp-roman8 roman8 r8 csHPRoman8 }
5757     { macintosh mac csMacintosh }
5758     { IBM037 cp037 ebcdic-cp-us ebcdic-cp-ca ebcdic-cp-wt ebcdic-cp-nl
5759       csIBM037 }
5760     { IBM038 EBCDIC-INT cp038 csIBM038 }
5761     { IBM273 CP273 csIBM273 }
5762     { IBM274 EBCDIC-BE CP274 csIBM274 }
5763     { IBM275 EBCDIC-BR cp275 csIBM275 }
5764     { IBM277 EBCDIC-CP-DK EBCDIC-CP-NO csIBM277 }
5765     { IBM278 CP278 ebcdic-cp-fi ebcdic-cp-se csIBM278 }
5766     { IBM280 CP280 ebcdic-cp-it csIBM280 }
5767     { IBM281 EBCDIC-JP-E cp281 csIBM281 }
5768     { IBM284 CP284 ebcdic-cp-es csIBM284 }
5769     { IBM285 CP285 ebcdic-cp-gb csIBM285 }
5770     { IBM290 cp290 EBCDIC-JP-kana csIBM290 }
5771     { IBM297 cp297 ebcdic-cp-fr csIBM297 }
5772     { IBM420 cp420 ebcdic-cp-ar1 csIBM420 }
5773     { IBM423 cp423 ebcdic-cp-gr csIBM423 }
5774     { IBM424 cp424 ebcdic-cp-he csIBM424 }
5775     { IBM437 cp437 437 csPC8CodePage437 }
5776     { IBM500 CP500 ebcdic-cp-be ebcdic-cp-ch csIBM500 }
5777     { IBM775 cp775 csPC775Baltic }
5778     { IBM850 cp850 850 csPC850Multilingual }
5779     { IBM851 cp851 851 csIBM851 }
5780     { IBM852 cp852 852 csPCp852 }
5781     { IBM855 cp855 855 csIBM855 }
5782     { IBM857 cp857 857 csIBM857 }
5783     { IBM860 cp860 860 csIBM860 }
5784     { IBM861 cp861 861 cp-is csIBM861 }
5785     { IBM862 cp862 862 csPC862LatinHebrew }
5786     { IBM863 cp863 863 csIBM863 }
5787     { IBM864 cp864 csIBM864 }
5788     { IBM865 cp865 865 csIBM865 }
5789     { IBM866 cp866 866 csIBM866 }
5790     { IBM868 CP868 cp-ar csIBM868 }
5791     { IBM869 cp869 869 cp-gr csIBM869 }
5792     { IBM870 CP870 ebcdic-cp-roece ebcdic-cp-yu csIBM870 }
5793     { IBM871 CP871 ebcdic-cp-is csIBM871 }
5794     { IBM880 cp880 EBCDIC-Cyrillic csIBM880 }
5795     { IBM891 cp891 csIBM891 }
5796     { IBM903 cp903 csIBM903 }
5797     { IBM904 cp904 904 csIBBM904 }
5798     { IBM905 CP905 ebcdic-cp-tr csIBM905 }
5799     { IBM918 CP918 ebcdic-cp-ar2 csIBM918 }
5800     { IBM1026 CP1026 csIBM1026 }
5801     { EBCDIC-AT-DE csIBMEBCDICATDE }
5802     { EBCDIC-AT-DE-A csEBCDICATDEA }
5803     { EBCDIC-CA-FR csEBCDICCAFR }
5804     { EBCDIC-DK-NO csEBCDICDKNO }
5805     { EBCDIC-DK-NO-A csEBCDICDKNOA }
5806     { EBCDIC-FI-SE csEBCDICFISE }
5807     { EBCDIC-FI-SE-A csEBCDICFISEA }
5808     { EBCDIC-FR csEBCDICFR }
5809     { EBCDIC-IT csEBCDICIT }
5810     { EBCDIC-PT csEBCDICPT }
5811     { EBCDIC-ES csEBCDICES }
5812     { EBCDIC-ES-A csEBCDICESA }
5813     { EBCDIC-ES-S csEBCDICESS }
5814     { EBCDIC-UK csEBCDICUK }
5815     { EBCDIC-US csEBCDICUS }
5816     { UNKNOWN-8BIT csUnknown8BiT }
5817     { MNEMONIC csMnemonic }
5818     { MNEM csMnem }
5819     { VISCII csVISCII }
5820     { VIQR csVIQR }
5821     { KOI8-R csKOI8R }
5822     { IBM00858 CCSID00858 CP00858 PC-Multilingual-850+euro }
5823     { IBM00924 CCSID00924 CP00924 ebcdic-Latin9--euro }
5824     { IBM01140 CCSID01140 CP01140 ebcdic-us-37+euro }
5825     { IBM01141 CCSID01141 CP01141 ebcdic-de-273+euro }
5826     { IBM01142 CCSID01142 CP01142 ebcdic-dk-277+euro ebcdic-no-277+euro }
5827     { IBM01143 CCSID01143 CP01143 ebcdic-fi-278+euro ebcdic-se-278+euro }
5828     { IBM01144 CCSID01144 CP01144 ebcdic-it-280+euro }
5829     { IBM01145 CCSID01145 CP01145 ebcdic-es-284+euro }
5830     { IBM01146 CCSID01146 CP01146 ebcdic-gb-285+euro }
5831     { IBM01147 CCSID01147 CP01147 ebcdic-fr-297+euro }
5832     { IBM01148 CCSID01148 CP01148 ebcdic-international-500+euro }
5833     { IBM01149 CCSID01149 CP01149 ebcdic-is-871+euro }
5834     { IBM1047 IBM-1047 }
5835     { PTCP154 csPTCP154 PT154 CP154 Cyrillic-Asian }
5836     { Amiga-1251 Ami1251 Amiga1251 Ami-1251 }
5837     { UNICODE-1-1 csUnicode11 }
5838     { CESU-8 csCESU-8 }
5839     { BOCU-1 csBOCU-1 }
5840     { UNICODE-1-1-UTF-7 csUnicode11UTF7 }
5841     { ISO-8859-14 iso-ir-199 ISO_8859-14:1998 ISO_8859-14 latin8 iso-celtic
5842       l8 }
5843     { ISO-8859-15 ISO_8859-15 Latin-9 }
5844     { ISO-8859-16 iso-ir-226 ISO_8859-16:2001 ISO_8859-16 latin10 l10 }
5845     { GBK CP936 MS936 windows-936 }
5846     { JIS_Encoding csJISEncoding }
5847     { Shift_JIS MS_Kanji csShiftJIS }
5848     { Extended_UNIX_Code_Packed_Format_for_Japanese csEUCPkdFmtJapanese
5849       EUC-JP }
5850     { Extended_UNIX_Code_Fixed_Width_for_Japanese csEUCFixWidJapanese }
5851     { ISO-10646-UCS-Basic csUnicodeASCII }
5852     { ISO-10646-Unicode-Latin1 csUnicodeLatin1 ISO-10646 }
5853     { ISO-Unicode-IBM-1261 csUnicodeIBM1261 }
5854     { ISO-Unicode-IBM-1268 csUnicodeIBM1268 }
5855     { ISO-Unicode-IBM-1276 csUnicodeIBM1276 }
5856     { ISO-Unicode-IBM-1264 csUnicodeIBM1264 }
5857     { ISO-Unicode-IBM-1265 csUnicodeIBM1265 }
5858     { ISO-8859-1-Windows-3.0-Latin-1 csWindows30Latin1 }
5859     { ISO-8859-1-Windows-3.1-Latin-1 csWindows31Latin1 }
5860     { ISO-8859-2-Windows-Latin-2 csWindows31Latin2 }
5861     { ISO-8859-9-Windows-Latin-5 csWindows31Latin5 }
5862     { Adobe-Standard-Encoding csAdobeStandardEncoding }
5863     { Ventura-US csVenturaUS }
5864     { Ventura-International csVenturaInternational }
5865     { PC8-Danish-Norwegian csPC8DanishNorwegian }
5866     { PC8-Turkish csPC8Turkish }
5867     { IBM-Symbols csIBMSymbols }
5868     { IBM-Thai csIBMThai }
5869     { HP-Legal csHPLegal }
5870     { HP-Pi-font csHPPiFont }
5871     { HP-Math8 csHPMath8 }
5872     { Adobe-Symbol-Encoding csHPPSMath }
5873     { HP-DeskTop csHPDesktop }
5874     { Ventura-Math csVenturaMath }
5875     { Microsoft-Publishing csMicrosoftPublishing }
5876     { Windows-31J csWindows31J }
5877     { GB2312 csGB2312 }
5878     { Big5 csBig5 }
5879 }
5880
5881 proc tcl_encoding {enc} {
5882     global encoding_aliases
5883     set names [encoding names]
5884     set lcnames [string tolower $names]
5885     set enc [string tolower $enc]
5886     set i [lsearch -exact $lcnames $enc]
5887     if {$i < 0} {
5888         # look for "isonnn" instead of "iso-nnn" or "iso_nnn"
5889         if {[regsub {^iso[-_]} $enc iso encx]} {
5890             set i [lsearch -exact $lcnames $encx]
5891         }
5892     }
5893     if {$i < 0} {
5894         foreach l $encoding_aliases {
5895             set ll [string tolower $l]
5896             if {[lsearch -exact $ll $enc] < 0} continue
5897             # look through the aliases for one that tcl knows about
5898             foreach e $ll {
5899                 set i [lsearch -exact $lcnames $e]
5900                 if {$i < 0} {
5901                     if {[regsub {^iso[-_]} $e iso ex]} {
5902                         set i [lsearch -exact $lcnames $ex]
5903                     }
5904                 }
5905                 if {$i >= 0} break
5906             }
5907             break
5908         }
5909     }
5910     if {$i >= 0} {
5911         return [lindex $names $i]
5912     }
5913     return {}
5914 }
5915
5916 # defaults...
5917 set datemode 0
5918 set diffopts "-U 5 -p"
5919 set wrcomcmd "git diff-tree --stdin -p --pretty"
5920
5921 set gitencoding {}
5922 catch {
5923     set gitencoding [exec git repo-config --get i18n.commitencoding]
5924 }
5925 if {$gitencoding == ""} {
5926     set gitencoding "utf-8"
5927 }
5928 set tclencoding [tcl_encoding $gitencoding]
5929 if {$tclencoding == {}} {
5930     puts stderr "Warning: encoding $gitencoding is not supported by Tcl/Tk"
5931 }
5932
5933 set mainfont {Helvetica 9}
5934 set textfont {Courier 9}
5935 set uifont {Helvetica 9 bold}
5936 set findmergefiles 0
5937 set maxgraphpct 50
5938 set maxwidth 16
5939 set revlistorder 0
5940 set fastdate 0
5941 set uparrowlen 7
5942 set downarrowlen 7
5943 set mingaplen 30
5944 set cmitmode "patch"
5945 set wrapcomment "none"
5946 set showneartags 1
5947
5948 set colors {green red blue magenta darkgrey brown orange}
5949 set bgcolor white
5950 set fgcolor black
5951 set diffcolors {red "#00a000" blue}
5952
5953 catch {source ~/.gitk}
5954
5955 font create optionfont -family sans-serif -size -12
5956
5957 set revtreeargs {}
5958 foreach arg $argv {
5959     switch -regexp -- $arg {
5960         "^$" { }
5961         "^-d" { set datemode 1 }
5962         default {
5963             lappend revtreeargs $arg
5964         }
5965     }
5966 }
5967
5968 # check that we can find a .git directory somewhere...
5969 set gitdir [gitdir]
5970 if {![file isdirectory $gitdir]} {
5971     show_error {} . "Cannot find the git directory \"$gitdir\"."
5972     exit 1
5973 }
5974
5975 set cmdline_files {}
5976 set i [lsearch -exact $revtreeargs "--"]
5977 if {$i >= 0} {
5978     set cmdline_files [lrange $revtreeargs [expr {$i + 1}] end]
5979     set revtreeargs [lrange $revtreeargs 0 [expr {$i - 1}]]
5980 } elseif {$revtreeargs ne {}} {
5981     if {[catch {
5982         set f [eval exec git rev-parse --no-revs --no-flags $revtreeargs]
5983         set cmdline_files [split $f "\n"]
5984         set n [llength $cmdline_files]
5985         set revtreeargs [lrange $revtreeargs 0 end-$n]
5986     } err]} {
5987         # unfortunately we get both stdout and stderr in $err,
5988         # so look for "fatal:".
5989         set i [string first "fatal:" $err]
5990         if {$i > 0} {
5991             set err [string range $err [expr {$i + 6}] end]
5992         }
5993         show_error {} . "Bad arguments to gitk:\n$err"
5994         exit 1
5995     }
5996 }
5997
5998 set history {}
5999 set historyindex 0
6000 set fh_serial 0
6001 set nhl_names {}
6002 set highlight_paths {}
6003 set searchdirn -forwards
6004 set boldrows {}
6005 set boldnamerows {}
6006
6007 set optim_delay 16
6008
6009 set nextviewnum 1
6010 set curview 0
6011 set selectedview 0
6012 set selectedhlview None
6013 set viewfiles(0) {}
6014 set viewperm(0) 0
6015 set viewargs(0) {}
6016
6017 set cmdlineok 0
6018 set stopped 0
6019 set stuffsaved 0
6020 set patchnum 0
6021 setcoords
6022 makewindow
6023 readrefs
6024
6025 if {$cmdline_files ne {} || $revtreeargs ne {}} {
6026     # create a view for the files/dirs specified on the command line
6027     set curview 1
6028     set selectedview 1
6029     set nextviewnum 2
6030     set viewname(1) "Command line"
6031     set viewfiles(1) $cmdline_files
6032     set viewargs(1) $revtreeargs
6033     set viewperm(1) 0
6034     addviewmenu 1
6035     .bar.view entryconf 2 -state normal
6036     .bar.view entryconf 3 -state normal
6037 }
6038
6039 if {[info exists permviews]} {
6040     foreach v $permviews {
6041         set n $nextviewnum
6042         incr nextviewnum
6043         set viewname($n) [lindex $v 0]
6044         set viewfiles($n) [lindex $v 1]
6045         set viewargs($n) [lindex $v 2]
6046         set viewperm($n) 1
6047         addviewmenu $n
6048     }
6049 }
6050 getcommits