gitk

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