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