git.oblomov.eu Git - git/blob - gitk

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