gitk

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