1f13f7f9b20ae0d1af0ab68ec089660f83473714
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5set appvers {@@GIT_VERSION@@}
   6set copyright {
   7Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
   8
   9This program is free software; you can redistribute it and/or modify
  10it under the terms of the GNU General Public License as published by
  11the Free Software Foundation; either version 2 of the License, or
  12(at your option) any later version.
  13
  14This program is distributed in the hope that it will be useful,
  15but WITHOUT ANY WARRANTY; without even the implied warranty of
  16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17GNU General Public License for more details.
  18
  19You should have received a copy of the GNU General Public License
  20along with this program; if not, write to the Free Software
  21Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  22
  23######################################################################
  24##
  25## read only globals
  26
  27set _appname [lindex [file split $argv0] end]
  28set _gitdir {}
  29set _gitexec {}
  30set _reponame {}
  31set _iscygwin {}
  32
  33proc appname {} {
  34        global _appname
  35        return $_appname
  36}
  37
  38proc gitdir {args} {
  39        global _gitdir
  40        if {$args eq {}} {
  41                return $_gitdir
  42        }
  43        return [eval [concat [list file join $_gitdir] $args]]
  44}
  45
  46proc gitexec {args} {
  47        global _gitexec
  48        if {$_gitexec eq {}} {
  49                if {[catch {set _gitexec [exec git --exec-path]} err]} {
  50                        error "Git not installed?\n\n$err"
  51                }
  52        }
  53        if {$args eq {}} {
  54                return $_gitexec
  55        }
  56        return [eval [concat [list file join $_gitexec] $args]]
  57}
  58
  59proc reponame {} {
  60        global _reponame
  61        return $_reponame
  62}
  63
  64proc is_MacOSX {} {
  65        global tcl_platform tk_library
  66        if {[tk windowingsystem] eq {aqua}} {
  67                return 1
  68        }
  69        return 0
  70}
  71
  72proc is_Windows {} {
  73        global tcl_platform
  74        if {$tcl_platform(platform) eq {windows}} {
  75                return 1
  76        }
  77        return 0
  78}
  79
  80proc is_Cygwin {} {
  81        global tcl_platform _iscygwin
  82        if {$_iscygwin eq {}} {
  83                if {$tcl_platform(platform) eq {windows}} {
  84                        if {[catch {set p [exec cygpath --windir]} err]} {
  85                                set _iscygwin 0
  86                        } else {
  87                                set _iscygwin 1
  88                        }
  89                } else {
  90                        set _iscygwin 0
  91                }
  92        }
  93        return $_iscygwin
  94}
  95
  96######################################################################
  97##
  98## config
  99
 100proc is_many_config {name} {
 101        switch -glob -- $name {
 102        remote.*.fetch -
 103        remote.*.push
 104                {return 1}
 105        *
 106                {return 0}
 107        }
 108}
 109
 110proc is_config_true {name} {
 111        global repo_config
 112        if {[catch {set v $repo_config($name)}]} {
 113                return 0
 114        } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 115                return 1
 116        } else {
 117                return 0
 118        }
 119}
 120
 121proc load_config {include_global} {
 122        global repo_config global_config default_config
 123
 124        array unset global_config
 125        if {$include_global} {
 126                catch {
 127                        set fd_rc [open "| git repo-config --global --list" r]
 128                        while {[gets $fd_rc line] >= 0} {
 129                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 130                                        if {[is_many_config $name]} {
 131                                                lappend global_config($name) $value
 132                                        } else {
 133                                                set global_config($name) $value
 134                                        }
 135                                }
 136                        }
 137                        close $fd_rc
 138                }
 139        }
 140
 141        array unset repo_config
 142        catch {
 143                set fd_rc [open "| git repo-config --list" r]
 144                while {[gets $fd_rc line] >= 0} {
 145                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 146                                if {[is_many_config $name]} {
 147                                        lappend repo_config($name) $value
 148                                } else {
 149                                        set repo_config($name) $value
 150                                }
 151                        }
 152                }
 153                close $fd_rc
 154        }
 155
 156        foreach name [array names default_config] {
 157                if {[catch {set v $global_config($name)}]} {
 158                        set global_config($name) $default_config($name)
 159                }
 160                if {[catch {set v $repo_config($name)}]} {
 161                        set repo_config($name) $default_config($name)
 162                }
 163        }
 164}
 165
 166proc save_config {} {
 167        global default_config font_descs
 168        global repo_config global_config
 169        global repo_config_new global_config_new
 170
 171        foreach option $font_descs {
 172                set name [lindex $option 0]
 173                set font [lindex $option 1]
 174                font configure $font \
 175                        -family $global_config_new(gui.$font^^family) \
 176                        -size $global_config_new(gui.$font^^size)
 177                font configure ${font}bold \
 178                        -family $global_config_new(gui.$font^^family) \
 179                        -size $global_config_new(gui.$font^^size)
 180                set global_config_new(gui.$name) [font configure $font]
 181                unset global_config_new(gui.$font^^family)
 182                unset global_config_new(gui.$font^^size)
 183        }
 184
 185        foreach name [array names default_config] {
 186                set value $global_config_new($name)
 187                if {$value ne $global_config($name)} {
 188                        if {$value eq $default_config($name)} {
 189                                catch {exec git repo-config --global --unset $name}
 190                        } else {
 191                                regsub -all "\[{}\]" $value {"} value
 192                                exec git repo-config --global $name $value
 193                        }
 194                        set global_config($name) $value
 195                        if {$value eq $repo_config($name)} {
 196                                catch {exec git repo-config --unset $name}
 197                                set repo_config($name) $value
 198                        }
 199                }
 200        }
 201
 202        foreach name [array names default_config] {
 203                set value $repo_config_new($name)
 204                if {$value ne $repo_config($name)} {
 205                        if {$value eq $global_config($name)} {
 206                                catch {exec git repo-config --unset $name}
 207                        } else {
 208                                regsub -all "\[{}\]" $value {"} value
 209                                exec git repo-config $name $value
 210                        }
 211                        set repo_config($name) $value
 212                }
 213        }
 214}
 215
 216proc error_popup {msg} {
 217        set title [appname]
 218        if {[reponame] ne {}} {
 219                append title " ([reponame])"
 220        }
 221        set cmd [list tk_messageBox \
 222                -icon error \
 223                -type ok \
 224                -title "$title: error" \
 225                -message $msg]
 226        if {[winfo ismapped .]} {
 227                lappend cmd -parent .
 228        }
 229        eval $cmd
 230}
 231
 232proc warn_popup {msg} {
 233        set title [appname]
 234        if {[reponame] ne {}} {
 235                append title " ([reponame])"
 236        }
 237        set cmd [list tk_messageBox \
 238                -icon warning \
 239                -type ok \
 240                -title "$title: warning" \
 241                -message $msg]
 242        if {[winfo ismapped .]} {
 243                lappend cmd -parent .
 244        }
 245        eval $cmd
 246}
 247
 248proc info_popup {msg {parent .}} {
 249        set title [appname]
 250        if {[reponame] ne {}} {
 251                append title " ([reponame])"
 252        }
 253        tk_messageBox \
 254                -parent $parent \
 255                -icon info \
 256                -type ok \
 257                -title $title \
 258                -message $msg
 259}
 260
 261proc ask_popup {msg} {
 262        set title [appname]
 263        if {[reponame] ne {}} {
 264                append title " ([reponame])"
 265        }
 266        return [tk_messageBox \
 267                -parent . \
 268                -icon question \
 269                -type yesno \
 270                -title $title \
 271                -message $msg]
 272}
 273
 274######################################################################
 275##
 276## repository setup
 277
 278if {   [catch {set _gitdir $env(GIT_DIR)}]
 279        && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
 280        catch {wm withdraw .}
 281        error_popup "Cannot find the git directory:\n\n$err"
 282        exit 1
 283}
 284if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 285        catch {set _gitdir [exec cygpath --unix $_gitdir]}
 286}
 287if {![file isdirectory $_gitdir]} {
 288        catch {wm withdraw .}
 289        error_popup "Git directory not found:\n\n$_gitdir"
 290        exit 1
 291}
 292if {[lindex [file split $_gitdir] end] ne {.git}} {
 293        catch {wm withdraw .}
 294        error_popup "Cannot use funny .git directory:\n\n$_gitdir"
 295        exit 1
 296}
 297if {[catch {cd [file dirname $_gitdir]} err]} {
 298        catch {wm withdraw .}
 299        error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 300        exit 1
 301}
 302set _reponame [lindex [file split \
 303        [file normalize [file dirname $_gitdir]]] \
 304        end]
 305
 306set single_commit 0
 307if {[appname] eq {git-citool}} {
 308        set single_commit 1
 309}
 310
 311######################################################################
 312##
 313## task management
 314
 315set rescan_active 0
 316set diff_active 0
 317set last_clicked {}
 318
 319set disable_on_lock [list]
 320set index_lock_type none
 321
 322proc lock_index {type} {
 323        global index_lock_type disable_on_lock
 324
 325        if {$index_lock_type eq {none}} {
 326                set index_lock_type $type
 327                foreach w $disable_on_lock {
 328                        uplevel #0 $w disabled
 329                }
 330                return 1
 331        } elseif {$index_lock_type eq "begin-$type"} {
 332                set index_lock_type $type
 333                return 1
 334        }
 335        return 0
 336}
 337
 338proc unlock_index {} {
 339        global index_lock_type disable_on_lock
 340
 341        set index_lock_type none
 342        foreach w $disable_on_lock {
 343                uplevel #0 $w normal
 344        }
 345}
 346
 347######################################################################
 348##
 349## status
 350
 351proc repository_state {ctvar hdvar mhvar} {
 352        global current_branch
 353        upvar $ctvar ct $hdvar hd $mhvar mh
 354
 355        set mh [list]
 356
 357        if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
 358                set current_branch {}
 359        } else {
 360                regsub ^refs/((heads|tags|remotes)/)? \
 361                        $current_branch \
 362                        {} \
 363                        current_branch
 364        }
 365
 366        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 367                set hd {}
 368                set ct initial
 369                return
 370        }
 371
 372        set merge_head [gitdir MERGE_HEAD]
 373        if {[file exists $merge_head]} {
 374                set ct merge
 375                set fd_mh [open $merge_head r]
 376                while {[gets $fd_mh line] >= 0} {
 377                        lappend mh $line
 378                }
 379                close $fd_mh
 380                return
 381        }
 382
 383        set ct normal
 384}
 385
 386proc PARENT {} {
 387        global PARENT empty_tree
 388
 389        set p [lindex $PARENT 0]
 390        if {$p ne {}} {
 391                return $p
 392        }
 393        if {$empty_tree eq {}} {
 394                set empty_tree [exec git mktree << {}]
 395        }
 396        return $empty_tree
 397}
 398
 399proc rescan {after {honor_trustmtime 1}} {
 400        global HEAD PARENT MERGE_HEAD commit_type
 401        global ui_index ui_workdir ui_status_value ui_comm
 402        global rescan_active file_states
 403        global repo_config
 404
 405        if {$rescan_active > 0 || ![lock_index read]} return
 406
 407        repository_state newType newHEAD newMERGE_HEAD
 408        if {[string match amend* $commit_type]
 409                && $newType eq {normal}
 410                && $newHEAD eq $HEAD} {
 411        } else {
 412                set HEAD $newHEAD
 413                set PARENT $newHEAD
 414                set MERGE_HEAD $newMERGE_HEAD
 415                set commit_type $newType
 416        }
 417
 418        array unset file_states
 419
 420        if {![$ui_comm edit modified]
 421                || [string trim [$ui_comm get 0.0 end]] eq {}} {
 422                if {[load_message GITGUI_MSG]} {
 423                } elseif {[load_message MERGE_MSG]} {
 424                } elseif {[load_message SQUASH_MSG]} {
 425                }
 426                $ui_comm edit reset
 427                $ui_comm edit modified false
 428        }
 429
 430        if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 431                rescan_stage2 {} $after
 432        } else {
 433                set rescan_active 1
 434                set ui_status_value {Refreshing file status...}
 435                set cmd [list git update-index]
 436                lappend cmd -q
 437                lappend cmd --unmerged
 438                lappend cmd --ignore-missing
 439                lappend cmd --refresh
 440                set fd_rf [open "| $cmd" r]
 441                fconfigure $fd_rf -blocking 0 -translation binary
 442                fileevent $fd_rf readable \
 443                        [list rescan_stage2 $fd_rf $after]
 444        }
 445}
 446
 447proc rescan_stage2 {fd after} {
 448        global ui_status_value
 449        global rescan_active buf_rdi buf_rdf buf_rlo
 450
 451        if {$fd ne {}} {
 452                read $fd
 453                if {![eof $fd]} return
 454                close $fd
 455        }
 456
 457        set ls_others [list | git ls-files --others -z \
 458                --exclude-per-directory=.gitignore]
 459        set info_exclude [gitdir info exclude]
 460        if {[file readable $info_exclude]} {
 461                lappend ls_others "--exclude-from=$info_exclude"
 462        }
 463
 464        set buf_rdi {}
 465        set buf_rdf {}
 466        set buf_rlo {}
 467
 468        set rescan_active 3
 469        set ui_status_value {Scanning for modified files ...}
 470        set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 471        set fd_df [open "| git diff-files -z" r]
 472        set fd_lo [open $ls_others r]
 473
 474        fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 475        fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 476        fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 477        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 478        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 479        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 480}
 481
 482proc load_message {file} {
 483        global ui_comm
 484
 485        set f [gitdir $file]
 486        if {[file isfile $f]} {
 487                if {[catch {set fd [open $f r]}]} {
 488                        return 0
 489                }
 490                set content [string trim [read $fd]]
 491                close $fd
 492                regsub -all -line {[ \r\t]+$} $content {} content
 493                $ui_comm delete 0.0 end
 494                $ui_comm insert end $content
 495                return 1
 496        }
 497        return 0
 498}
 499
 500proc read_diff_index {fd after} {
 501        global buf_rdi
 502
 503        append buf_rdi [read $fd]
 504        set c 0
 505        set n [string length $buf_rdi]
 506        while {$c < $n} {
 507                set z1 [string first "\0" $buf_rdi $c]
 508                if {$z1 == -1} break
 509                incr z1
 510                set z2 [string first "\0" $buf_rdi $z1]
 511                if {$z2 == -1} break
 512
 513                incr c
 514                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 515                set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 516                merge_state \
 517                        [encoding convertfrom $p] \
 518                        [lindex $i 4]? \
 519                        [list [lindex $i 0] [lindex $i 2]] \
 520                        [list]
 521                set c $z2
 522                incr c
 523        }
 524        if {$c < $n} {
 525                set buf_rdi [string range $buf_rdi $c end]
 526        } else {
 527                set buf_rdi {}
 528        }
 529
 530        rescan_done $fd buf_rdi $after
 531}
 532
 533proc read_diff_files {fd after} {
 534        global buf_rdf
 535
 536        append buf_rdf [read $fd]
 537        set c 0
 538        set n [string length $buf_rdf]
 539        while {$c < $n} {
 540                set z1 [string first "\0" $buf_rdf $c]
 541                if {$z1 == -1} break
 542                incr z1
 543                set z2 [string first "\0" $buf_rdf $z1]
 544                if {$z2 == -1} break
 545
 546                incr c
 547                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 548                set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 549                merge_state \
 550                        [encoding convertfrom $p] \
 551                        ?[lindex $i 4] \
 552                        [list] \
 553                        [list [lindex $i 0] [lindex $i 2]]
 554                set c $z2
 555                incr c
 556        }
 557        if {$c < $n} {
 558                set buf_rdf [string range $buf_rdf $c end]
 559        } else {
 560                set buf_rdf {}
 561        }
 562
 563        rescan_done $fd buf_rdf $after
 564}
 565
 566proc read_ls_others {fd after} {
 567        global buf_rlo
 568
 569        append buf_rlo [read $fd]
 570        set pck [split $buf_rlo "\0"]
 571        set buf_rlo [lindex $pck end]
 572        foreach p [lrange $pck 0 end-1] {
 573                merge_state [encoding convertfrom $p] ?O
 574        }
 575        rescan_done $fd buf_rlo $after
 576}
 577
 578proc rescan_done {fd buf after} {
 579        global rescan_active
 580        global file_states repo_config
 581        upvar $buf to_clear
 582
 583        if {![eof $fd]} return
 584        set to_clear {}
 585        close $fd
 586        if {[incr rescan_active -1] > 0} return
 587
 588        prune_selection
 589        unlock_index
 590        display_all_files
 591        reshow_diff
 592        uplevel #0 $after
 593}
 594
 595proc prune_selection {} {
 596        global file_states selected_paths
 597
 598        foreach path [array names selected_paths] {
 599                if {[catch {set still_here $file_states($path)}]} {
 600                        unset selected_paths($path)
 601                }
 602        }
 603}
 604
 605######################################################################
 606##
 607## diff
 608
 609proc clear_diff {} {
 610        global ui_diff current_diff_path current_diff_header
 611        global ui_index ui_workdir
 612
 613        $ui_diff conf -state normal
 614        $ui_diff delete 0.0 end
 615        $ui_diff conf -state disabled
 616
 617        set current_diff_path {}
 618        set current_diff_header {}
 619
 620        $ui_index tag remove in_diff 0.0 end
 621        $ui_workdir tag remove in_diff 0.0 end
 622}
 623
 624proc reshow_diff {} {
 625        global ui_status_value file_states file_lists
 626        global current_diff_path current_diff_side
 627
 628        set p $current_diff_path
 629        if {$p eq {}
 630                || $current_diff_side eq {}
 631                || [catch {set s $file_states($p)}]
 632                || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
 633                clear_diff
 634        } else {
 635                show_diff $p $current_diff_side
 636        }
 637}
 638
 639proc handle_empty_diff {} {
 640        global current_diff_path file_states file_lists
 641
 642        set path $current_diff_path
 643        set s $file_states($path)
 644        if {[lindex $s 0] ne {_M}} return
 645
 646        info_popup "No differences detected.
 647
 648[short_path $path] has no changes.
 649
 650The modification date of this file was updated
 651by another application, but the content within
 652the file was not changed.
 653
 654A rescan will be automatically started to find
 655other files which may have the same state."
 656
 657        clear_diff
 658        display_file $path __
 659        rescan {set ui_status_value {Ready.}} 0
 660}
 661
 662proc show_diff {path w {lno {}}} {
 663        global file_states file_lists
 664        global is_3way_diff diff_active repo_config
 665        global ui_diff ui_status_value ui_index ui_workdir
 666        global current_diff_path current_diff_side current_diff_header
 667
 668        if {$diff_active || ![lock_index read]} return
 669
 670        clear_diff
 671        if {$lno == {}} {
 672                set lno [lsearch -sorted -exact $file_lists($w) $path]
 673                if {$lno >= 0} {
 674                        incr lno
 675                }
 676        }
 677        if {$lno >= 1} {
 678                $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 679        }
 680
 681        set s $file_states($path)
 682        set m [lindex $s 0]
 683        set is_3way_diff 0
 684        set diff_active 1
 685        set current_diff_path $path
 686        set current_diff_side $w
 687        set current_diff_header {}
 688        set ui_status_value "Loading diff of [escape_path $path]..."
 689
 690        # - Git won't give us the diff, there's nothing to compare to!
 691        #
 692        if {$m eq {_O}} {
 693                set max_sz [expr {128 * 1024}]
 694                if {[catch {
 695                                set fd [open $path r]
 696                                set content [read $fd $max_sz]
 697                                close $fd
 698                                set sz [file size $path]
 699                        } err ]} {
 700                        set diff_active 0
 701                        unlock_index
 702                        set ui_status_value "Unable to display [escape_path $path]"
 703                        error_popup "Error loading file:\n\n$err"
 704                        return
 705                }
 706                $ui_diff conf -state normal
 707                if {![catch {set type [exec file $path]}]} {
 708                        set n [string length $path]
 709                        if {[string equal -length $n $path $type]} {
 710                                set type [string range $type $n end]
 711                                regsub {^:?\s*} $type {} type
 712                        }
 713                        $ui_diff insert end "* $type\n" d_@
 714                }
 715                if {[string first "\0" $content] != -1} {
 716                        $ui_diff insert end \
 717                                "* Binary file (not showing content)." \
 718                                d_@
 719                } else {
 720                        if {$sz > $max_sz} {
 721                                $ui_diff insert end \
 722"* Untracked file is $sz bytes.
 723* Showing only first $max_sz bytes.
 724" d_@
 725                        }
 726                        $ui_diff insert end $content
 727                        if {$sz > $max_sz} {
 728                                $ui_diff insert end "
 729* Untracked file clipped here by [appname].
 730* To see the entire file, use an external editor.
 731" d_@
 732                        }
 733                }
 734                $ui_diff conf -state disabled
 735                set diff_active 0
 736                unlock_index
 737                set ui_status_value {Ready.}
 738                return
 739        }
 740
 741        set cmd [list | git]
 742        if {$w eq $ui_index} {
 743                lappend cmd diff-index
 744                lappend cmd --cached
 745        } elseif {$w eq $ui_workdir} {
 746                if {[string index $m 0] eq {U}} {
 747                        lappend cmd diff
 748                } else {
 749                        lappend cmd diff-files
 750                }
 751        }
 752
 753        lappend cmd -p
 754        lappend cmd --no-color
 755        if {$repo_config(gui.diffcontext) > 0} {
 756                lappend cmd "-U$repo_config(gui.diffcontext)"
 757        }
 758        if {$w eq $ui_index} {
 759                lappend cmd [PARENT]
 760        }
 761        lappend cmd --
 762        lappend cmd $path
 763
 764        if {[catch {set fd [open $cmd r]} err]} {
 765                set diff_active 0
 766                unlock_index
 767                set ui_status_value "Unable to display [escape_path $path]"
 768                error_popup "Error loading diff:\n\n$err"
 769                return
 770        }
 771
 772        fconfigure $fd \
 773                -blocking 0 \
 774                -encoding binary \
 775                -translation binary
 776        fileevent $fd readable [list read_diff $fd]
 777}
 778
 779proc read_diff {fd} {
 780        global ui_diff ui_status_value diff_active
 781        global is_3way_diff current_diff_header
 782
 783        $ui_diff conf -state normal
 784        while {[gets $fd line] >= 0} {
 785                # -- Cleanup uninteresting diff header lines.
 786                #
 787                if {   [string match {diff --git *}      $line]
 788                        || [string match {diff --cc *}       $line]
 789                        || [string match {diff --combined *} $line]
 790                        || [string match {--- *}             $line]
 791                        || [string match {+++ *}             $line]} {
 792                        append current_diff_header $line "\n"
 793                        continue
 794                }
 795                if {[string match {index *} $line]} continue
 796                if {$line eq {deleted file mode 120000}} {
 797                        set line "deleted symlink"
 798                }
 799
 800                # -- Automatically detect if this is a 3 way diff.
 801                #
 802                if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 803
 804                if {[string match {mode *} $line]
 805                        || [string match {new file *} $line]
 806                        || [string match {deleted file *} $line]
 807                        || [string match {Binary files * and * differ} $line]
 808                        || $line eq {\ No newline at end of file}
 809                        || [regexp {^\* Unmerged path } $line]} {
 810                        set tags {}
 811                } elseif {$is_3way_diff} {
 812                        set op [string range $line 0 1]
 813                        switch -- $op {
 814                        {  } {set tags {}}
 815                        {@@} {set tags d_@}
 816                        { +} {set tags d_s+}
 817                        { -} {set tags d_s-}
 818                        {+ } {set tags d_+s}
 819                        {- } {set tags d_-s}
 820                        {--} {set tags d_--}
 821                        {++} {
 822                                if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 823                                        set line [string replace $line 0 1 {  }]
 824                                        set tags d$op
 825                                } else {
 826                                        set tags d_++
 827                                }
 828                        }
 829                        default {
 830                                puts "error: Unhandled 3 way diff marker: {$op}"
 831                                set tags {}
 832                        }
 833                        }
 834                } else {
 835                        set op [string index $line 0]
 836                        switch -- $op {
 837                        { } {set tags {}}
 838                        {@} {set tags d_@}
 839                        {-} {set tags d_-}
 840                        {+} {
 841                                if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 842                                        set line [string replace $line 0 0 { }]
 843                                        set tags d$op
 844                                } else {
 845                                        set tags d_+
 846                                }
 847                        }
 848                        default {
 849                                puts "error: Unhandled 2 way diff marker: {$op}"
 850                                set tags {}
 851                        }
 852                        }
 853                }
 854                $ui_diff insert end $line $tags
 855                if {[string index $line end] eq "\r"} {
 856                        $ui_diff tag add d_cr {end - 2c}
 857                }
 858                $ui_diff insert end "\n" $tags
 859        }
 860        $ui_diff conf -state disabled
 861
 862        if {[eof $fd]} {
 863                close $fd
 864                set diff_active 0
 865                unlock_index
 866                set ui_status_value {Ready.}
 867
 868                if {[$ui_diff index end] eq {2.0}} {
 869                        handle_empty_diff
 870                }
 871        }
 872}
 873
 874proc apply_hunk {x y} {
 875        global current_diff_path current_diff_header current_diff_side
 876        global ui_diff ui_index file_states
 877
 878        if {$current_diff_path eq {} || $current_diff_header eq {}} return
 879        if {![lock_index apply_hunk]} return
 880
 881        set apply_cmd {git apply --cached --whitespace=nowarn}
 882        set mi [lindex $file_states($current_diff_path) 0]
 883        if {$current_diff_side eq $ui_index} {
 884                set mode unstage
 885                lappend apply_cmd --reverse
 886                if {[string index $mi 0] ne {M}} {
 887                        unlock_index
 888                        return
 889                }
 890        } else {
 891                set mode stage
 892                if {[string index $mi 1] ne {M}} {
 893                        unlock_index
 894                        return
 895                }
 896        }
 897
 898        set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
 899        set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
 900        if {$s_lno eq {}} {
 901                unlock_index
 902                return
 903        }
 904
 905        set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
 906        if {$e_lno eq {}} {
 907                set e_lno end
 908        }
 909
 910        if {[catch {
 911                set p [open "| $apply_cmd" w]
 912                fconfigure $p -translation binary -encoding binary
 913                puts -nonewline $p $current_diff_header
 914                puts -nonewline $p [$ui_diff get $s_lno $e_lno]
 915                close $p} err]} {
 916                error_popup "Failed to $mode selected hunk.\n\n$err"
 917                unlock_index
 918                return
 919        }
 920
 921        $ui_diff conf -state normal
 922        $ui_diff delete $s_lno $e_lno
 923        $ui_diff conf -state disabled
 924
 925        if {[$ui_diff get 1.0 end] eq "\n"} {
 926                set o _
 927        } else {
 928                set o ?
 929        }
 930
 931        if {$current_diff_side eq $ui_index} {
 932                set mi ${o}M
 933        } elseif {[string index $mi 0] eq {_}} {
 934                set mi M$o
 935        } else {
 936                set mi ?$o
 937        }
 938        unlock_index
 939        display_file $current_diff_path $mi
 940        if {$o eq {_}} {
 941                clear_diff
 942        }
 943}
 944
 945######################################################################
 946##
 947## commit
 948
 949proc load_last_commit {} {
 950        global HEAD PARENT MERGE_HEAD commit_type ui_comm
 951        global repo_config
 952
 953        if {[llength $PARENT] == 0} {
 954                error_popup {There is nothing to amend.
 955
 956You are about to create the initial commit.
 957There is no commit before this to amend.
 958}
 959                return
 960        }
 961
 962        repository_state curType curHEAD curMERGE_HEAD
 963        if {$curType eq {merge}} {
 964                error_popup {Cannot amend while merging.
 965
 966You are currently in the middle of a merge that
 967has not been fully completed.  You cannot amend
 968the prior commit unless you first abort the
 969current merge activity.
 970}
 971                return
 972        }
 973
 974        set msg {}
 975        set parents [list]
 976        if {[catch {
 977                        set fd [open "| git cat-file commit $curHEAD" r]
 978                        fconfigure $fd -encoding binary -translation lf
 979                        if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
 980                                set enc utf-8
 981                        }
 982                        while {[gets $fd line] > 0} {
 983                                if {[string match {parent *} $line]} {
 984                                        lappend parents [string range $line 7 end]
 985                                } elseif {[string match {encoding *} $line]} {
 986                                        set enc [string tolower [string range $line 9 end]]
 987                                }
 988                        }
 989                        fconfigure $fd -encoding $enc
 990                        set msg [string trim [read $fd]]
 991                        close $fd
 992                } err]} {
 993                error_popup "Error loading commit data for amend:\n\n$err"
 994                return
 995        }
 996
 997        set HEAD $curHEAD
 998        set PARENT $parents
 999        set MERGE_HEAD [list]
1000        switch -- [llength $parents] {
1001        0       {set commit_type amend-initial}
1002        1       {set commit_type amend}
1003        default {set commit_type amend-merge}
1004        }
1005
1006        $ui_comm delete 0.0 end
1007        $ui_comm insert end $msg
1008        $ui_comm edit reset
1009        $ui_comm edit modified false
1010        rescan {set ui_status_value {Ready.}}
1011}
1012
1013proc create_new_commit {} {
1014        global commit_type ui_comm
1015
1016        set commit_type normal
1017        $ui_comm delete 0.0 end
1018        $ui_comm edit reset
1019        $ui_comm edit modified false
1020        rescan {set ui_status_value {Ready.}}
1021}
1022
1023set GIT_COMMITTER_IDENT {}
1024
1025proc committer_ident {} {
1026        global GIT_COMMITTER_IDENT
1027
1028        if {$GIT_COMMITTER_IDENT eq {}} {
1029                if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1030                        error_popup "Unable to obtain your identity:\n\n$err"
1031                        return {}
1032                }
1033                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1034                        $me me GIT_COMMITTER_IDENT]} {
1035                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1036                        return {}
1037                }
1038        }
1039
1040        return $GIT_COMMITTER_IDENT
1041}
1042
1043proc commit_tree {} {
1044        global HEAD commit_type file_states ui_comm repo_config
1045        global ui_status_value pch_error
1046
1047        if {[committer_ident] eq {}} return
1048        if {![lock_index update]} return
1049
1050        # -- Our in memory state should match the repository.
1051        #
1052        repository_state curType curHEAD curMERGE_HEAD
1053        if {[string match amend* $commit_type]
1054                && $curType eq {normal}
1055                && $curHEAD eq $HEAD} {
1056        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1057                info_popup {Last scanned state does not match repository state.
1058
1059Another Git program has modified this repository
1060since the last scan.  A rescan must be performed
1061before another commit can be created.
1062
1063The rescan will be automatically started now.
1064}
1065                unlock_index
1066                rescan {set ui_status_value {Ready.}}
1067                return
1068        }
1069
1070        # -- At least one file should differ in the index.
1071        #
1072        set files_ready 0
1073        foreach path [array names file_states] {
1074                switch -glob -- [lindex $file_states($path) 0] {
1075                _? {continue}
1076                A? -
1077                D? -
1078                M? {set files_ready 1}
1079                U? {
1080                        error_popup "Unmerged files cannot be committed.
1081
1082File [short_path $path] has merge conflicts.
1083You must resolve them and add the file before committing.
1084"
1085                        unlock_index
1086                        return
1087                }
1088                default {
1089                        error_popup "Unknown file state [lindex $s 0] detected.
1090
1091File [short_path $path] cannot be committed by this program.
1092"
1093                }
1094                }
1095        }
1096        if {!$files_ready} {
1097                info_popup {No changes to commit.
1098
1099You must add at least 1 file before you can commit.
1100}
1101                unlock_index
1102                return
1103        }
1104
1105        # -- A message is required.
1106        #
1107        set msg [string trim [$ui_comm get 1.0 end]]
1108        regsub -all -line {[ \t\r]+$} $msg {} msg
1109        if {$msg eq {}} {
1110                error_popup {Please supply a commit message.
1111
1112A good commit message has the following format:
1113
1114- First line: Describe in one sentance what you did.
1115- Second line: Blank
1116- Remaining lines: Describe why this change is good.
1117}
1118                unlock_index
1119                return
1120        }
1121
1122        # -- Run the pre-commit hook.
1123        #
1124        set pchook [gitdir hooks pre-commit]
1125
1126        # On Cygwin [file executable] might lie so we need to ask
1127        # the shell if the hook is executable.  Yes that's annoying.
1128        #
1129        if {[is_Cygwin] && [file isfile $pchook]} {
1130                set pchook [list sh -c [concat \
1131                        "if test -x \"$pchook\";" \
1132                        "then exec \"$pchook\" 2>&1;" \
1133                        "fi"]]
1134        } elseif {[file executable $pchook]} {
1135                set pchook [list $pchook |& cat]
1136        } else {
1137                commit_writetree $curHEAD $msg
1138                return
1139        }
1140
1141        set ui_status_value {Calling pre-commit hook...}
1142        set pch_error {}
1143        set fd_ph [open "| $pchook" r]
1144        fconfigure $fd_ph -blocking 0 -translation binary
1145        fileevent $fd_ph readable \
1146                [list commit_prehook_wait $fd_ph $curHEAD $msg]
1147}
1148
1149proc commit_prehook_wait {fd_ph curHEAD msg} {
1150        global pch_error ui_status_value
1151
1152        append pch_error [read $fd_ph]
1153        fconfigure $fd_ph -blocking 1
1154        if {[eof $fd_ph]} {
1155                if {[catch {close $fd_ph}]} {
1156                        set ui_status_value {Commit declined by pre-commit hook.}
1157                        hook_failed_popup pre-commit $pch_error
1158                        unlock_index
1159                } else {
1160                        commit_writetree $curHEAD $msg
1161                }
1162                set pch_error {}
1163                return
1164        }
1165        fconfigure $fd_ph -blocking 0
1166}
1167
1168proc commit_writetree {curHEAD msg} {
1169        global ui_status_value
1170
1171        set ui_status_value {Committing changes...}
1172        set fd_wt [open "| git write-tree" r]
1173        fileevent $fd_wt readable \
1174                [list commit_committree $fd_wt $curHEAD $msg]
1175}
1176
1177proc commit_committree {fd_wt curHEAD msg} {
1178        global HEAD PARENT MERGE_HEAD commit_type
1179        global single_commit all_heads current_branch
1180        global ui_status_value ui_comm selected_commit_type
1181        global file_states selected_paths rescan_active
1182        global repo_config
1183
1184        gets $fd_wt tree_id
1185        if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1186                error_popup "write-tree failed:\n\n$err"
1187                set ui_status_value {Commit failed.}
1188                unlock_index
1189                return
1190        }
1191
1192        # -- Build the message.
1193        #
1194        set msg_p [gitdir COMMIT_EDITMSG]
1195        set msg_wt [open $msg_p w]
1196        if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1197                set enc utf-8
1198        }
1199        fconfigure $msg_wt -encoding $enc -translation binary
1200        puts -nonewline $msg_wt $msg
1201        close $msg_wt
1202
1203        # -- Create the commit.
1204        #
1205        set cmd [list git commit-tree $tree_id]
1206        set parents [concat $PARENT $MERGE_HEAD]
1207        if {[llength $parents] > 0} {
1208                foreach p $parents {
1209                        lappend cmd -p $p
1210                }
1211        } else {
1212                # git commit-tree writes to stderr during initial commit.
1213                lappend cmd 2>/dev/null
1214        }
1215        lappend cmd <$msg_p
1216        if {[catch {set cmt_id [eval exec $cmd]} err]} {
1217                error_popup "commit-tree failed:\n\n$err"
1218                set ui_status_value {Commit failed.}
1219                unlock_index
1220                return
1221        }
1222
1223        # -- Update the HEAD ref.
1224        #
1225        set reflogm commit
1226        if {$commit_type ne {normal}} {
1227                append reflogm " ($commit_type)"
1228        }
1229        set i [string first "\n" $msg]
1230        if {$i >= 0} {
1231                append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1232        } else {
1233                append reflogm {: } $msg
1234        }
1235        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1236        if {[catch {eval exec $cmd} err]} {
1237                error_popup "update-ref failed:\n\n$err"
1238                set ui_status_value {Commit failed.}
1239                unlock_index
1240                return
1241        }
1242
1243        # -- Make sure our current branch exists.
1244        #
1245        if {$commit_type eq {initial}} {
1246                lappend all_heads $current_branch
1247                set all_heads [lsort -unique $all_heads]
1248                populate_branch_menu
1249        }
1250
1251        # -- Cleanup after ourselves.
1252        #
1253        catch {file delete $msg_p}
1254        catch {file delete [gitdir MERGE_HEAD]}
1255        catch {file delete [gitdir MERGE_MSG]}
1256        catch {file delete [gitdir SQUASH_MSG]}
1257        catch {file delete [gitdir GITGUI_MSG]}
1258
1259        # -- Let rerere do its thing.
1260        #
1261        if {[file isdirectory [gitdir rr-cache]]} {
1262                catch {exec git rerere}
1263        }
1264
1265        # -- Run the post-commit hook.
1266        #
1267        set pchook [gitdir hooks post-commit]
1268        if {[is_Cygwin] && [file isfile $pchook]} {
1269                set pchook [list sh -c [concat \
1270                        "if test -x \"$pchook\";" \
1271                        "then exec \"$pchook\";" \
1272                        "fi"]]
1273        } elseif {![file executable $pchook]} {
1274                set pchook {}
1275        }
1276        if {$pchook ne {}} {
1277                catch {exec $pchook &}
1278        }
1279
1280        $ui_comm delete 0.0 end
1281        $ui_comm edit reset
1282        $ui_comm edit modified false
1283
1284        if {$single_commit} do_quit
1285
1286        # -- Update in memory status
1287        #
1288        set selected_commit_type new
1289        set commit_type normal
1290        set HEAD $cmt_id
1291        set PARENT $cmt_id
1292        set MERGE_HEAD [list]
1293
1294        foreach path [array names file_states] {
1295                set s $file_states($path)
1296                set m [lindex $s 0]
1297                switch -glob -- $m {
1298                _O -
1299                _M -
1300                _D {continue}
1301                __ -
1302                A_ -
1303                M_ -
1304                D_ {
1305                        unset file_states($path)
1306                        catch {unset selected_paths($path)}
1307                }
1308                DO {
1309                        set file_states($path) [list _O [lindex $s 1] {} {}]
1310                }
1311                AM -
1312                AD -
1313                MM -
1314                MD {
1315                        set file_states($path) [list \
1316                                _[string index $m 1] \
1317                                [lindex $s 1] \
1318                                [lindex $s 3] \
1319                                {}]
1320                }
1321                }
1322        }
1323
1324        display_all_files
1325        unlock_index
1326        reshow_diff
1327        set ui_status_value \
1328                "Changes committed as [string range $cmt_id 0 7]."
1329}
1330
1331######################################################################
1332##
1333## fetch push
1334
1335proc fetch_from {remote} {
1336        set w [new_console \
1337                "fetch $remote" \
1338                "Fetching new changes from $remote"]
1339        set cmd [list git fetch]
1340        lappend cmd $remote
1341        console_exec $w $cmd console_done
1342}
1343
1344proc push_to {remote} {
1345        set w [new_console \
1346                "push $remote" \
1347                "Pushing changes to $remote"]
1348        set cmd [list git push]
1349        lappend cmd -v
1350        lappend cmd $remote
1351        console_exec $w $cmd console_done
1352}
1353
1354######################################################################
1355##
1356## ui helpers
1357
1358proc mapicon {w state path} {
1359        global all_icons
1360
1361        if {[catch {set r $all_icons($state$w)}]} {
1362                puts "error: no icon for $w state={$state} $path"
1363                return file_plain
1364        }
1365        return $r
1366}
1367
1368proc mapdesc {state path} {
1369        global all_descs
1370
1371        if {[catch {set r $all_descs($state)}]} {
1372                puts "error: no desc for state={$state} $path"
1373                return $state
1374        }
1375        return $r
1376}
1377
1378proc escape_path {path} {
1379        regsub -all "\n" $path "\\n" path
1380        return $path
1381}
1382
1383proc short_path {path} {
1384        return [escape_path [lindex [file split $path] end]]
1385}
1386
1387set next_icon_id 0
1388set null_sha1 [string repeat 0 40]
1389
1390proc merge_state {path new_state {head_info {}} {index_info {}}} {
1391        global file_states next_icon_id null_sha1
1392
1393        set s0 [string index $new_state 0]
1394        set s1 [string index $new_state 1]
1395
1396        if {[catch {set info $file_states($path)}]} {
1397                set state __
1398                set icon n[incr next_icon_id]
1399        } else {
1400                set state [lindex $info 0]
1401                set icon [lindex $info 1]
1402                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1403                if {$index_info eq {}} {set index_info [lindex $info 3]}
1404        }
1405
1406        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1407        elseif {$s0 eq {_}} {set s0 _}
1408
1409        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1410        elseif {$s1 eq {_}} {set s1 _}
1411
1412        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1413                set head_info [list 0 $null_sha1]
1414        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1415                && $head_info eq {}} {
1416                set head_info $index_info
1417        }
1418
1419        set file_states($path) [list $s0$s1 $icon \
1420                $head_info $index_info \
1421                ]
1422        return $state
1423}
1424
1425proc display_file_helper {w path icon_name old_m new_m} {
1426        global file_lists
1427
1428        if {$new_m eq {_}} {
1429                set lno [lsearch -sorted -exact $file_lists($w) $path]
1430                if {$lno >= 0} {
1431                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1432                        incr lno
1433                        $w conf -state normal
1434                        $w delete $lno.0 [expr {$lno + 1}].0
1435                        $w conf -state disabled
1436                }
1437        } elseif {$old_m eq {_} && $new_m ne {_}} {
1438                lappend file_lists($w) $path
1439                set file_lists($w) [lsort -unique $file_lists($w)]
1440                set lno [lsearch -sorted -exact $file_lists($w) $path]
1441                incr lno
1442                $w conf -state normal
1443                $w image create $lno.0 \
1444                        -align center -padx 5 -pady 1 \
1445                        -name $icon_name \
1446                        -image [mapicon $w $new_m $path]
1447                $w insert $lno.1 "[escape_path $path]\n"
1448                $w conf -state disabled
1449        } elseif {$old_m ne $new_m} {
1450                $w conf -state normal
1451                $w image conf $icon_name -image [mapicon $w $new_m $path]
1452                $w conf -state disabled
1453        }
1454}
1455
1456proc display_file {path state} {
1457        global file_states selected_paths
1458        global ui_index ui_workdir
1459
1460        set old_m [merge_state $path $state]
1461        set s $file_states($path)
1462        set new_m [lindex $s 0]
1463        set icon_name [lindex $s 1]
1464
1465        set o [string index $old_m 0]
1466        set n [string index $new_m 0]
1467        if {$o eq {U}} {
1468                set o _
1469        }
1470        if {$n eq {U}} {
1471                set n _
1472        }
1473        display_file_helper     $ui_index $path $icon_name $o $n
1474
1475        if {[string index $old_m 0] eq {U}} {
1476                set o U
1477        } else {
1478                set o [string index $old_m 1]
1479        }
1480        if {[string index $new_m 0] eq {U}} {
1481                set n U
1482        } else {
1483                set n [string index $new_m 1]
1484        }
1485        display_file_helper     $ui_workdir $path $icon_name $o $n
1486
1487        if {$new_m eq {__}} {
1488                unset file_states($path)
1489                catch {unset selected_paths($path)}
1490        }
1491}
1492
1493proc display_all_files_helper {w path icon_name m} {
1494        global file_lists
1495
1496        lappend file_lists($w) $path
1497        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1498        $w image create end \
1499                -align center -padx 5 -pady 1 \
1500                -name $icon_name \
1501                -image [mapicon $w $m $path]
1502        $w insert end "[escape_path $path]\n"
1503}
1504
1505proc display_all_files {} {
1506        global ui_index ui_workdir
1507        global file_states file_lists
1508        global last_clicked
1509
1510        $ui_index conf -state normal
1511        $ui_workdir conf -state normal
1512
1513        $ui_index delete 0.0 end
1514        $ui_workdir delete 0.0 end
1515        set last_clicked {}
1516
1517        set file_lists($ui_index) [list]
1518        set file_lists($ui_workdir) [list]
1519
1520        foreach path [lsort [array names file_states]] {
1521                set s $file_states($path)
1522                set m [lindex $s 0]
1523                set icon_name [lindex $s 1]
1524
1525                set s [string index $m 0]
1526                if {$s ne {U} && $s ne {_}} {
1527                        display_all_files_helper $ui_index $path \
1528                                $icon_name $s
1529                }
1530
1531                if {[string index $m 0] eq {U}} {
1532                        set s U
1533                } else {
1534                        set s [string index $m 1]
1535                }
1536                if {$s ne {_}} {
1537                        display_all_files_helper $ui_workdir $path \
1538                                $icon_name $s
1539                }
1540        }
1541
1542        $ui_index conf -state disabled
1543        $ui_workdir conf -state disabled
1544}
1545
1546proc update_indexinfo {msg pathList after} {
1547        global update_index_cp ui_status_value
1548
1549        if {![lock_index update]} return
1550
1551        set update_index_cp 0
1552        set pathList [lsort $pathList]
1553        set totalCnt [llength $pathList]
1554        set batch [expr {int($totalCnt * .01) + 1}]
1555        if {$batch > 25} {set batch 25}
1556
1557        set ui_status_value [format \
1558                "$msg... %i/%i files (%.2f%%)" \
1559                $update_index_cp \
1560                $totalCnt \
1561                0.0]
1562        set fd [open "| git update-index -z --index-info" w]
1563        fconfigure $fd \
1564                -blocking 0 \
1565                -buffering full \
1566                -buffersize 512 \
1567                -encoding binary \
1568                -translation binary
1569        fileevent $fd writable [list \
1570                write_update_indexinfo \
1571                $fd \
1572                $pathList \
1573                $totalCnt \
1574                $batch \
1575                $msg \
1576                $after \
1577                ]
1578}
1579
1580proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1581        global update_index_cp ui_status_value
1582        global file_states current_diff_path
1583
1584        if {$update_index_cp >= $totalCnt} {
1585                close $fd
1586                unlock_index
1587                uplevel #0 $after
1588                return
1589        }
1590
1591        for {set i $batch} \
1592                {$update_index_cp < $totalCnt && $i > 0} \
1593                {incr i -1} {
1594                set path [lindex $pathList $update_index_cp]
1595                incr update_index_cp
1596
1597                set s $file_states($path)
1598                switch -glob -- [lindex $s 0] {
1599                A? {set new _O}
1600                M? {set new _M}
1601                D_ {set new _D}
1602                D? {set new _?}
1603                ?? {continue}
1604                }
1605                set info [lindex $s 2]
1606                if {$info eq {}} continue
1607
1608                puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1609                display_file $path $new
1610        }
1611
1612        set ui_status_value [format \
1613                "$msg... %i/%i files (%.2f%%)" \
1614                $update_index_cp \
1615                $totalCnt \
1616                [expr {100.0 * $update_index_cp / $totalCnt}]]
1617}
1618
1619proc update_index {msg pathList after} {
1620        global update_index_cp ui_status_value
1621
1622        if {![lock_index update]} return
1623
1624        set update_index_cp 0
1625        set pathList [lsort $pathList]
1626        set totalCnt [llength $pathList]
1627        set batch [expr {int($totalCnt * .01) + 1}]
1628        if {$batch > 25} {set batch 25}
1629
1630        set ui_status_value [format \
1631                "$msg... %i/%i files (%.2f%%)" \
1632                $update_index_cp \
1633                $totalCnt \
1634                0.0]
1635        set fd [open "| git update-index --add --remove -z --stdin" w]
1636        fconfigure $fd \
1637                -blocking 0 \
1638                -buffering full \
1639                -buffersize 512 \
1640                -encoding binary \
1641                -translation binary
1642        fileevent $fd writable [list \
1643                write_update_index \
1644                $fd \
1645                $pathList \
1646                $totalCnt \
1647                $batch \
1648                $msg \
1649                $after \
1650                ]
1651}
1652
1653proc write_update_index {fd pathList totalCnt batch msg after} {
1654        global update_index_cp ui_status_value
1655        global file_states current_diff_path
1656
1657        if {$update_index_cp >= $totalCnt} {
1658                close $fd
1659                unlock_index
1660                uplevel #0 $after
1661                return
1662        }
1663
1664        for {set i $batch} \
1665                {$update_index_cp < $totalCnt && $i > 0} \
1666                {incr i -1} {
1667                set path [lindex $pathList $update_index_cp]
1668                incr update_index_cp
1669
1670                switch -glob -- [lindex $file_states($path) 0] {
1671                AD {set new __}
1672                ?D {set new D_}
1673                _O -
1674                AM {set new A_}
1675                U? {
1676                        if {[file exists $path]} {
1677                                set new M_
1678                        } else {
1679                                set new D_
1680                        }
1681                }
1682                ?M {set new M_}
1683                ?? {continue}
1684                }
1685                puts -nonewline $fd "[encoding convertto $path]\0"
1686                display_file $path $new
1687        }
1688
1689        set ui_status_value [format \
1690                "$msg... %i/%i files (%.2f%%)" \
1691                $update_index_cp \
1692                $totalCnt \
1693                [expr {100.0 * $update_index_cp / $totalCnt}]]
1694}
1695
1696proc checkout_index {msg pathList after} {
1697        global update_index_cp ui_status_value
1698
1699        if {![lock_index update]} return
1700
1701        set update_index_cp 0
1702        set pathList [lsort $pathList]
1703        set totalCnt [llength $pathList]
1704        set batch [expr {int($totalCnt * .01) + 1}]
1705        if {$batch > 25} {set batch 25}
1706
1707        set ui_status_value [format \
1708                "$msg... %i/%i files (%.2f%%)" \
1709                $update_index_cp \
1710                $totalCnt \
1711                0.0]
1712        set cmd [list git checkout-index]
1713        lappend cmd --index
1714        lappend cmd --quiet
1715        lappend cmd --force
1716        lappend cmd -z
1717        lappend cmd --stdin
1718        set fd [open "| $cmd " w]
1719        fconfigure $fd \
1720                -blocking 0 \
1721                -buffering full \
1722                -buffersize 512 \
1723                -encoding binary \
1724                -translation binary
1725        fileevent $fd writable [list \
1726                write_checkout_index \
1727                $fd \
1728                $pathList \
1729                $totalCnt \
1730                $batch \
1731                $msg \
1732                $after \
1733                ]
1734}
1735
1736proc write_checkout_index {fd pathList totalCnt batch msg after} {
1737        global update_index_cp ui_status_value
1738        global file_states current_diff_path
1739
1740        if {$update_index_cp >= $totalCnt} {
1741                close $fd
1742                unlock_index
1743                uplevel #0 $after
1744                return
1745        }
1746
1747        for {set i $batch} \
1748                {$update_index_cp < $totalCnt && $i > 0} \
1749                {incr i -1} {
1750                set path [lindex $pathList $update_index_cp]
1751                incr update_index_cp
1752                switch -glob -- [lindex $file_states($path) 0] {
1753                U? {continue}
1754                ?M -
1755                ?D {
1756                        puts -nonewline $fd "[encoding convertto $path]\0"
1757                        display_file $path ?_
1758                }
1759                }
1760        }
1761
1762        set ui_status_value [format \
1763                "$msg... %i/%i files (%.2f%%)" \
1764                $update_index_cp \
1765                $totalCnt \
1766                [expr {100.0 * $update_index_cp / $totalCnt}]]
1767}
1768
1769######################################################################
1770##
1771## branch management
1772
1773proc is_tracking_branch {name} {
1774        global tracking_branches
1775
1776        if {![catch {set info $tracking_branches($name)}]} {
1777                return 1
1778        }
1779        foreach t [array names tracking_branches] {
1780                if {[string match {*/\*} $t] && [string match $t $name]} {
1781                        return 1
1782                }
1783        }
1784        return 0
1785}
1786
1787proc load_all_heads {} {
1788        global all_heads
1789
1790        set all_heads [list]
1791        set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1792        while {[gets $fd line] > 0} {
1793                if {[is_tracking_branch $line]} continue
1794                if {![regsub ^refs/heads/ $line {} name]} continue
1795                lappend all_heads $name
1796        }
1797        close $fd
1798
1799        set all_heads [lsort $all_heads]
1800}
1801
1802proc populate_branch_menu {} {
1803        global all_heads disable_on_lock
1804
1805        set m .mbar.branch
1806        set last [$m index last]
1807        for {set i 0} {$i <= $last} {incr i} {
1808                if {[$m type $i] eq {separator}} {
1809                        $m delete $i last
1810                        set new_dol [list]
1811                        foreach a $disable_on_lock {
1812                                if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1813                                        lappend new_dol $a
1814                                }
1815                        }
1816                        set disable_on_lock $new_dol
1817                        break
1818                }
1819        }
1820
1821        if {$all_heads ne {}} {
1822                $m add separator
1823        }
1824        foreach b $all_heads {
1825                $m add radiobutton \
1826                        -label $b \
1827                        -command [list switch_branch $b] \
1828                        -variable current_branch \
1829                        -value $b \
1830                        -font font_ui
1831                lappend disable_on_lock \
1832                        [list $m entryconf [$m index last] -state]
1833        }
1834}
1835
1836proc all_tracking_branches {} {
1837        global tracking_branches
1838
1839        set all_trackings {}
1840        set cmd {}
1841        foreach name [array names tracking_branches] {
1842                if {[regsub {/\*$} $name {} name]} {
1843                        lappend cmd $name
1844                } else {
1845                        regsub ^refs/(heads|remotes)/ $name {} name
1846                        lappend all_trackings $name
1847                }
1848        }
1849
1850        if {$cmd ne {}} {
1851                set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1852                while {[gets $fd name] > 0} {
1853                        regsub ^refs/(heads|remotes)/ $name {} name
1854                        lappend all_trackings $name
1855                }
1856                close $fd
1857        }
1858
1859        return [lsort -unique $all_trackings]
1860}
1861
1862proc do_create_branch_action {w} {
1863        global all_heads null_sha1 repo_config
1864        global create_branch_checkout create_branch_revtype
1865        global create_branch_head create_branch_trackinghead
1866        global create_branch_name create_branch_revexp
1867
1868        set newbranch $create_branch_name
1869        if {$newbranch eq {}
1870                || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1871                tk_messageBox \
1872                        -icon error \
1873                        -type ok \
1874                        -title [wm title $w] \
1875                        -parent $w \
1876                        -message "Please supply a branch name."
1877                focus $w.desc.name_t
1878                return
1879        }
1880        if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1881                tk_messageBox \
1882                        -icon error \
1883                        -type ok \
1884                        -title [wm title $w] \
1885                        -parent $w \
1886                        -message "Branch '$newbranch' already exists."
1887                focus $w.desc.name_t
1888                return
1889        }
1890        if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1891                tk_messageBox \
1892                        -icon error \
1893                        -type ok \
1894                        -title [wm title $w] \
1895                        -parent $w \
1896                        -message "We do not like '$newbranch' as a branch name."
1897                focus $w.desc.name_t
1898                return
1899        }
1900
1901        set rev {}
1902        switch -- $create_branch_revtype {
1903        head {set rev $create_branch_head}
1904        tracking {set rev $create_branch_trackinghead}
1905        expression {set rev $create_branch_revexp}
1906        }
1907        if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1908                tk_messageBox \
1909                        -icon error \
1910                        -type ok \
1911                        -title [wm title $w] \
1912                        -parent $w \
1913                        -message "Invalid starting revision: $rev"
1914                return
1915        }
1916        set cmd [list git update-ref]
1917        lappend cmd -m
1918        lappend cmd "branch: Created from $rev"
1919        lappend cmd "refs/heads/$newbranch"
1920        lappend cmd $cmt
1921        lappend cmd $null_sha1
1922        if {[catch {eval exec $cmd} err]} {
1923                tk_messageBox \
1924                        -icon error \
1925                        -type ok \
1926                        -title [wm title $w] \
1927                        -parent $w \
1928                        -message "Failed to create '$newbranch'.\n\n$err"
1929                return
1930        }
1931
1932        lappend all_heads $newbranch
1933        set all_heads [lsort $all_heads]
1934        populate_branch_menu
1935        destroy $w
1936        if {$create_branch_checkout} {
1937                switch_branch $newbranch
1938        }
1939}
1940
1941proc radio_selector {varname value args} {
1942        upvar #0 $varname var
1943        set var $value
1944}
1945
1946trace add variable create_branch_head write \
1947        [list radio_selector create_branch_revtype head]
1948trace add variable create_branch_trackinghead write \
1949        [list radio_selector create_branch_revtype tracking]
1950
1951trace add variable delete_branch_head write \
1952        [list radio_selector delete_branch_checktype head]
1953trace add variable delete_branch_trackinghead write \
1954        [list radio_selector delete_branch_checktype tracking]
1955
1956proc do_create_branch {} {
1957        global all_heads current_branch repo_config
1958        global create_branch_checkout create_branch_revtype
1959        global create_branch_head create_branch_trackinghead
1960        global create_branch_name create_branch_revexp
1961
1962        set w .branch_editor
1963        toplevel $w
1964        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1965
1966        label $w.header -text {Create New Branch} \
1967                -font font_uibold
1968        pack $w.header -side top -fill x
1969
1970        frame $w.buttons
1971        button $w.buttons.create -text Create \
1972                -font font_ui \
1973                -default active \
1974                -command [list do_create_branch_action $w]
1975        pack $w.buttons.create -side right
1976        button $w.buttons.cancel -text {Cancel} \
1977                -font font_ui \
1978                -command [list destroy $w]
1979        pack $w.buttons.cancel -side right -padx 5
1980        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1981
1982        labelframe $w.desc \
1983                -text {Branch Description} \
1984                -font font_ui
1985        label $w.desc.name_l -text {Name:} -font font_ui
1986        entry $w.desc.name_t \
1987                -borderwidth 1 \
1988                -relief sunken \
1989                -width 40 \
1990                -textvariable create_branch_name \
1991                -font font_ui \
1992                -validate key \
1993                -validatecommand {
1994                        if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
1995                        return 1
1996                }
1997        grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
1998        grid columnconfigure $w.desc 1 -weight 1
1999        pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2000
2001        labelframe $w.from \
2002                -text {Starting Revision} \
2003                -font font_ui
2004        radiobutton $w.from.head_r \
2005                -text {Local Branch:} \
2006                -value head \
2007                -variable create_branch_revtype \
2008                -font font_ui
2009        eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2010        grid $w.from.head_r $w.from.head_m -sticky w
2011        set all_trackings [all_tracking_branches]
2012        if {$all_trackings ne {}} {
2013                set create_branch_trackinghead [lindex $all_trackings 0]
2014                radiobutton $w.from.tracking_r \
2015                        -text {Tracking Branch:} \
2016                        -value tracking \
2017                        -variable create_branch_revtype \
2018                        -font font_ui
2019                eval tk_optionMenu $w.from.tracking_m \
2020                        create_branch_trackinghead \
2021                        $all_trackings
2022                grid $w.from.tracking_r $w.from.tracking_m -sticky w
2023        }
2024        radiobutton $w.from.exp_r \
2025                -text {Revision Expression:} \
2026                -value expression \
2027                -variable create_branch_revtype \
2028                -font font_ui
2029        entry $w.from.exp_t \
2030                -borderwidth 1 \
2031                -relief sunken \
2032                -width 50 \
2033                -textvariable create_branch_revexp \
2034                -font font_ui \
2035                -validate key \
2036                -validatecommand {
2037                        if {%d == 1 && [regexp {\s} %S]} {return 0}
2038                        if {%d == 1 && [string length %S] > 0} {
2039                                set create_branch_revtype expression
2040                        }
2041                        return 1
2042                }
2043        grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2044        grid columnconfigure $w.from 1 -weight 1
2045        pack $w.from -anchor nw -fill x -pady 5 -padx 5
2046
2047        labelframe $w.postActions \
2048                -text {Post Creation Actions} \
2049                -font font_ui
2050        checkbutton $w.postActions.checkout \
2051                -text {Checkout after creation} \
2052                -variable create_branch_checkout \
2053                -font font_ui
2054        pack $w.postActions.checkout -anchor nw
2055        pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2056
2057        set create_branch_checkout 1
2058        set create_branch_head $current_branch
2059        set create_branch_revtype head
2060        set create_branch_name $repo_config(gui.newbranchtemplate)
2061        set create_branch_revexp {}
2062
2063        bind $w <Visibility> "
2064                grab $w
2065                $w.desc.name_t icursor end
2066                focus $w.desc.name_t
2067        "
2068        bind $w <Key-Escape> "destroy $w"
2069        bind $w <Key-Return> "do_create_branch_action $w;break"
2070        wm title $w "[appname] ([reponame]): Create Branch"
2071        tkwait window $w
2072}
2073
2074proc do_delete_branch_action {w} {
2075        global all_heads
2076        global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2077
2078        set check_rev {}
2079        switch -- $delete_branch_checktype {
2080        head {set check_rev $delete_branch_head}
2081        tracking {set check_rev $delete_branch_trackinghead}
2082        always {set check_rev {:none}}
2083        }
2084        if {$check_rev eq {:none}} {
2085                set check_cmt {}
2086        } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2087                tk_messageBox \
2088                        -icon error \
2089                        -type ok \
2090                        -title [wm title $w] \
2091                        -parent $w \
2092                        -message "Invalid check revision: $check_rev"
2093                return
2094        }
2095
2096        set to_delete [list]
2097        set not_merged [list]
2098        foreach i [$w.list.l curselection] {
2099                set b [$w.list.l get $i]
2100                if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2101                if {$check_cmt ne {}} {
2102                        if {$b eq $check_rev} continue
2103                        if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2104                        if {$o ne $m} {
2105                                lappend not_merged $b
2106                                continue
2107                        }
2108                }
2109                lappend to_delete [list $b $o]
2110        }
2111        if {$not_merged ne {}} {
2112                set msg "The following branches are not completely merged into $check_rev:
2113
2114 - [join $not_merged "\n - "]"
2115                tk_messageBox \
2116                        -icon info \
2117                        -type ok \
2118                        -title [wm title $w] \
2119                        -parent $w \
2120                        -message $msg
2121        }
2122        if {$to_delete eq {}} return
2123        if {$delete_branch_checktype eq {always}} {
2124                set msg {Recovering deleted branches is difficult.
2125
2126Delete the selected branches?}
2127                if {[tk_messageBox \
2128                        -icon warning \
2129                        -type yesno \
2130                        -title [wm title $w] \
2131                        -parent $w \
2132                        -message $msg] ne yes} {
2133                        return
2134                }
2135        }
2136
2137        set failed {}
2138        foreach i $to_delete {
2139                set b [lindex $i 0]
2140                set o [lindex $i 1]
2141                if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2142                        append failed " - $b: $err\n"
2143                } else {
2144                        set x [lsearch -sorted -exact $all_heads $b]
2145                        if {$x >= 0} {
2146                                set all_heads [lreplace $all_heads $x $x]
2147                        }
2148                }
2149        }
2150
2151        if {$failed ne {}} {
2152                tk_messageBox \
2153                        -icon error \
2154                        -type ok \
2155                        -title [wm title $w] \
2156                        -parent $w \
2157                        -message "Failed to delete branches:\n$failed"
2158        }
2159
2160        set all_heads [lsort $all_heads]
2161        populate_branch_menu
2162        destroy $w
2163}
2164
2165proc do_delete_branch {} {
2166        global all_heads tracking_branches current_branch
2167        global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2168
2169        set w .branch_editor
2170        toplevel $w
2171        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2172
2173        label $w.header -text {Delete Local Branch} \
2174                -font font_uibold
2175        pack $w.header -side top -fill x
2176
2177        frame $w.buttons
2178        button $w.buttons.create -text Delete \
2179                -font font_ui \
2180                -command [list do_delete_branch_action $w]
2181        pack $w.buttons.create -side right
2182        button $w.buttons.cancel -text {Cancel} \
2183                -font font_ui \
2184                -command [list destroy $w]
2185        pack $w.buttons.cancel -side right -padx 5
2186        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2187
2188        labelframe $w.list \
2189                -text {Local Branches} \
2190                -font font_ui
2191        listbox $w.list.l \
2192                -height 10 \
2193                -width 70 \
2194                -selectmode extended \
2195                -yscrollcommand [list $w.list.sby set] \
2196                -font font_ui
2197        foreach h $all_heads {
2198                if {$h ne $current_branch} {
2199                        $w.list.l insert end $h
2200                }
2201        }
2202        scrollbar $w.list.sby -command [list $w.list.l yview]
2203        pack $w.list.sby -side right -fill y
2204        pack $w.list.l -side left -fill both -expand 1
2205        pack $w.list -fill both -expand 1 -pady 5 -padx 5
2206
2207        labelframe $w.validate \
2208                -text {Delete Only If} \
2209                -font font_ui
2210        radiobutton $w.validate.head_r \
2211                -text {Merged Into Local Branch:} \
2212                -value head \
2213                -variable delete_branch_checktype \
2214                -font font_ui
2215        eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2216        grid $w.validate.head_r $w.validate.head_m -sticky w
2217        set all_trackings [all_tracking_branches]
2218        if {$all_trackings ne {}} {
2219                set delete_branch_trackinghead [lindex $all_trackings 0]
2220                radiobutton $w.validate.tracking_r \
2221                        -text {Merged Into Tracking Branch:} \
2222                        -value tracking \
2223                        -variable delete_branch_checktype \
2224                        -font font_ui
2225                eval tk_optionMenu $w.validate.tracking_m \
2226                        delete_branch_trackinghead \
2227                        $all_trackings
2228                grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2229        }
2230        radiobutton $w.validate.always_r \
2231                -text {Always (Do not perform merge checks)} \
2232                -value always \
2233                -variable delete_branch_checktype \
2234                -font font_ui
2235        grid $w.validate.always_r -columnspan 2 -sticky w
2236        grid columnconfigure $w.validate 1 -weight 1
2237        pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2238
2239        set delete_branch_head $current_branch
2240        set delete_branch_checktype head
2241
2242        bind $w <Visibility> "grab $w; focus $w"
2243        bind $w <Key-Escape> "destroy $w"
2244        wm title $w "[appname] ([reponame]): Delete Branch"
2245        tkwait window $w
2246}
2247
2248proc switch_branch {new_branch} {
2249        global HEAD commit_type current_branch repo_config
2250
2251        if {![lock_index switch]} return
2252
2253        # -- Our in memory state should match the repository.
2254        #
2255        repository_state curType curHEAD curMERGE_HEAD
2256        if {[string match amend* $commit_type]
2257                && $curType eq {normal}
2258                && $curHEAD eq $HEAD} {
2259        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2260                info_popup {Last scanned state does not match repository state.
2261
2262Another Git program has modified this repository
2263since the last scan.  A rescan must be performed
2264before the current branch can be changed.
2265
2266The rescan will be automatically started now.
2267}
2268                unlock_index
2269                rescan {set ui_status_value {Ready.}}
2270                return
2271        }
2272
2273        # -- Don't do a pointless switch.
2274        #
2275        if {$current_branch eq $new_branch} {
2276                unlock_index
2277                return
2278        }
2279
2280        if {$repo_config(gui.trustmtime) eq {true}} {
2281                switch_branch_stage2 {} $new_branch
2282        } else {
2283                set ui_status_value {Refreshing file status...}
2284                set cmd [list git update-index]
2285                lappend cmd -q
2286                lappend cmd --unmerged
2287                lappend cmd --ignore-missing
2288                lappend cmd --refresh
2289                set fd_rf [open "| $cmd" r]
2290                fconfigure $fd_rf -blocking 0 -translation binary
2291                fileevent $fd_rf readable \
2292                        [list switch_branch_stage2 $fd_rf $new_branch]
2293        }
2294}
2295
2296proc switch_branch_stage2 {fd_rf new_branch} {
2297        global ui_status_value HEAD
2298
2299        if {$fd_rf ne {}} {
2300                read $fd_rf
2301                if {![eof $fd_rf]} return
2302                close $fd_rf
2303        }
2304
2305        set ui_status_value "Updating working directory to '$new_branch'..."
2306        set cmd [list git read-tree]
2307        lappend cmd -m
2308        lappend cmd -u
2309        lappend cmd --exclude-per-directory=.gitignore
2310        lappend cmd $HEAD
2311        lappend cmd $new_branch
2312        set fd_rt [open "| $cmd" r]
2313        fconfigure $fd_rt -blocking 0 -translation binary
2314        fileevent $fd_rt readable \
2315                [list switch_branch_readtree_wait $fd_rt $new_branch]
2316}
2317
2318proc switch_branch_readtree_wait {fd_rt new_branch} {
2319        global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2320        global current_branch
2321        global ui_comm ui_status_value
2322
2323        # -- We never get interesting output on stdout; only stderr.
2324        #
2325        read $fd_rt
2326        fconfigure $fd_rt -blocking 1
2327        if {![eof $fd_rt]} {
2328                fconfigure $fd_rt -blocking 0
2329                return
2330        }
2331
2332        # -- The working directory wasn't in sync with the index and
2333        #    we'd have to overwrite something to make the switch. A
2334        #    merge is required.
2335        #
2336        if {[catch {close $fd_rt} err]} {
2337                regsub {^fatal: } $err {} err
2338                warn_popup "File level merge required.
2339
2340$err
2341
2342Staying on branch '$current_branch'."
2343                set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2344                unlock_index
2345                return
2346        }
2347
2348        # -- Update the symbolic ref.  Core git doesn't even check for failure
2349        #    here, it Just Works(tm).  If it doesn't we are in some really ugly
2350        #    state that is difficult to recover from within git-gui.
2351        #
2352        if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2353                error_popup "Failed to set current branch.
2354
2355This working directory is only partially switched.
2356We successfully updated your files, but failed to
2357update an internal Git file.
2358
2359This should not have occurred.  [appname] will now
2360close and give up.
2361
2362$err"
2363                do_quit
2364                return
2365        }
2366
2367        # -- Update our repository state.  If we were previously in amend mode
2368        #    we need to toss the current buffer and do a full rescan to update
2369        #    our file lists.  If we weren't in amend mode our file lists are
2370        #    accurate and we can avoid the rescan.
2371        #
2372        unlock_index
2373        set selected_commit_type new
2374        if {[string match amend* $commit_type]} {
2375                $ui_comm delete 0.0 end
2376                $ui_comm edit reset
2377                $ui_comm edit modified false
2378                rescan {set ui_status_value "Checked out branch '$current_branch'."}
2379        } else {
2380                repository_state commit_type HEAD MERGE_HEAD
2381                set PARENT $HEAD
2382                set ui_status_value "Checked out branch '$current_branch'."
2383        }
2384}
2385
2386######################################################################
2387##
2388## remote management
2389
2390proc load_all_remotes {} {
2391        global repo_config
2392        global all_remotes tracking_branches
2393
2394        set all_remotes [list]
2395        array unset tracking_branches
2396
2397        set rm_dir [gitdir remotes]
2398        if {[file isdirectory $rm_dir]} {
2399                set all_remotes [glob \
2400                        -types f \
2401                        -tails \
2402                        -nocomplain \
2403                        -directory $rm_dir *]
2404
2405                foreach name $all_remotes {
2406                        catch {
2407                                set fd [open [file join $rm_dir $name] r]
2408                                while {[gets $fd line] >= 0} {
2409                                        if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2410                                                $line line src dst]} continue
2411                                        if {![regexp ^refs/ $dst]} {
2412                                                set dst "refs/heads/$dst"
2413                                        }
2414                                        set tracking_branches($dst) [list $name $src]
2415                                }
2416                                close $fd
2417                        }
2418                }
2419        }
2420
2421        foreach line [array names repo_config remote.*.url] {
2422                if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2423                lappend all_remotes $name
2424
2425                if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2426                        set fl {}
2427                }
2428                foreach line $fl {
2429                        if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2430                        if {![regexp ^refs/ $dst]} {
2431                                set dst "refs/heads/$dst"
2432                        }
2433                        set tracking_branches($dst) [list $name $src]
2434                }
2435        }
2436
2437        set all_remotes [lsort -unique $all_remotes]
2438}
2439
2440proc populate_fetch_menu {} {
2441        global all_remotes repo_config
2442
2443        set m .mbar.fetch
2444        foreach r $all_remotes {
2445                set enable 0
2446                if {![catch {set a $repo_config(remote.$r.url)}]} {
2447                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2448                                set enable 1
2449                        }
2450                } else {
2451                        catch {
2452                                set fd [open [gitdir remotes $r] r]
2453                                while {[gets $fd n] >= 0} {
2454                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2455                                                set enable 1
2456                                                break
2457                                        }
2458                                }
2459                                close $fd
2460                        }
2461                }
2462
2463                if {$enable} {
2464                        $m add command \
2465                                -label "Fetch from $r..." \
2466                                -command [list fetch_from $r] \
2467                                -font font_ui
2468                }
2469        }
2470}
2471
2472proc populate_push_menu {} {
2473        global all_remotes repo_config
2474
2475        set m .mbar.push
2476        set fast_count 0
2477        foreach r $all_remotes {
2478                set enable 0
2479                if {![catch {set a $repo_config(remote.$r.url)}]} {
2480                        if {![catch {set a $repo_config(remote.$r.push)}]} {
2481                                set enable 1
2482                        }
2483                } else {
2484                        catch {
2485                                set fd [open [gitdir remotes $r] r]
2486                                while {[gets $fd n] >= 0} {
2487                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2488                                                set enable 1
2489                                                break
2490                                        }
2491                                }
2492                                close $fd
2493                        }
2494                }
2495
2496                if {$enable} {
2497                        if {!$fast_count} {
2498                                $m add separator
2499                        }
2500                        $m add command \
2501                                -label "Push to $r..." \
2502                                -command [list push_to $r] \
2503                                -font font_ui
2504                        incr fast_count
2505                }
2506        }
2507}
2508
2509proc start_push_anywhere_action {w} {
2510        global push_urltype push_remote push_url push_thin push_tags
2511
2512        set r_url {}
2513        switch -- $push_urltype {
2514        remote {set r_url $push_remote}
2515        url {set r_url $push_url}
2516        }
2517        if {$r_url eq {}} return
2518
2519        set cmd [list git push]
2520        lappend cmd -v
2521        if {$push_thin} {
2522                lappend cmd --thin
2523        }
2524        if {$push_tags} {
2525                lappend cmd --tags
2526        }
2527        lappend cmd $r_url
2528        set cnt 0
2529        foreach i [$w.source.l curselection] {
2530                set b [$w.source.l get $i]
2531                lappend cmd "refs/heads/$b:refs/heads/$b"
2532                incr cnt
2533        }
2534        if {$cnt == 0} {
2535                return
2536        } elseif {$cnt == 1} {
2537                set unit branch
2538        } else {
2539                set unit branches
2540        }
2541
2542        set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2543        console_exec $cons $cmd console_done
2544        destroy $w
2545}
2546
2547trace add variable push_remote write \
2548        [list radio_selector push_urltype remote]
2549
2550proc do_push_anywhere {} {
2551        global all_heads all_remotes current_branch
2552        global push_urltype push_remote push_url push_thin push_tags
2553
2554        set w .push_setup
2555        toplevel $w
2556        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2557
2558        label $w.header -text {Push Branches} -font font_uibold
2559        pack $w.header -side top -fill x
2560
2561        frame $w.buttons
2562        button $w.buttons.create -text Push \
2563                -font font_ui \
2564                -command [list start_push_anywhere_action $w]
2565        pack $w.buttons.create -side right
2566        button $w.buttons.cancel -text {Cancel} \
2567                -font font_ui \
2568                -command [list destroy $w]
2569        pack $w.buttons.cancel -side right -padx 5
2570        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2571
2572        labelframe $w.source \
2573                -text {Source Branches} \
2574                -font font_ui
2575        listbox $w.source.l \
2576                -height 10 \
2577                -width 70 \
2578                -selectmode extended \
2579                -yscrollcommand [list $w.source.sby set] \
2580                -font font_ui
2581        foreach h $all_heads {
2582                $w.source.l insert end $h
2583                if {$h eq $current_branch} {
2584                        $w.source.l select set end
2585                }
2586        }
2587        scrollbar $w.source.sby -command [list $w.source.l yview]
2588        pack $w.source.sby -side right -fill y
2589        pack $w.source.l -side left -fill both -expand 1
2590        pack $w.source -fill both -expand 1 -pady 5 -padx 5
2591
2592        labelframe $w.dest \
2593                -text {Destination Repository} \
2594                -font font_ui
2595        if {$all_remotes ne {}} {
2596                radiobutton $w.dest.remote_r \
2597                        -text {Remote:} \
2598                        -value remote \
2599                        -variable push_urltype \
2600                        -font font_ui
2601                eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2602                grid $w.dest.remote_r $w.dest.remote_m -sticky w
2603                if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2604                        set push_remote origin
2605                } else {
2606                        set push_remote [lindex $all_remotes 0]
2607                }
2608                set push_urltype remote
2609        } else {
2610                set push_urltype url
2611        }
2612        radiobutton $w.dest.url_r \
2613                -text {Arbitrary URL:} \
2614                -value url \
2615                -variable push_urltype \
2616                -font font_ui
2617        entry $w.dest.url_t \
2618                -borderwidth 1 \
2619                -relief sunken \
2620                -width 50 \
2621                -textvariable push_url \
2622                -font font_ui \
2623                -validate key \
2624                -validatecommand {
2625                        if {%d == 1 && [regexp {\s} %S]} {return 0}
2626                        if {%d == 1 && [string length %S] > 0} {
2627                                set push_urltype url
2628                        }
2629                        return 1
2630                }
2631        grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2632        grid columnconfigure $w.dest 1 -weight 1
2633        pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2634
2635        labelframe $w.options \
2636                -text {Transfer Options} \
2637                -font font_ui
2638        checkbutton $w.options.thin \
2639                -text {Use thin pack (for slow network connections)} \
2640                -variable push_thin \
2641                -font font_ui
2642        grid $w.options.thin -columnspan 2 -sticky w
2643        checkbutton $w.options.tags \
2644                -text {Include tags} \
2645                -variable push_tags \
2646                -font font_ui
2647        grid $w.options.tags -columnspan 2 -sticky w
2648        grid columnconfigure $w.options 1 -weight 1
2649        pack $w.options -anchor nw -fill x -pady 5 -padx 5
2650
2651        set push_url {}
2652        set push_thin 0
2653        set push_tags 0
2654
2655        bind $w <Visibility> "grab $w"
2656        bind $w <Key-Escape> "destroy $w"
2657        wm title $w "[appname] ([reponame]): Push"
2658        tkwait window $w
2659}
2660
2661######################################################################
2662##
2663## merge
2664
2665proc can_merge {} {
2666        global HEAD commit_type file_states
2667
2668        if {[string match amend* $commit_type]} {
2669                info_popup {Cannot merge while amending.
2670
2671You must finish amending this commit before
2672starting any type of merge.
2673}
2674                return 0
2675        }
2676
2677        if {[committer_ident] eq {}} {return 0}
2678        if {![lock_index merge]} {return 0}
2679
2680        # -- Our in memory state should match the repository.
2681        #
2682        repository_state curType curHEAD curMERGE_HEAD
2683        if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2684                info_popup {Last scanned state does not match repository state.
2685
2686Another Git program has modified this repository
2687since the last scan.  A rescan must be performed
2688before a merge can be performed.
2689
2690The rescan will be automatically started now.
2691}
2692                unlock_index
2693                rescan {set ui_status_value {Ready.}}
2694                return 0
2695        }
2696
2697        foreach path [array names file_states] {
2698                switch -glob -- [lindex $file_states($path) 0] {
2699                _O {
2700                        continue; # and pray it works!
2701                }
2702                U? {
2703                        error_popup "You are in the middle of a conflicted merge.
2704
2705File [short_path $path] has merge conflicts.
2706
2707You must resolve them, add the file, and commit to
2708complete the current merge.  Only then can you
2709begin another merge.
2710"
2711                        unlock_index
2712                        return 0
2713                }
2714                ?? {
2715                        error_popup "You are in the middle of a change.
2716
2717File [short_path $path] is modified.
2718
2719You should complete the current commit before
2720starting a merge.  Doing so will help you abort
2721a failed merge, should the need arise.
2722"
2723                        unlock_index
2724                        return 0
2725                }
2726                }
2727        }
2728
2729        return 1
2730}
2731
2732proc visualize_local_merge {w} {
2733        set revs {}
2734        foreach i [$w.source.l curselection] {
2735                lappend revs [$w.source.l get $i]
2736        }
2737        if {$revs eq {}} return
2738        lappend revs --not HEAD
2739        do_gitk $revs
2740}
2741
2742proc start_local_merge_action {w} {
2743        global HEAD ui_status_value current_branch
2744
2745        set cmd [list git merge]
2746        set names {}
2747        set revcnt 0
2748        foreach i [$w.source.l curselection] {
2749                set b [$w.source.l get $i]
2750                lappend cmd $b
2751                lappend names $b
2752                incr revcnt
2753        }
2754
2755        if {$revcnt == 0} {
2756                return
2757        } elseif {$revcnt == 1} {
2758                set unit branch
2759        } elseif {$revcnt <= 15} {
2760                set unit branches
2761        } else {
2762                tk_messageBox \
2763                        -icon error \
2764                        -type ok \
2765                        -title [wm title $w] \
2766                        -parent $w \
2767                        -message "Too many branches selected.
2768
2769You have requested to merge $revcnt branches
2770in an octopus merge.  This exceeds Git's
2771internal limit of 15 branches per merge.
2772
2773Please select fewer branches.  To merge more
2774than 15 branches, merge the branches in batches.
2775"
2776                return
2777        }
2778
2779        set msg "Merging $current_branch, [join $names {, }]"
2780        set ui_status_value "$msg..."
2781        set cons [new_console "Merge" $msg]
2782        console_exec $cons $cmd [list finish_merge $revcnt]
2783        bind $w <Destroy> {}
2784        destroy $w
2785}
2786
2787proc finish_merge {revcnt w ok} {
2788        console_done $w $ok
2789        if {$ok} {
2790                set msg {Merge completed successfully.}
2791        } else {
2792                if {$revcnt != 1} {
2793                        info_popup "Octopus merge failed.
2794
2795Your merge of $revcnt branches has failed.
2796
2797There are file-level conflicts between the
2798branches which must be resolved manually.
2799
2800The working directory will now be reset.
2801
2802You can attempt this merge again
2803by merging only one branch at a time." $w
2804
2805                        set fd [open "| git read-tree --reset -u HEAD" r]
2806                        fconfigure $fd -blocking 0 -translation binary
2807                        fileevent $fd readable [list reset_hard_wait $fd]
2808                        set ui_status_value {Aborting... please wait...}
2809                        return
2810                }
2811
2812                set msg {Merge failed.  Conflict resolution is required.}
2813        }
2814        unlock_index
2815        rescan [list set ui_status_value $msg]
2816}
2817
2818proc do_local_merge {} {
2819        global current_branch
2820
2821        if {![can_merge]} return
2822
2823        set w .merge_setup
2824        toplevel $w
2825        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2826
2827        label $w.header \
2828                -text "Merge Into $current_branch" \
2829                -font font_uibold
2830        pack $w.header -side top -fill x
2831
2832        frame $w.buttons
2833        button $w.buttons.visualize -text Visualize \
2834                -font font_ui \
2835                -command [list visualize_local_merge $w]
2836        pack $w.buttons.visualize -side left
2837        button $w.buttons.create -text Merge \
2838                -font font_ui \
2839                -command [list start_local_merge_action $w]
2840        pack $w.buttons.create -side right
2841        button $w.buttons.cancel -text {Cancel} \
2842                -font font_ui \
2843                -command [list destroy $w]
2844        pack $w.buttons.cancel -side right -padx 5
2845        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2846
2847        labelframe $w.source \
2848                -text {Source Branches} \
2849                -font font_ui
2850        listbox $w.source.l \
2851                -height 10 \
2852                -width 70 \
2853                -selectmode extended \
2854                -yscrollcommand [list $w.source.sby set] \
2855                -font font_ui
2856        scrollbar $w.source.sby -command [list $w.source.l yview]
2857        pack $w.source.sby -side right -fill y
2858        pack $w.source.l -side left -fill both -expand 1
2859        pack $w.source -fill both -expand 1 -pady 5 -padx 5
2860
2861        set cmd [list git for-each-ref]
2862        lappend cmd {--format=%(objectname) %(refname)}
2863        lappend cmd refs/heads
2864        lappend cmd refs/remotes
2865        set fr_fd [open "| $cmd" r]
2866        fconfigure $fr_fd -translation binary
2867        while {[gets $fr_fd line] > 0} {
2868                set line [split $line { }]
2869                set sha1([lindex $line 0]) [lindex $line 1]
2870        }
2871        close $fr_fd
2872
2873        set to_show {}
2874        set fr_fd [open "| git rev-list --all --not HEAD"]
2875        while {[gets $fr_fd line] > 0} {
2876                if {[catch {set ref $sha1($line)}]} continue
2877                regsub ^refs/(heads|remotes)/ $ref {} ref
2878                lappend to_show $ref
2879        }
2880        close $fr_fd
2881
2882        foreach ref [lsort -unique $to_show] {
2883                $w.source.l insert end $ref
2884        }
2885
2886        bind $w <Visibility> "grab $w"
2887        bind $w <Key-Escape> "unlock_index;destroy $w"
2888        bind $w <Destroy> unlock_index
2889        wm title $w "[appname] ([reponame]): Merge"
2890        tkwait window $w
2891}
2892
2893proc do_reset_hard {} {
2894        global HEAD commit_type file_states
2895
2896        if {[string match amend* $commit_type]} {
2897                info_popup {Cannot abort while amending.
2898
2899You must finish amending this commit.
2900}
2901                return
2902        }
2903
2904        if {![lock_index abort]} return
2905
2906        if {[string match *merge* $commit_type]} {
2907                set op merge
2908        } else {
2909                set op commit
2910        }
2911
2912        if {[ask_popup "Abort $op?
2913
2914Aborting the current $op will cause
2915*ALL* uncommitted changes to be lost.
2916
2917Continue with aborting the current $op?"] eq {yes}} {
2918                set fd [open "| git read-tree --reset -u HEAD" r]
2919                fconfigure $fd -blocking 0 -translation binary
2920                fileevent $fd readable [list reset_hard_wait $fd]
2921                set ui_status_value {Aborting... please wait...}
2922        } else {
2923                unlock_index
2924        }
2925}
2926
2927proc reset_hard_wait {fd} {
2928        global ui_comm
2929
2930        read $fd
2931        if {[eof $fd]} {
2932                close $fd
2933                unlock_index
2934
2935                $ui_comm delete 0.0 end
2936                $ui_comm edit modified false
2937
2938                catch {file delete [gitdir MERGE_HEAD]}
2939                catch {file delete [gitdir rr-cache MERGE_RR]}
2940                catch {file delete [gitdir SQUASH_MSG]}
2941                catch {file delete [gitdir MERGE_MSG]}
2942                catch {file delete [gitdir GITGUI_MSG]}
2943
2944                rescan {set ui_status_value {Abort completed.  Ready.}}
2945        }
2946}
2947
2948######################################################################
2949##
2950## browser
2951
2952set next_browser_id 0
2953
2954proc new_browser {commit} {
2955        global next_browser_id cursor_ptr
2956        global browser_commit browser_status browser_stack browser_path browser_busy
2957
2958        set w .browser[incr next_browser_id]
2959        set w_list $w.list.l
2960        set browser_commit($w_list) $commit
2961        set browser_status($w_list) {Starting...}
2962        set browser_stack($w_list) {}
2963        set browser_path($w_list) $browser_commit($w_list):
2964        set browser_busy($w_list) 1
2965
2966        toplevel $w
2967        label $w.path -textvariable browser_path($w_list) \
2968                -anchor w \
2969                -justify left \
2970                -borderwidth 1 \
2971                -relief sunken \
2972                -font font_uibold
2973        pack $w.path -anchor w -side top -fill x
2974
2975        frame $w.list
2976        text $w_list -background white -borderwidth 0 \
2977                -cursor $cursor_ptr \
2978                -state disabled \
2979                -wrap none \
2980                -height 20 \
2981                -width 70 \
2982                -xscrollcommand [list $w.list.sbx set] \
2983                -yscrollcommand [list $w.list.sby set] \
2984                -font font_ui
2985        $w_list tag conf in_sel \
2986                -background [$w_list cget -foreground] \
2987                -foreground [$w_list cget -background]
2988        scrollbar $w.list.sbx -orient h -command [list $w_list xview]
2989        scrollbar $w.list.sby -orient v -command [list $w_list yview]
2990        pack $w.list.sbx -side bottom -fill x
2991        pack $w.list.sby -side right -fill y
2992        pack $w_list -side left -fill both -expand 1
2993        pack $w.list -side top -fill both -expand 1
2994
2995        label $w.status -textvariable browser_status($w_list) \
2996                -anchor w \
2997                -justify left \
2998                -borderwidth 1 \
2999                -relief sunken \
3000                -font font_ui
3001        pack $w.status -anchor w -side bottom -fill x
3002
3003        bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
3004        bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3005
3006        bind $w <Visibility> "focus $w"
3007        bind $w <Destroy> "
3008                array unset browser_buffer $w_list
3009                array unset browser_files $w_list
3010                array unset browser_status $w_list
3011                array unset browser_stack $w_list
3012                array unset browser_path $w_list
3013                array unset browser_commit $w_list
3014                array unset browser_busy $w_list
3015        "
3016        wm title $w "[appname] ([reponame]): File Browser"
3017        ls_tree $w_list $browser_commit($w_list) {}
3018}
3019
3020proc browser_click {was_double_click w pos} {
3021        global browser_files browser_status browser_path
3022        global browser_commit browser_stack browser_busy
3023
3024        if {$browser_busy($w)} return
3025        set lno [lindex [split [$w index $pos] .] 0]
3026        set info [lindex $browser_files($w) [expr {$lno - 1}]]
3027
3028        $w conf -state normal
3029        $w tag remove sel 0.0 end
3030        $w tag remove in_sel 0.0 end
3031        if {$info ne {}} {
3032                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3033                if {$was_double_click} {
3034                        switch -- [lindex $info 0] {
3035                        parent {
3036                                set parent [lindex $browser_stack($w) end-1]
3037                                set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3038                                if {$browser_stack($w) eq {}} {
3039                                        regsub {:.*$} $browser_path($w) {:} browser_path($w)
3040                                } else {
3041                                        regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3042                                }
3043                                set browser_status($w) "Loading $browser_path($w)..."
3044                                ls_tree $w [lindex $parent 0] [lindex $parent 1]
3045                        }
3046                        tree {
3047                                set name [lindex $info 2]
3048                                set escn [escape_path $name]
3049                                set browser_status($w) "Loading $escn..."
3050                                append browser_path($w) $escn
3051                                ls_tree $w [lindex $info 1] $name
3052                        }
3053                        blob {
3054                                set name [lindex $info 2]
3055                                set p {}
3056                                foreach n $browser_stack($w) {
3057                                        append p [lindex $n 1]
3058                                }
3059                                append p $name
3060                                show_blame $browser_commit($w) $p
3061                        }
3062                        }
3063                }
3064        }
3065        $w conf -state disabled
3066}
3067
3068proc ls_tree {w tree_id name} {
3069        global browser_buffer browser_files browser_stack browser_busy
3070
3071        set browser_buffer($w) {}
3072        set browser_files($w) {}
3073        set browser_busy($w) 1
3074
3075        $w conf -state normal
3076        $w tag remove in_sel 0.0 end
3077        $w tag remove sel 0.0 end
3078        $w delete 0.0 end
3079        if {$browser_stack($w) ne {}} {
3080                $w image create end \
3081                        -align center -padx 5 -pady 1 \
3082                        -name icon0 \
3083                        -image file_uplevel
3084                $w insert end {[Up To Parent]}
3085                lappend browser_files($w) parent
3086        }
3087        lappend browser_stack($w) [list $tree_id $name]
3088        $w conf -state disabled
3089
3090        set cmd [list git ls-tree -z $tree_id]
3091        set fd [open "| $cmd" r]
3092        fconfigure $fd -blocking 0 -translation binary -encoding binary
3093        fileevent $fd readable [list read_ls_tree $fd $w]
3094}
3095
3096proc read_ls_tree {fd w} {
3097        global browser_buffer browser_files browser_status browser_busy
3098
3099        if {![winfo exists $w]} {
3100                catch {close $fd}
3101                return
3102        }
3103
3104        append browser_buffer($w) [read $fd]
3105        set pck [split $browser_buffer($w) "\0"]
3106        set browser_buffer($w) [lindex $pck end]
3107
3108        set n [llength $browser_files($w)]
3109        $w conf -state normal
3110        foreach p [lrange $pck 0 end-1] {
3111                set info [split $p "\t"]
3112                set path [lindex $info 1]
3113                set info [split [lindex $info 0] { }]
3114                set type [lindex $info 1]
3115                set object [lindex $info 2]
3116
3117                switch -- $type {
3118                blob {
3119                        set image file_mod
3120                }
3121                tree {
3122                        set image file_dir
3123                        append path /
3124                }
3125                default {
3126                        set image file_question
3127                }
3128                }
3129
3130                if {$n > 0} {$w insert end "\n"}
3131                $w image create end \
3132                        -align center -padx 5 -pady 1 \
3133                        -name icon[incr n] \
3134                        -image $image
3135                $w insert end [escape_path $path]
3136                lappend browser_files($w) [list $type $object $path]
3137        }
3138        $w conf -state disabled
3139
3140        if {[eof $fd]} {
3141                close $fd
3142                set browser_status($w) Ready.
3143                set browser_busy($w) 0
3144                array unset browser_buffer $w
3145        }
3146}
3147
3148proc show_blame {commit path} {
3149        global next_browser_id blame_status blame_data
3150
3151        set w .browser[incr next_browser_id]
3152        set blame_status($w) {Loading current file content...}
3153        set texts [list]
3154
3155        toplevel $w
3156
3157        label $w.path -text "$commit:$path" \
3158                -anchor w \
3159                -justify left \
3160                -borderwidth 1 \
3161                -relief sunken \
3162                -font font_uibold
3163        pack $w.path -side top -fill x
3164
3165        set hbg #e2effa
3166        frame $w.out
3167        label $w.out.commit_l -text Commit \
3168                -relief solid \
3169                -borderwidth 1 \
3170                -background $hbg \
3171                -font font_uibold
3172        text $w.out.commit_t \
3173                -background white -borderwidth 0 \
3174                -state disabled \
3175                -wrap none \
3176                -height 40 \
3177                -width 9 \
3178                -font font_diff
3179        lappend texts $w.out.commit_t
3180
3181        label $w.out.author_l -text Author \
3182                -relief solid \
3183                -borderwidth 1 \
3184                -background $hbg \
3185                -font font_uibold
3186        text $w.out.author_t \
3187                -background white -borderwidth 0 \
3188                -state disabled \
3189                -wrap none \
3190                -height 40 \
3191                -width 20 \
3192                -font font_diff
3193        lappend texts $w.out.author_t
3194
3195        label $w.out.date_l -text Date \
3196                -relief solid \
3197                -borderwidth 1 \
3198                -background $hbg \
3199                -font font_uibold
3200        text $w.out.date_t \
3201                -background white -borderwidth 0 \
3202                -state disabled \
3203                -wrap none \
3204                -height 40 \
3205                -width [string length "yyyy-mm-dd hh:mm:ss"] \
3206                -font font_diff
3207        lappend texts $w.out.date_t
3208
3209        label $w.out.filename_l -text Filename \
3210                -relief solid \
3211                -borderwidth 1 \
3212                -background $hbg \
3213                -font font_uibold
3214        text $w.out.filename_t \
3215                -background white -borderwidth 0 \
3216                -state disabled \
3217                -wrap none \
3218                -height 40 \
3219                -width 20 \
3220                -font font_diff
3221        lappend texts $w.out.filename_t
3222
3223        label $w.out.origlinenumber_l -text {Orig Line} \
3224                -relief solid \
3225                -borderwidth 1 \
3226                -background $hbg \
3227                -font font_uibold
3228        text $w.out.origlinenumber_t \
3229                -background white -borderwidth 0 \
3230                -state disabled \
3231                -wrap none \
3232                -height 40 \
3233                -width 5 \
3234                -font font_diff
3235        $w.out.origlinenumber_t tag conf linenumber -justify right
3236        lappend texts $w.out.origlinenumber_t
3237
3238        label $w.out.linenumber_l -text {Curr Line} \
3239                -relief solid \
3240                -borderwidth 1 \
3241                -background $hbg \
3242                -font font_uibold
3243        text $w.out.linenumber_t \
3244                -background white -borderwidth 0 \
3245                -state disabled \
3246                -wrap none \
3247                -height 40 \
3248                -width 5 \
3249                -font font_diff
3250        $w.out.linenumber_t tag conf linenumber -justify right
3251        lappend texts $w.out.linenumber_t
3252
3253        label $w.out.file_l -text {File Content} \
3254                -relief solid \
3255                -borderwidth 1 \
3256                -background $hbg \
3257                -font font_uibold
3258        text $w.out.file_t \
3259                -background white -borderwidth 0 \
3260                -state disabled \
3261                -wrap none \
3262                -height 40 \
3263                -width 80 \
3264                -xscrollcommand [list $w.out.sbx set] \
3265                -font font_diff
3266        lappend texts $w.out.file_t
3267
3268        scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3269        scrollbar $w.out.sby -orient v \
3270                -command [list scrollbar2many $texts yview]
3271        set labels [list]
3272        foreach i $texts {
3273                regsub {_t$} $i _l l
3274                lappend labels $l
3275        }
3276        set file_col [expr {[llength $texts] - 1}]
3277        eval grid $labels -sticky we
3278        eval grid $texts $w.out.sby -sticky nsew
3279        grid conf $w.out.sbx -column $file_col -sticky we
3280        grid columnconfigure $w.out $file_col -weight 1
3281        grid rowconfigure $w.out 1 -weight 1
3282        pack $w.out -fill both -expand 1
3283
3284        label $w.status -textvariable blame_status($w) \
3285                -anchor w \
3286                -justify left \
3287                -borderwidth 1 \
3288                -relief sunken \
3289                -font font_ui
3290        pack $w.status -side bottom -fill x
3291
3292        menu $w.ctxm -tearoff 0
3293        $w.ctxm add command -label "Copy Commit" \
3294                -font font_ui \
3295                -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3296
3297        foreach i $texts {
3298                $i tag conf in_sel \
3299                        -background [$i cget -foreground] \
3300                        -foreground [$i cget -background]
3301                $i conf -yscrollcommand \
3302                        [list many2scrollbar $texts yview $w.out.sby]
3303                bind $i <Button-1> "blame_highlight $i @%x,%y $texts;break"
3304                bind_button3 $i "
3305                        set cursorX %x
3306                        set cursorY %y
3307                        set cursorW %W
3308                        tk_popup $w.ctxm %X %Y
3309                "
3310        }
3311
3312        bind $w <Visibility> "focus $w"
3313        bind $w <Destroy> "
3314                array unset blame_status $w
3315                array unset blame_data $w,*
3316        "
3317        wm title $w "[appname] ([reponame]): File Viewer"
3318
3319        set blame_data($w,total_lines) 0
3320        set cmd [list git cat-file blob "$commit:$path"]
3321        set fd [open "| $cmd" r]
3322        fconfigure $fd -blocking 0 -translation lf -encoding binary
3323        fileevent $fd readable [list read_blame_catfile \
3324                $fd $w $commit $path \
3325                $texts $w.out.linenumber_t $w.out.file_t]
3326}
3327
3328proc read_blame_catfile {fd w commit path texts w_lno w_file} {
3329        global blame_status blame_data
3330
3331        if {![winfo exists $w_file]} {
3332                catch {close $fd}
3333                return
3334        }
3335
3336        set n $blame_data($w,total_lines)
3337        foreach i $texts {$i conf -state normal}
3338        while {[gets $fd line] >= 0} {
3339                regsub "\r\$" $line {} line
3340                incr n
3341                $w_lno insert end $n linenumber
3342                $w_file insert end $line
3343                foreach i $texts {$i insert end "\n"}
3344        }
3345        foreach i $texts {$i conf -state disabled}
3346        set blame_data($w,total_lines) $n
3347
3348        if {[eof $fd]} {
3349                close $fd
3350                set blame_status($w) {Loading annotations...}
3351                set cmd [list git blame -M -C --incremental]
3352                lappend cmd $commit -- $path
3353                set fd [open "| $cmd" r]
3354                fconfigure $fd -blocking 0 -translation lf -encoding binary
3355                fileevent $fd readable "read_blame_incremental $fd $w $texts"
3356        }
3357}
3358
3359proc read_blame_incremental {fd w
3360        w_commit w_author w_date w_filename w_olno
3361        w_lno w_file} {
3362        global blame_status blame_data
3363
3364        if {![winfo exists $w_commit]} {
3365                catch {close $fd}
3366                return
3367        }
3368
3369        $w_commit conf -state normal
3370        $w_author conf -state normal
3371        $w_date conf -state normal
3372        $w_filename conf -state normal
3373        $w_olno conf -state normal
3374
3375        while {[gets $fd line] >= 0} {
3376                if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3377                        commit original_line final_line line_count]} {
3378                        set blame_data($w,commit) $commit
3379                        set blame_data($w,original_line) $original_line
3380                        set blame_data($w,final_line) $final_line
3381                        set blame_data($w,line_count) $line_count
3382                } elseif {[string match {filename *} $line]} {
3383                        set n $blame_data($w,line_count)
3384                        set lno $blame_data($w,final_line)
3385                        set ol $blame_data($w,original_line)
3386                        set file [string range $line 9 end]
3387                        set commit $blame_data($w,commit)
3388                        set abbrev [string range $commit 0 8]
3389
3390                        if {[catch {set author $blame_data($w,$commit,author)} err]} {
3391                        puts $err
3392                                set author {}
3393                        }
3394
3395                        if {[catch {set atime $blame_data($w,$commit,author-time)}]} {
3396                                set atime {}
3397                        } else {
3398                                set atime [clock format $atime -format {%Y-%m-%d %T}]
3399                        }
3400
3401                        while {$n > 0} {
3402                                $w_commit delete $lno.0 "$lno.0 lineend"
3403                                $w_author delete $lno.0 "$lno.0 lineend"
3404                                $w_date delete $lno.0 "$lno.0 lineend"
3405                                $w_filename delete $lno.0 "$lno.0 lineend"
3406                                $w_olno delete $lno.0 "$lno.0 lineend"
3407
3408                                $w_commit insert $lno.0 $abbrev
3409                                $w_author insert $lno.0 $author
3410                                $w_date insert $lno.0 $atime
3411                                $w_filename insert $lno.0 $file
3412                                $w_olno insert $lno.0 $ol linenumber
3413
3414                                set blame_data($w,line$lno,commit) $commit
3415
3416                                incr n -1
3417                                incr lno
3418                                incr ol
3419                        }
3420                } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3421                        set blame_data($w,$blame_data($w,commit),$header) $data
3422                }
3423        }
3424
3425        $w_commit conf -state disabled
3426        $w_author conf -state disabled
3427        $w_date conf -state disabled
3428        $w_filename conf -state disabled
3429        $w_olno conf -state disabled
3430
3431        if {[eof $fd]} {
3432                close $fd
3433                set blame_status($w) {Annotation complete.}
3434        }
3435}
3436
3437proc blame_highlight {w pos args} {
3438        set lno [lindex [split [$w index $pos] .] 0]
3439        foreach i $args {
3440                $i tag remove in_sel 0.0 end
3441        }
3442        if {$lno eq {}} return
3443        foreach i $args {
3444                $i tag add in_sel $lno.0 "$lno.0 + 1 line"
3445        }
3446}
3447
3448proc blame_copycommit {w i pos} {
3449        global blame_data
3450        set lno [lindex [split [$i index $pos] .] 0]
3451        if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3452                clipboard clear
3453                clipboard append \
3454                        -format STRING \
3455                        -type STRING \
3456                        -- $commit
3457        }
3458}
3459
3460######################################################################
3461##
3462## icons
3463
3464set filemask {
3465#define mask_width 14
3466#define mask_height 15
3467static unsigned char mask_bits[] = {
3468   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3469   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3470   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3471}
3472
3473image create bitmap file_plain -background white -foreground black -data {
3474#define plain_width 14
3475#define plain_height 15
3476static unsigned char plain_bits[] = {
3477   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3478   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3479   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3480} -maskdata $filemask
3481
3482image create bitmap file_mod -background white -foreground blue -data {
3483#define mod_width 14
3484#define mod_height 15
3485static unsigned char mod_bits[] = {
3486   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3487   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3488   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3489} -maskdata $filemask
3490
3491image create bitmap file_fulltick -background white -foreground "#007000" -data {
3492#define file_fulltick_width 14
3493#define file_fulltick_height 15
3494static unsigned char file_fulltick_bits[] = {
3495   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3496   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3497   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3498} -maskdata $filemask
3499
3500image create bitmap file_parttick -background white -foreground "#005050" -data {
3501#define parttick_width 14
3502#define parttick_height 15
3503static unsigned char parttick_bits[] = {
3504   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3505   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3506   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3507} -maskdata $filemask
3508
3509image create bitmap file_question -background white -foreground black -data {
3510#define file_question_width 14
3511#define file_question_height 15
3512static unsigned char file_question_bits[] = {
3513   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3514   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3515   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3516} -maskdata $filemask
3517
3518image create bitmap file_removed -background white -foreground red -data {
3519#define file_removed_width 14
3520#define file_removed_height 15
3521static unsigned char file_removed_bits[] = {
3522   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3523   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3524   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3525} -maskdata $filemask
3526
3527image create bitmap file_merge -background white -foreground blue -data {
3528#define file_merge_width 14
3529#define file_merge_height 15
3530static unsigned char file_merge_bits[] = {
3531   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3532   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3533   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3534} -maskdata $filemask
3535
3536set file_dir_data {
3537#define file_width 18
3538#define file_height 18
3539static unsigned char file_bits[] = {
3540  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3541  0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3542  0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3543  0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3544  0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3545}
3546image create bitmap file_dir -background white -foreground blue \
3547        -data $file_dir_data -maskdata $file_dir_data
3548unset file_dir_data
3549
3550set file_uplevel_data {
3551#define up_width 15
3552#define up_height 15
3553static unsigned char up_bits[] = {
3554  0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3555  0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3556  0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3557}
3558image create bitmap file_uplevel -background white -foreground red \
3559        -data $file_uplevel_data -maskdata $file_uplevel_data
3560unset file_uplevel_data
3561
3562set ui_index .vpane.files.index.list
3563set ui_workdir .vpane.files.workdir.list
3564
3565set all_icons(_$ui_index)   file_plain
3566set all_icons(A$ui_index)   file_fulltick
3567set all_icons(M$ui_index)   file_fulltick
3568set all_icons(D$ui_index)   file_removed
3569set all_icons(U$ui_index)   file_merge
3570
3571set all_icons(_$ui_workdir) file_plain
3572set all_icons(M$ui_workdir) file_mod
3573set all_icons(D$ui_workdir) file_question
3574set all_icons(U$ui_workdir) file_merge
3575set all_icons(O$ui_workdir) file_plain
3576
3577set max_status_desc 0
3578foreach i {
3579                {__ "Unmodified"}
3580
3581                {_M "Modified, not staged"}
3582                {M_ "Staged for commit"}
3583                {MM "Portions staged for commit"}
3584                {MD "Staged for commit, missing"}
3585
3586                {_O "Untracked, not staged"}
3587                {A_ "Staged for commit"}
3588                {AM "Portions staged for commit"}
3589                {AD "Staged for commit, missing"}
3590
3591                {_D "Missing"}
3592                {D_ "Staged for removal"}
3593                {DO "Staged for removal, still present"}
3594
3595                {U_ "Requires merge resolution"}
3596                {UU "Requires merge resolution"}
3597                {UM "Requires merge resolution"}
3598                {UD "Requires merge resolution"}
3599        } {
3600        if {$max_status_desc < [string length [lindex $i 1]]} {
3601                set max_status_desc [string length [lindex $i 1]]
3602        }
3603        set all_descs([lindex $i 0]) [lindex $i 1]
3604}
3605unset i
3606
3607######################################################################
3608##
3609## util
3610
3611proc bind_button3 {w cmd} {
3612        bind $w <Any-Button-3> $cmd
3613        if {[is_MacOSX]} {
3614                bind $w <Control-Button-1> $cmd
3615        }
3616}
3617
3618proc scrollbar2many {list mode args} {
3619        foreach w $list {eval $w $mode $args}
3620}
3621
3622proc many2scrollbar {list mode sb top bottom} {
3623        $sb set $top $bottom
3624        foreach w $list {$w $mode moveto $top}
3625}
3626
3627proc incr_font_size {font {amt 1}} {
3628        set sz [font configure $font -size]
3629        incr sz $amt
3630        font configure $font -size $sz
3631        font configure ${font}bold -size $sz
3632}
3633
3634proc hook_failed_popup {hook msg} {
3635        set w .hookfail
3636        toplevel $w
3637
3638        frame $w.m
3639        label $w.m.l1 -text "$hook hook failed:" \
3640                -anchor w \
3641                -justify left \
3642                -font font_uibold
3643        text $w.m.t \
3644                -background white -borderwidth 1 \
3645                -relief sunken \
3646                -width 80 -height 10 \
3647                -font font_diff \
3648                -yscrollcommand [list $w.m.sby set]
3649        label $w.m.l2 \
3650                -text {You must correct the above errors before committing.} \
3651                -anchor w \
3652                -justify left \
3653                -font font_uibold
3654        scrollbar $w.m.sby -command [list $w.m.t yview]
3655        pack $w.m.l1 -side top -fill x
3656        pack $w.m.l2 -side bottom -fill x
3657        pack $w.m.sby -side right -fill y
3658        pack $w.m.t -side left -fill both -expand 1
3659        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3660
3661        $w.m.t insert 1.0 $msg
3662        $w.m.t conf -state disabled
3663
3664        button $w.ok -text OK \
3665                -width 15 \
3666                -font font_ui \
3667                -command "destroy $w"
3668        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3669
3670        bind $w <Visibility> "grab $w; focus $w"
3671        bind $w <Key-Return> "destroy $w"
3672        wm title $w "[appname] ([reponame]): error"
3673        tkwait window $w
3674}
3675
3676set next_console_id 0
3677
3678proc new_console {short_title long_title} {
3679        global next_console_id console_data
3680        set w .console[incr next_console_id]
3681        set console_data($w) [list $short_title $long_title]
3682        return [console_init $w]
3683}
3684
3685proc console_init {w} {
3686        global console_cr console_data M1B
3687
3688        set console_cr($w) 1.0
3689        toplevel $w
3690        frame $w.m
3691        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3692                -anchor w \
3693                -justify left \
3694                -font font_uibold
3695        text $w.m.t \
3696                -background white -borderwidth 1 \
3697                -relief sunken \
3698                -width 80 -height 10 \
3699                -font font_diff \
3700                -state disabled \
3701                -yscrollcommand [list $w.m.sby set]
3702        label $w.m.s -text {Working... please wait...} \
3703                -anchor w \
3704                -justify left \
3705                -font font_uibold
3706        scrollbar $w.m.sby -command [list $w.m.t yview]
3707        pack $w.m.l1 -side top -fill x
3708        pack $w.m.s -side bottom -fill x
3709        pack $w.m.sby -side right -fill y
3710        pack $w.m.t -side left -fill both -expand 1
3711        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3712
3713        menu $w.ctxm -tearoff 0
3714        $w.ctxm add command -label "Copy" \
3715                -font font_ui \
3716                -command "tk_textCopy $w.m.t"
3717        $w.ctxm add command -label "Select All" \
3718                -font font_ui \
3719                -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3720        $w.ctxm add command -label "Copy All" \
3721                -font font_ui \
3722                -command "
3723                        $w.m.t tag add sel 0.0 end
3724                        tk_textCopy $w.m.t
3725                        $w.m.t tag remove sel 0.0 end
3726                "
3727
3728        button $w.ok -text {Close} \
3729                -font font_ui \
3730                -state disabled \
3731                -command "destroy $w"
3732        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3733
3734        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3735        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3736        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3737        bind $w <Visibility> "focus $w"
3738        wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3739        return $w
3740}
3741
3742proc console_exec {w cmd after} {
3743        # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3744        #    But most users need that so we have to relogin. :-(
3745        #
3746        if {[is_Cygwin]} {
3747                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3748        }
3749
3750        # -- Tcl won't let us redirect both stdout and stderr to
3751        #    the same pipe.  So pass it through cat...
3752        #
3753        set cmd [concat | $cmd |& cat]
3754
3755        set fd_f [open $cmd r]
3756        fconfigure $fd_f -blocking 0 -translation binary
3757        fileevent $fd_f readable [list console_read $w $fd_f $after]
3758}
3759
3760proc console_read {w fd after} {
3761        global console_cr
3762
3763        set buf [read $fd]
3764        if {$buf ne {}} {
3765                if {![winfo exists $w]} {console_init $w}
3766                $w.m.t conf -state normal
3767                set c 0
3768                set n [string length $buf]
3769                while {$c < $n} {
3770                        set cr [string first "\r" $buf $c]
3771                        set lf [string first "\n" $buf $c]
3772                        if {$cr < 0} {set cr [expr {$n + 1}]}
3773                        if {$lf < 0} {set lf [expr {$n + 1}]}
3774
3775                        if {$lf < $cr} {
3776                                $w.m.t insert end [string range $buf $c $lf]
3777                                set console_cr($w) [$w.m.t index {end -1c}]
3778                                set c $lf
3779                                incr c
3780                        } else {
3781                                $w.m.t delete $console_cr($w) end
3782                                $w.m.t insert end "\n"
3783                                $w.m.t insert end [string range $buf $c $cr]
3784                                set c $cr
3785                                incr c
3786                        }
3787                }
3788                $w.m.t conf -state disabled
3789                $w.m.t see end
3790        }
3791
3792        fconfigure $fd -blocking 1
3793        if {[eof $fd]} {
3794                if {[catch {close $fd}]} {
3795                        set ok 0
3796                } else {
3797                        set ok 1
3798                }
3799                uplevel #0 $after $w $ok
3800                return
3801        }
3802        fconfigure $fd -blocking 0
3803}
3804
3805proc console_chain {cmdlist w {ok 1}} {
3806        if {$ok} {
3807                if {[llength $cmdlist] == 0} {
3808                        console_done $w $ok
3809                        return
3810                }
3811
3812                set cmd [lindex $cmdlist 0]
3813                set cmdlist [lrange $cmdlist 1 end]
3814
3815                if {[lindex $cmd 0] eq {console_exec}} {
3816                        console_exec $w \
3817                                [lindex $cmd 1] \
3818                                [list console_chain $cmdlist]
3819                } else {
3820                        uplevel #0 $cmd $cmdlist $w $ok
3821                }
3822        } else {
3823                console_done $w $ok
3824        }
3825}
3826
3827proc console_done {args} {
3828        global console_cr console_data
3829
3830        switch -- [llength $args] {
3831        2 {
3832                set w [lindex $args 0]
3833                set ok [lindex $args 1]
3834        }
3835        3 {
3836                set w [lindex $args 1]
3837                set ok [lindex $args 2]
3838        }
3839        default {
3840                error "wrong number of args: console_done ?ignored? w ok"
3841        }
3842        }
3843
3844        if {$ok} {
3845                if {[winfo exists $w]} {
3846                        $w.m.s conf -background green -text {Success}
3847                        $w.ok conf -state normal
3848                }
3849        } else {
3850                if {![winfo exists $w]} {
3851                        console_init $w
3852                }
3853                $w.m.s conf -background red -text {Error: Command Failed}
3854                $w.ok conf -state normal
3855        }
3856
3857        array unset console_cr $w
3858        array unset console_data $w
3859}
3860
3861######################################################################
3862##
3863## ui commands
3864
3865set starting_gitk_msg {Starting gitk... please wait...}
3866
3867proc do_gitk {revs} {
3868        global env ui_status_value starting_gitk_msg
3869
3870        # -- On Windows gitk is severly broken, and right now it seems like
3871        #    nobody cares about fixing it.  The only known workaround is to
3872        #    always delete ~/.gitk before starting the program.
3873        #
3874        if {[is_Windows]} {
3875                catch {file delete [file join $env(HOME) .gitk]}
3876        }
3877
3878        # -- Always start gitk through whatever we were loaded with.  This
3879        #    lets us bypass using shell process on Windows systems.
3880        #
3881        set cmd [info nameofexecutable]
3882        lappend cmd [gitexec gitk]
3883        if {$revs ne {}} {
3884                append cmd { }
3885                append cmd $revs
3886        }
3887
3888        if {[catch {eval exec $cmd &} err]} {
3889                error_popup "Failed to start gitk:\n\n$err"
3890        } else {
3891                set ui_status_value $starting_gitk_msg
3892                after 10000 {
3893                        if {$ui_status_value eq $starting_gitk_msg} {
3894                                set ui_status_value {Ready.}
3895                        }
3896                }
3897        }
3898}
3899
3900proc do_stats {} {
3901        set fd [open "| git count-objects -v" r]
3902        while {[gets $fd line] > 0} {
3903                if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
3904                        set stats($name) $value
3905                }
3906        }
3907        close $fd
3908
3909        set packed_sz 0
3910        foreach p [glob -directory [gitdir objects pack] \
3911                -type f \
3912                -nocomplain -- *] {
3913                incr packed_sz [file size $p]
3914        }
3915        if {$packed_sz > 0} {
3916                set stats(size-pack) [expr {$packed_sz / 1024}]
3917        }
3918
3919        set w .stats_view
3920        toplevel $w
3921        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3922
3923        label $w.header -text {Database Statistics} \
3924                -font font_uibold
3925        pack $w.header -side top -fill x
3926
3927        frame $w.buttons -border 1
3928        button $w.buttons.close -text Close \
3929                -font font_ui \
3930                -command [list destroy $w]
3931        button $w.buttons.gc -text {Compress Database} \
3932                -font font_ui \
3933                -command "destroy $w;do_gc"
3934        pack $w.buttons.close -side right
3935        pack $w.buttons.gc -side left
3936        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3937
3938        frame $w.stat -borderwidth 1 -relief solid
3939        foreach s {
3940                {count           {Number of loose objects}}
3941                {size            {Disk space used by loose objects} { KiB}}
3942                {in-pack         {Number of packed objects}}
3943                {packs           {Number of packs}}
3944                {size-pack       {Disk space used by packed objects} { KiB}}
3945                {prune-packable  {Packed objects waiting for pruning}}
3946                {garbage         {Garbage files}}
3947                } {
3948                set name [lindex $s 0]
3949                set label [lindex $s 1]
3950                if {[catch {set value $stats($name)}]} continue
3951                if {[llength $s] > 2} {
3952                        set value "$value[lindex $s 2]"
3953                }
3954
3955                label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
3956                label $w.stat.v_$name -text $value -anchor w -font font_ui
3957                grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
3958        }
3959        pack $w.stat -pady 10 -padx 10
3960
3961        bind $w <Visibility> "grab $w; focus $w"
3962        bind $w <Key-Escape> [list destroy $w]
3963        bind $w <Key-Return> [list destroy $w]
3964        wm title $w "[appname] ([reponame]): Database Statistics"
3965        tkwait window $w
3966}
3967
3968proc do_gc {} {
3969        set w [new_console {gc} {Compressing the object database}]
3970        console_chain {
3971                {console_exec {git pack-refs --prune}}
3972                {console_exec {git reflog expire --all}}
3973                {console_exec {git repack -a -d -l}}
3974                {console_exec {git rerere gc}}
3975        } $w
3976}
3977
3978proc do_fsck_objects {} {
3979        set w [new_console {fsck-objects} \
3980                {Verifying the object database with fsck-objects}]
3981        set cmd [list git fsck-objects]
3982        lappend cmd --full
3983        lappend cmd --cache
3984        lappend cmd --strict
3985        console_exec $w $cmd console_done
3986}
3987
3988set is_quitting 0
3989
3990proc do_quit {} {
3991        global ui_comm is_quitting repo_config commit_type
3992
3993        if {$is_quitting} return
3994        set is_quitting 1
3995
3996        # -- Stash our current commit buffer.
3997        #
3998        set save [gitdir GITGUI_MSG]
3999        set msg [string trim [$ui_comm get 0.0 end]]
4000        regsub -all -line {[ \r\t]+$} $msg {} msg
4001        if {(![string match amend* $commit_type]
4002                || [$ui_comm edit modified])
4003                && $msg ne {}} {
4004                catch {
4005                        set fd [open $save w]
4006                        puts -nonewline $fd $msg
4007                        close $fd
4008                }
4009        } else {
4010                catch {file delete $save}
4011        }
4012
4013        # -- Stash our current window geometry into this repository.
4014        #
4015        set cfg_geometry [list]
4016        lappend cfg_geometry [wm geometry .]
4017        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4018        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4019        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4020                set rc_geometry {}
4021        }
4022        if {$cfg_geometry ne $rc_geometry} {
4023                catch {exec git repo-config gui.geometry $cfg_geometry}
4024        }
4025
4026        destroy .
4027}
4028
4029proc do_rescan {} {
4030        rescan {set ui_status_value {Ready.}}
4031}
4032
4033proc unstage_helper {txt paths} {
4034        global file_states current_diff_path
4035
4036        if {![lock_index begin-update]} return
4037
4038        set pathList [list]
4039        set after {}
4040        foreach path $paths {
4041                switch -glob -- [lindex $file_states($path) 0] {
4042                A? -
4043                M? -
4044                D? {
4045                        lappend pathList $path
4046                        if {$path eq $current_diff_path} {
4047                                set after {reshow_diff;}
4048                        }
4049                }
4050                }
4051        }
4052        if {$pathList eq {}} {
4053                unlock_index
4054        } else {
4055                update_indexinfo \
4056                        $txt \
4057                        $pathList \
4058                        [concat $after {set ui_status_value {Ready.}}]
4059        }
4060}
4061
4062proc do_unstage_selection {} {
4063        global current_diff_path selected_paths
4064
4065        if {[array size selected_paths] > 0} {
4066                unstage_helper \
4067                        {Unstaging selected files from commit} \
4068                        [array names selected_paths]
4069        } elseif {$current_diff_path ne {}} {
4070                unstage_helper \
4071                        "Unstaging [short_path $current_diff_path] from commit" \
4072                        [list $current_diff_path]
4073        }
4074}
4075
4076proc add_helper {txt paths} {
4077        global file_states current_diff_path
4078
4079        if {![lock_index begin-update]} return
4080
4081        set pathList [list]
4082        set after {}
4083        foreach path $paths {
4084                switch -glob -- [lindex $file_states($path) 0] {
4085                _O -
4086                ?M -
4087                ?D -
4088                U? {
4089                        lappend pathList $path
4090                        if {$path eq $current_diff_path} {
4091                                set after {reshow_diff;}
4092                        }
4093                }
4094                }
4095        }
4096        if {$pathList eq {}} {
4097                unlock_index
4098        } else {
4099                update_index \
4100                        $txt \
4101                        $pathList \
4102                        [concat $after {set ui_status_value {Ready to commit.}}]
4103        }
4104}
4105
4106proc do_add_selection {} {
4107        global current_diff_path selected_paths
4108
4109        if {[array size selected_paths] > 0} {
4110                add_helper \
4111                        {Adding selected files} \
4112                        [array names selected_paths]
4113        } elseif {$current_diff_path ne {}} {
4114                add_helper \
4115                        "Adding [short_path $current_diff_path]" \
4116                        [list $current_diff_path]
4117        }
4118}
4119
4120proc do_add_all {} {
4121        global file_states
4122
4123        set paths [list]
4124        foreach path [array names file_states] {
4125                switch -glob -- [lindex $file_states($path) 0] {
4126                U? {continue}
4127                ?M -
4128                ?D {lappend paths $path}
4129                }
4130        }
4131        add_helper {Adding all changed files} $paths
4132}
4133
4134proc revert_helper {txt paths} {
4135        global file_states current_diff_path
4136
4137        if {![lock_index begin-update]} return
4138
4139        set pathList [list]
4140        set after {}
4141        foreach path $paths {
4142                switch -glob -- [lindex $file_states($path) 0] {
4143                U? {continue}
4144                ?M -
4145                ?D {
4146                        lappend pathList $path
4147                        if {$path eq $current_diff_path} {
4148                                set after {reshow_diff;}
4149                        }
4150                }
4151                }
4152        }
4153
4154        set n [llength $pathList]
4155        if {$n == 0} {
4156                unlock_index
4157                return
4158        } elseif {$n == 1} {
4159                set s "[short_path [lindex $pathList]]"
4160        } else {
4161                set s "these $n files"
4162        }
4163
4164        set reply [tk_dialog \
4165                .confirm_revert \
4166                "[appname] ([reponame])" \
4167                "Revert changes in $s?
4168
4169Any unadded changes will be permanently lost by the revert." \
4170                question \
4171                1 \
4172                {Do Nothing} \
4173                {Revert Changes} \
4174                ]
4175        if {$reply == 1} {
4176                checkout_index \
4177                        $txt \
4178                        $pathList \
4179                        [concat $after {set ui_status_value {Ready.}}]
4180        } else {
4181                unlock_index
4182        }
4183}
4184
4185proc do_revert_selection {} {
4186        global current_diff_path selected_paths
4187
4188        if {[array size selected_paths] > 0} {
4189                revert_helper \
4190                        {Reverting selected files} \
4191                        [array names selected_paths]
4192        } elseif {$current_diff_path ne {}} {
4193                revert_helper \
4194                        "Reverting [short_path $current_diff_path]" \
4195                        [list $current_diff_path]
4196        }
4197}
4198
4199proc do_signoff {} {
4200        global ui_comm
4201
4202        set me [committer_ident]
4203        if {$me eq {}} return
4204
4205        set sob "Signed-off-by: $me"
4206        set last [$ui_comm get {end -1c linestart} {end -1c}]
4207        if {$last ne $sob} {
4208                $ui_comm edit separator
4209                if {$last ne {}
4210                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4211                        $ui_comm insert end "\n"
4212                }
4213                $ui_comm insert end "\n$sob"
4214                $ui_comm edit separator
4215                $ui_comm see end
4216        }
4217}
4218
4219proc do_select_commit_type {} {
4220        global commit_type selected_commit_type
4221
4222        if {$selected_commit_type eq {new}
4223                && [string match amend* $commit_type]} {
4224                create_new_commit
4225        } elseif {$selected_commit_type eq {amend}
4226                && ![string match amend* $commit_type]} {
4227                load_last_commit
4228
4229                # The amend request was rejected...
4230                #
4231                if {![string match amend* $commit_type]} {
4232                        set selected_commit_type new
4233                }
4234        }
4235}
4236
4237proc do_commit {} {
4238        commit_tree
4239}
4240
4241proc do_about {} {
4242        global appvers copyright
4243        global tcl_patchLevel tk_patchLevel
4244
4245        set w .about_dialog
4246        toplevel $w
4247        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4248
4249        label $w.header -text "About [appname]" \
4250                -font font_uibold
4251        pack $w.header -side top -fill x
4252
4253        frame $w.buttons
4254        button $w.buttons.close -text {Close} \
4255                -font font_ui \
4256                -command [list destroy $w]
4257        pack $w.buttons.close -side right
4258        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4259
4260        label $w.desc \
4261                -text "[appname] - a commit creation tool for Git.
4262$copyright" \
4263                -padx 5 -pady 5 \
4264                -justify left \
4265                -anchor w \
4266                -borderwidth 1 \
4267                -relief solid \
4268                -font font_ui
4269        pack $w.desc -side top -fill x -padx 5 -pady 5
4270
4271        set v {}
4272        append v "[appname] version $appvers\n"
4273        append v "[exec git version]\n"
4274        append v "\n"
4275        if {$tcl_patchLevel eq $tk_patchLevel} {
4276                append v "Tcl/Tk version $tcl_patchLevel"
4277        } else {
4278                append v "Tcl version $tcl_patchLevel"
4279                append v ", Tk version $tk_patchLevel"
4280        }
4281
4282        label $w.vers \
4283                -text $v \
4284                -padx 5 -pady 5 \
4285                -justify left \
4286                -anchor w \
4287                -borderwidth 1 \
4288                -relief solid \
4289                -font font_ui
4290        pack $w.vers -side top -fill x -padx 5 -pady 5
4291
4292        menu $w.ctxm -tearoff 0
4293        $w.ctxm add command \
4294                -label {Copy} \
4295                -font font_ui \
4296                -command "
4297                clipboard clear
4298                clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4299        "
4300
4301        bind $w <Visibility> "grab $w; focus $w"
4302        bind $w <Key-Escape> "destroy $w"
4303        bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4304        wm title $w "About [appname]"
4305        tkwait window $w
4306}
4307
4308proc do_options {} {
4309        global repo_config global_config font_descs
4310        global repo_config_new global_config_new
4311
4312        array unset repo_config_new
4313        array unset global_config_new
4314        foreach name [array names repo_config] {
4315                set repo_config_new($name) $repo_config($name)
4316        }
4317        load_config 1
4318        foreach name [array names repo_config] {
4319                switch -- $name {
4320                gui.diffcontext {continue}
4321                }
4322                set repo_config_new($name) $repo_config($name)
4323        }
4324        foreach name [array names global_config] {
4325                set global_config_new($name) $global_config($name)
4326        }
4327
4328        set w .options_editor
4329        toplevel $w
4330        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4331
4332        label $w.header -text "[appname] Options" \
4333                -font font_uibold
4334        pack $w.header -side top -fill x
4335
4336        frame $w.buttons
4337        button $w.buttons.restore -text {Restore Defaults} \
4338                -font font_ui \
4339                -command do_restore_defaults
4340        pack $w.buttons.restore -side left
4341        button $w.buttons.save -text Save \
4342                -font font_ui \
4343                -command [list do_save_config $w]
4344        pack $w.buttons.save -side right
4345        button $w.buttons.cancel -text {Cancel} \
4346                -font font_ui \
4347                -command [list destroy $w]
4348        pack $w.buttons.cancel -side right -padx 5
4349        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4350
4351        labelframe $w.repo -text "[reponame] Repository" \
4352                -font font_ui
4353        labelframe $w.global -text {Global (All Repositories)} \
4354                -font font_ui
4355        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4356        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4357
4358        set optid 0
4359        foreach option {
4360                {t user.name {User Name}}
4361                {t user.email {Email Address}}
4362
4363                {b merge.summary {Summarize Merge Commits}}
4364                {i-1..5 merge.verbosity {Merge Verbosity}}
4365
4366                {b gui.trustmtime  {Trust File Modification Timestamps}}
4367                {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4368                {t gui.newbranchtemplate {New Branch Name Template}}
4369                } {
4370                set type [lindex $option 0]
4371                set name [lindex $option 1]
4372                set text [lindex $option 2]
4373                incr optid
4374                foreach f {repo global} {
4375                        switch -glob -- $type {
4376                        b {
4377                                checkbutton $w.$f.$optid -text $text \
4378                                        -variable ${f}_config_new($name) \
4379                                        -onvalue true \
4380                                        -offvalue false \
4381                                        -font font_ui
4382                                pack $w.$f.$optid -side top -anchor w
4383                        }
4384                        i-* {
4385                                regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4386                                frame $w.$f.$optid
4387                                label $w.$f.$optid.l -text "$text:" -font font_ui
4388                                pack $w.$f.$optid.l -side left -anchor w -fill x
4389                                spinbox $w.$f.$optid.v \
4390                                        -textvariable ${f}_config_new($name) \
4391                                        -from $min \
4392                                        -to $max \
4393                                        -increment 1 \
4394                                        -width [expr {1 + [string length $max]}] \
4395                                        -font font_ui
4396                                bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4397                                pack $w.$f.$optid.v -side right -anchor e -padx 5
4398                                pack $w.$f.$optid -side top -anchor w -fill x
4399                        }
4400                        t {
4401                                frame $w.$f.$optid
4402                                label $w.$f.$optid.l -text "$text:" -font font_ui
4403                                entry $w.$f.$optid.v \
4404                                        -borderwidth 1 \
4405                                        -relief sunken \
4406                                        -width 20 \
4407                                        -textvariable ${f}_config_new($name) \
4408                                        -font font_ui
4409                                pack $w.$f.$optid.l -side left -anchor w
4410                                pack $w.$f.$optid.v -side left -anchor w \
4411                                        -fill x -expand 1 \
4412                                        -padx 5
4413                                pack $w.$f.$optid -side top -anchor w -fill x
4414                        }
4415                        }
4416                }
4417        }
4418
4419        set all_fonts [lsort [font families]]
4420        foreach option $font_descs {
4421                set name [lindex $option 0]
4422                set font [lindex $option 1]
4423                set text [lindex $option 2]
4424
4425                set global_config_new(gui.$font^^family) \
4426                        [font configure $font -family]
4427                set global_config_new(gui.$font^^size) \
4428                        [font configure $font -size]
4429
4430                frame $w.global.$name
4431                label $w.global.$name.l -text "$text:" -font font_ui
4432                pack $w.global.$name.l -side left -anchor w -fill x
4433                eval tk_optionMenu $w.global.$name.family \
4434                        global_config_new(gui.$font^^family) \
4435                        $all_fonts
4436                spinbox $w.global.$name.size \
4437                        -textvariable global_config_new(gui.$font^^size) \
4438                        -from 2 -to 80 -increment 1 \
4439                        -width 3 \
4440                        -font font_ui
4441                bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4442                pack $w.global.$name.size -side right -anchor e
4443                pack $w.global.$name.family -side right -anchor e
4444                pack $w.global.$name -side top -anchor w -fill x
4445        }
4446
4447        bind $w <Visibility> "grab $w; focus $w"
4448        bind $w <Key-Escape> "destroy $w"
4449        wm title $w "[appname] ([reponame]): Options"
4450        tkwait window $w
4451}
4452
4453proc do_restore_defaults {} {
4454        global font_descs default_config repo_config
4455        global repo_config_new global_config_new
4456
4457        foreach name [array names default_config] {
4458                set repo_config_new($name) $default_config($name)
4459                set global_config_new($name) $default_config($name)
4460        }
4461
4462        foreach option $font_descs {
4463                set name [lindex $option 0]
4464                set repo_config(gui.$name) $default_config(gui.$name)
4465        }
4466        apply_config
4467
4468        foreach option $font_descs {
4469                set name [lindex $option 0]
4470                set font [lindex $option 1]
4471                set global_config_new(gui.$font^^family) \
4472                        [font configure $font -family]
4473                set global_config_new(gui.$font^^size) \
4474                        [font configure $font -size]
4475        }
4476}
4477
4478proc do_save_config {w} {
4479        if {[catch {save_config} err]} {
4480                error_popup "Failed to completely save options:\n\n$err"
4481        }
4482        reshow_diff
4483        destroy $w
4484}
4485
4486proc do_windows_shortcut {} {
4487        global argv0
4488
4489        set fn [tk_getSaveFile \
4490                -parent . \
4491                -title "[appname] ([reponame]): Create Desktop Icon" \
4492                -initialfile "Git [reponame].bat"]
4493        if {$fn != {}} {
4494                if {[catch {
4495                                set fd [open $fn w]
4496                                puts $fd "@ECHO Entering [reponame]"
4497                                puts $fd "@ECHO Starting git-gui... please wait..."
4498                                puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4499                                puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4500                                puts -nonewline $fd "@\"[info nameofexecutable]\""
4501                                puts $fd " \"[file normalize $argv0]\""
4502                                close $fd
4503                        } err]} {
4504                        error_popup "Cannot write script:\n\n$err"
4505                }
4506        }
4507}
4508
4509proc do_cygwin_shortcut {} {
4510        global argv0
4511
4512        if {[catch {
4513                set desktop [exec cygpath \
4514                        --windows \
4515                        --absolute \
4516                        --long-name \
4517                        --desktop]
4518                }]} {
4519                        set desktop .
4520        }
4521        set fn [tk_getSaveFile \
4522                -parent . \
4523                -title "[appname] ([reponame]): Create Desktop Icon" \
4524                -initialdir $desktop \
4525                -initialfile "Git [reponame].bat"]
4526        if {$fn != {}} {
4527                if {[catch {
4528                                set fd [open $fn w]
4529                                set sh [exec cygpath \
4530                                        --windows \
4531                                        --absolute \
4532                                        /bin/sh]
4533                                set me [exec cygpath \
4534                                        --unix \
4535                                        --absolute \
4536                                        $argv0]
4537                                set gd [exec cygpath \
4538                                        --unix \
4539                                        --absolute \
4540                                        [gitdir]]
4541                                set gw [exec cygpath \
4542                                        --windows \
4543                                        --absolute \
4544                                        [file dirname [gitdir]]]
4545                                regsub -all ' $me "'\\''" me
4546                                regsub -all ' $gd "'\\''" gd
4547                                puts $fd "@ECHO Entering $gw"
4548                                puts $fd "@ECHO Starting git-gui... please wait..."
4549                                puts -nonewline $fd "@\"$sh\" --login -c \""
4550                                puts -nonewline $fd "GIT_DIR='$gd'"
4551                                puts -nonewline $fd " '$me'"
4552                                puts $fd "&\""
4553                                close $fd
4554                        } err]} {
4555                        error_popup "Cannot write script:\n\n$err"
4556                }
4557        }
4558}
4559
4560proc do_macosx_app {} {
4561        global argv0 env
4562
4563        set fn [tk_getSaveFile \
4564                -parent . \
4565                -title "[appname] ([reponame]): Create Desktop Icon" \
4566                -initialdir [file join $env(HOME) Desktop] \
4567                -initialfile "Git [reponame].app"]
4568        if {$fn != {}} {
4569                if {[catch {
4570                                set Contents [file join $fn Contents]
4571                                set MacOS [file join $Contents MacOS]
4572                                set exe [file join $MacOS git-gui]
4573
4574                                file mkdir $MacOS
4575
4576                                set fd [open [file join $Contents Info.plist] w]
4577                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4578<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4579<plist version="1.0">
4580<dict>
4581        <key>CFBundleDevelopmentRegion</key>
4582        <string>English</string>
4583        <key>CFBundleExecutable</key>
4584        <string>git-gui</string>
4585        <key>CFBundleIdentifier</key>
4586        <string>org.spearce.git-gui</string>
4587        <key>CFBundleInfoDictionaryVersion</key>
4588        <string>6.0</string>
4589        <key>CFBundlePackageType</key>
4590        <string>APPL</string>
4591        <key>CFBundleSignature</key>
4592        <string>????</string>
4593        <key>CFBundleVersion</key>
4594        <string>1.0</string>
4595        <key>NSPrincipalClass</key>
4596        <string>NSApplication</string>
4597</dict>
4598</plist>}
4599                                close $fd
4600
4601                                set fd [open $exe w]
4602                                set gd [file normalize [gitdir]]
4603                                set ep [file normalize [gitexec]]
4604                                regsub -all ' $gd "'\\''" gd
4605                                regsub -all ' $ep "'\\''" ep
4606                                puts $fd "#!/bin/sh"
4607                                foreach name [array names env] {
4608                                        if {[string match GIT_* $name]} {
4609                                                regsub -all ' $env($name) "'\\''" v
4610                                                puts $fd "export $name='$v'"
4611                                        }
4612                                }
4613                                puts $fd "export PATH='$ep':\$PATH"
4614                                puts $fd "export GIT_DIR='$gd'"
4615                                puts $fd "exec [file normalize $argv0]"
4616                                close $fd
4617
4618                                file attributes $exe -permissions u+x,g+x,o+x
4619                        } err]} {
4620                        error_popup "Cannot write icon:\n\n$err"
4621                }
4622        }
4623}
4624
4625proc toggle_or_diff {w x y} {
4626        global file_states file_lists current_diff_path ui_index ui_workdir
4627        global last_clicked selected_paths
4628
4629        set pos [split [$w index @$x,$y] .]
4630        set lno [lindex $pos 0]
4631        set col [lindex $pos 1]
4632        set path [lindex $file_lists($w) [expr {$lno - 1}]]
4633        if {$path eq {}} {
4634                set last_clicked {}
4635                return
4636        }
4637
4638        set last_clicked [list $w $lno]
4639        array unset selected_paths
4640        $ui_index tag remove in_sel 0.0 end
4641        $ui_workdir tag remove in_sel 0.0 end
4642
4643        if {$col == 0} {
4644                if {$current_diff_path eq $path} {
4645                        set after {reshow_diff;}
4646                } else {
4647                        set after {}
4648                }
4649                if {$w eq $ui_index} {
4650                        update_indexinfo \
4651                                "Unstaging [short_path $path] from commit" \
4652                                [list $path] \
4653                                [concat $after {set ui_status_value {Ready.}}]
4654                } elseif {$w eq $ui_workdir} {
4655                        update_index \
4656                                "Adding [short_path $path]" \
4657                                [list $path] \
4658                                [concat $after {set ui_status_value {Ready.}}]
4659                }
4660        } else {
4661                show_diff $path $w $lno
4662        }
4663}
4664
4665proc add_one_to_selection {w x y} {
4666        global file_lists last_clicked selected_paths
4667
4668        set lno [lindex [split [$w index @$x,$y] .] 0]
4669        set path [lindex $file_lists($w) [expr {$lno - 1}]]
4670        if {$path eq {}} {
4671                set last_clicked {}
4672                return
4673        }
4674
4675        if {$last_clicked ne {}
4676                && [lindex $last_clicked 0] ne $w} {
4677                array unset selected_paths
4678                [lindex $last_clicked 0] tag remove in_sel 0.0 end
4679        }
4680
4681        set last_clicked [list $w $lno]
4682        if {[catch {set in_sel $selected_paths($path)}]} {
4683                set in_sel 0
4684        }
4685        if {$in_sel} {
4686                unset selected_paths($path)
4687                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4688        } else {
4689                set selected_paths($path) 1
4690                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4691        }
4692}
4693
4694proc add_range_to_selection {w x y} {
4695        global file_lists last_clicked selected_paths
4696
4697        if {[lindex $last_clicked 0] ne $w} {
4698                toggle_or_diff $w $x $y
4699                return
4700        }
4701
4702        set lno [lindex [split [$w index @$x,$y] .] 0]
4703        set lc [lindex $last_clicked 1]
4704        if {$lc < $lno} {
4705                set begin $lc
4706                set end $lno
4707        } else {
4708                set begin $lno
4709                set end $lc
4710        }
4711
4712        foreach path [lrange $file_lists($w) \
4713                [expr {$begin - 1}] \
4714                [expr {$end - 1}]] {
4715                set selected_paths($path) 1
4716        }
4717        $w tag add in_sel $begin.0 [expr {$end + 1}].0
4718}
4719
4720######################################################################
4721##
4722## config defaults
4723
4724set cursor_ptr arrow
4725font create font_diff -family Courier -size 10
4726font create font_ui
4727catch {
4728        label .dummy
4729        eval font configure font_ui [font actual [.dummy cget -font]]
4730        destroy .dummy
4731}
4732
4733font create font_uibold
4734font create font_diffbold
4735
4736if {[is_Windows]} {
4737        set M1B Control
4738        set M1T Ctrl
4739} elseif {[is_MacOSX]} {
4740        set M1B M1
4741        set M1T Cmd
4742} else {
4743        set M1B M1
4744        set M1T M1
4745}
4746
4747proc apply_config {} {
4748        global repo_config font_descs
4749
4750        foreach option $font_descs {
4751                set name [lindex $option 0]
4752                set font [lindex $option 1]
4753                if {[catch {
4754                        foreach {cn cv} $repo_config(gui.$name) {
4755                                font configure $font $cn $cv
4756                        }
4757                        } err]} {
4758                        error_popup "Invalid font specified in gui.$name:\n\n$err"
4759                }
4760                foreach {cn cv} [font configure $font] {
4761                        font configure ${font}bold $cn $cv
4762                }
4763                font configure ${font}bold -weight bold
4764        }
4765}
4766
4767set default_config(merge.summary) false
4768set default_config(merge.verbosity) 2
4769set default_config(user.name) {}
4770set default_config(user.email) {}
4771
4772set default_config(gui.trustmtime) false
4773set default_config(gui.diffcontext) 5
4774set default_config(gui.newbranchtemplate) {}
4775set default_config(gui.fontui) [font configure font_ui]
4776set default_config(gui.fontdiff) [font configure font_diff]
4777set font_descs {
4778        {fontui   font_ui   {Main Font}}
4779        {fontdiff font_diff {Diff/Console Font}}
4780}
4781load_config 0
4782apply_config
4783
4784######################################################################
4785##
4786## ui construction
4787
4788# -- Menu Bar
4789#
4790menu .mbar -tearoff 0
4791.mbar add cascade -label Repository -menu .mbar.repository
4792.mbar add cascade -label Edit -menu .mbar.edit
4793if {!$single_commit} {
4794        .mbar add cascade -label Branch -menu .mbar.branch
4795}
4796.mbar add cascade -label Commit -menu .mbar.commit
4797if {!$single_commit} {
4798        .mbar add cascade -label Merge -menu .mbar.merge
4799        .mbar add cascade -label Fetch -menu .mbar.fetch
4800        .mbar add cascade -label Push -menu .mbar.push
4801}
4802. configure -menu .mbar
4803
4804# -- Repository Menu
4805#
4806menu .mbar.repository
4807
4808.mbar.repository add command \
4809        -label {Browse Current Branch} \
4810        -command {new_browser $current_branch} \
4811        -font font_ui
4812.mbar.repository add separator
4813
4814.mbar.repository add command \
4815        -label {Visualize Current Branch} \
4816        -command {do_gitk {}} \
4817        -font font_ui
4818.mbar.repository add command \
4819        -label {Visualize All Branches} \
4820        -command {do_gitk {--all}} \
4821        -font font_ui
4822.mbar.repository add separator
4823
4824if {!$single_commit} {
4825        .mbar.repository add command -label {Database Statistics} \
4826                -command do_stats \
4827                -font font_ui
4828
4829        .mbar.repository add command -label {Compress Database} \
4830                -command do_gc \
4831                -font font_ui
4832
4833        .mbar.repository add command -label {Verify Database} \
4834                -command do_fsck_objects \
4835                -font font_ui
4836
4837        .mbar.repository add separator
4838
4839        if {[is_Cygwin]} {
4840                .mbar.repository add command \
4841                        -label {Create Desktop Icon} \
4842                        -command do_cygwin_shortcut \
4843                        -font font_ui
4844        } elseif {[is_Windows]} {
4845                .mbar.repository add command \
4846                        -label {Create Desktop Icon} \
4847                        -command do_windows_shortcut \
4848                        -font font_ui
4849        } elseif {[is_MacOSX]} {
4850                .mbar.repository add command \
4851                        -label {Create Desktop Icon} \
4852                        -command do_macosx_app \
4853                        -font font_ui
4854        }
4855}
4856
4857.mbar.repository add command -label Quit \
4858        -command do_quit \
4859        -accelerator $M1T-Q \
4860        -font font_ui
4861
4862# -- Edit Menu
4863#
4864menu .mbar.edit
4865.mbar.edit add command -label Undo \
4866        -command {catch {[focus] edit undo}} \
4867        -accelerator $M1T-Z \
4868        -font font_ui
4869.mbar.edit add command -label Redo \
4870        -command {catch {[focus] edit redo}} \
4871        -accelerator $M1T-Y \
4872        -font font_ui
4873.mbar.edit add separator
4874.mbar.edit add command -label Cut \
4875        -command {catch {tk_textCut [focus]}} \
4876        -accelerator $M1T-X \
4877        -font font_ui
4878.mbar.edit add command -label Copy \
4879        -command {catch {tk_textCopy [focus]}} \
4880        -accelerator $M1T-C \
4881        -font font_ui
4882.mbar.edit add command -label Paste \
4883        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4884        -accelerator $M1T-V \
4885        -font font_ui
4886.mbar.edit add command -label Delete \
4887        -command {catch {[focus] delete sel.first sel.last}} \
4888        -accelerator Del \
4889        -font font_ui
4890.mbar.edit add separator
4891.mbar.edit add command -label {Select All} \
4892        -command {catch {[focus] tag add sel 0.0 end}} \
4893        -accelerator $M1T-A \
4894        -font font_ui
4895
4896# -- Branch Menu
4897#
4898if {!$single_commit} {
4899        menu .mbar.branch
4900
4901        .mbar.branch add command -label {Create...} \
4902                -command do_create_branch \
4903                -accelerator $M1T-N \
4904                -font font_ui
4905        lappend disable_on_lock [list .mbar.branch entryconf \
4906                [.mbar.branch index last] -state]
4907
4908        .mbar.branch add command -label {Delete...} \
4909                -command do_delete_branch \
4910                -font font_ui
4911        lappend disable_on_lock [list .mbar.branch entryconf \
4912                [.mbar.branch index last] -state]
4913}
4914
4915# -- Commit Menu
4916#
4917menu .mbar.commit
4918
4919.mbar.commit add radiobutton \
4920        -label {New Commit} \
4921        -command do_select_commit_type \
4922        -variable selected_commit_type \
4923        -value new \
4924        -font font_ui
4925lappend disable_on_lock \
4926        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4927
4928.mbar.commit add radiobutton \
4929        -label {Amend Last Commit} \
4930        -command do_select_commit_type \
4931        -variable selected_commit_type \
4932        -value amend \
4933        -font font_ui
4934lappend disable_on_lock \
4935        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4936
4937.mbar.commit add separator
4938
4939.mbar.commit add command -label Rescan \
4940        -command do_rescan \
4941        -accelerator F5 \
4942        -font font_ui
4943lappend disable_on_lock \
4944        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4945
4946.mbar.commit add command -label {Add To Commit} \
4947        -command do_add_selection \
4948        -font font_ui
4949lappend disable_on_lock \
4950        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4951
4952.mbar.commit add command -label {Add All To Commit} \
4953        -command do_add_all \
4954        -accelerator $M1T-I \
4955        -font font_ui
4956lappend disable_on_lock \
4957        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4958
4959.mbar.commit add command -label {Unstage From Commit} \
4960        -command do_unstage_selection \
4961        -font font_ui
4962lappend disable_on_lock \
4963        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4964
4965.mbar.commit add command -label {Revert Changes} \
4966        -command do_revert_selection \
4967        -font font_ui
4968lappend disable_on_lock \
4969        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4970
4971.mbar.commit add separator
4972
4973.mbar.commit add command -label {Sign Off} \
4974        -command do_signoff \
4975        -accelerator $M1T-S \
4976        -font font_ui
4977
4978.mbar.commit add command -label Commit \
4979        -command do_commit \
4980        -accelerator $M1T-Return \
4981        -font font_ui
4982lappend disable_on_lock \
4983        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4984
4985if {[is_MacOSX]} {
4986        # -- Apple Menu (Mac OS X only)
4987        #
4988        .mbar add cascade -label Apple -menu .mbar.apple
4989        menu .mbar.apple
4990
4991        .mbar.apple add command -label "About [appname]" \
4992                -command do_about \
4993                -font font_ui
4994        .mbar.apple add command -label "[appname] Options..." \
4995                -command do_options \
4996                -font font_ui
4997} else {
4998        # -- Edit Menu
4999        #
5000        .mbar.edit add separator
5001        .mbar.edit add command -label {Options...} \
5002                -command do_options \
5003                -font font_ui
5004
5005        # -- Tools Menu
5006        #
5007        if {[file exists /usr/local/miga/lib/gui-miga]
5008                && [file exists .pvcsrc]} {
5009        proc do_miga {} {
5010                global ui_status_value
5011                if {![lock_index update]} return
5012                set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5013                set miga_fd [open "|$cmd" r]
5014                fconfigure $miga_fd -blocking 0
5015                fileevent $miga_fd readable [list miga_done $miga_fd]
5016                set ui_status_value {Running miga...}
5017        }
5018        proc miga_done {fd} {
5019                read $fd 512
5020                if {[eof $fd]} {
5021                        close $fd
5022                        unlock_index
5023                        rescan [list set ui_status_value {Ready.}]
5024                }
5025        }
5026        .mbar add cascade -label Tools -menu .mbar.tools
5027        menu .mbar.tools
5028        .mbar.tools add command -label "Migrate" \
5029                -command do_miga \
5030                -font font_ui
5031        lappend disable_on_lock \
5032                [list .mbar.tools entryconf [.mbar.tools index last] -state]
5033        }
5034}
5035
5036# -- Help Menu
5037#
5038.mbar add cascade -label Help -menu .mbar.help
5039menu .mbar.help
5040
5041if {![is_MacOSX]} {
5042        .mbar.help add command -label "About [appname]" \
5043                -command do_about \
5044                -font font_ui
5045}
5046
5047set browser {}
5048catch {set browser $repo_config(instaweb.browser)}
5049set doc_path [file dirname [gitexec]]
5050set doc_path [file join $doc_path Documentation index.html]
5051
5052if {[is_Cygwin]} {
5053        set doc_path [exec cygpath --windows $doc_path]
5054}
5055
5056if {$browser eq {}} {
5057        if {[is_MacOSX]} {
5058                set browser open
5059        } elseif {[is_Cygwin]} {
5060                set program_files [file dirname [exec cygpath --windir]]
5061                set program_files [file join $program_files {Program Files}]
5062                set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5063                set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5064                if {[file exists $firefox]} {
5065                        set browser $firefox
5066                } elseif {[file exists $ie]} {
5067                        set browser $ie
5068                }
5069                unset program_files firefox ie
5070        }
5071}
5072
5073if {[file isfile $doc_path]} {
5074        set doc_url "file:$doc_path"
5075} else {
5076        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5077}
5078
5079if {$browser ne {}} {
5080        .mbar.help add command -label {Online Documentation} \
5081                -command [list exec $browser $doc_url &] \
5082                -font font_ui
5083}
5084unset browser doc_path doc_url
5085
5086# -- Branch Control
5087#
5088frame .branch \
5089        -borderwidth 1 \
5090        -relief sunken
5091label .branch.l1 \
5092        -text {Current Branch:} \
5093        -anchor w \
5094        -justify left \
5095        -font font_ui
5096label .branch.cb \
5097        -textvariable current_branch \
5098        -anchor w \
5099        -justify left \
5100        -font font_ui
5101pack .branch.l1 -side left
5102pack .branch.cb -side left -fill x
5103pack .branch -side top -fill x
5104
5105if {!$single_commit} {
5106        menu .mbar.merge
5107        .mbar.merge add command -label {Local Merge...} \
5108                -command do_local_merge \
5109                -font font_ui
5110        lappend disable_on_lock \
5111                [list .mbar.merge entryconf [.mbar.merge index last] -state]
5112        .mbar.merge add command -label {Abort Merge...} \
5113                -command do_reset_hard \
5114                -font font_ui
5115        lappend disable_on_lock \
5116                [list .mbar.merge entryconf [.mbar.merge index last] -state]
5117
5118
5119        menu .mbar.fetch
5120
5121        menu .mbar.push
5122        .mbar.push add command -label {Push...} \
5123                -command do_push_anywhere \
5124                -font font_ui
5125}
5126
5127# -- Main Window Layout
5128#
5129panedwindow .vpane -orient vertical
5130panedwindow .vpane.files -orient horizontal
5131.vpane add .vpane.files -sticky nsew -height 100 -width 200
5132pack .vpane -anchor n -side top -fill both -expand 1
5133
5134# -- Index File List
5135#
5136frame .vpane.files.index -height 100 -width 200
5137label .vpane.files.index.title -text {Changes To Be Committed} \
5138        -background green \
5139        -font font_ui
5140text $ui_index -background white -borderwidth 0 \
5141        -width 20 -height 10 \
5142        -wrap none \
5143        -font font_ui \
5144        -cursor $cursor_ptr \
5145        -xscrollcommand {.vpane.files.index.sx set} \
5146        -yscrollcommand {.vpane.files.index.sy set} \
5147        -state disabled
5148scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5149scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5150pack .vpane.files.index.title -side top -fill x
5151pack .vpane.files.index.sx -side bottom -fill x
5152pack .vpane.files.index.sy -side right -fill y
5153pack $ui_index -side left -fill both -expand 1
5154.vpane.files add .vpane.files.index -sticky nsew
5155
5156# -- Working Directory File List
5157#
5158frame .vpane.files.workdir -height 100 -width 200
5159label .vpane.files.workdir.title -text {Changed But Not Updated} \
5160        -background red \
5161        -font font_ui
5162text $ui_workdir -background white -borderwidth 0 \
5163        -width 20 -height 10 \
5164        -wrap none \
5165        -font font_ui \
5166        -cursor $cursor_ptr \
5167        -xscrollcommand {.vpane.files.workdir.sx set} \
5168        -yscrollcommand {.vpane.files.workdir.sy set} \
5169        -state disabled
5170scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5171scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5172pack .vpane.files.workdir.title -side top -fill x
5173pack .vpane.files.workdir.sx -side bottom -fill x
5174pack .vpane.files.workdir.sy -side right -fill y
5175pack $ui_workdir -side left -fill both -expand 1
5176.vpane.files add .vpane.files.workdir -sticky nsew
5177
5178foreach i [list $ui_index $ui_workdir] {
5179        $i tag conf in_diff -font font_uibold
5180        $i tag conf in_sel \
5181                -background [$i cget -foreground] \
5182                -foreground [$i cget -background]
5183}
5184unset i
5185
5186# -- Diff and Commit Area
5187#
5188frame .vpane.lower -height 300 -width 400
5189frame .vpane.lower.commarea
5190frame .vpane.lower.diff -relief sunken -borderwidth 1
5191pack .vpane.lower.commarea -side top -fill x
5192pack .vpane.lower.diff -side bottom -fill both -expand 1
5193.vpane add .vpane.lower -sticky nsew
5194
5195# -- Commit Area Buttons
5196#
5197frame .vpane.lower.commarea.buttons
5198label .vpane.lower.commarea.buttons.l -text {} \
5199        -anchor w \
5200        -justify left \
5201        -font font_ui
5202pack .vpane.lower.commarea.buttons.l -side top -fill x
5203pack .vpane.lower.commarea.buttons -side left -fill y
5204
5205button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5206        -command do_rescan \
5207        -font font_ui
5208pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5209lappend disable_on_lock \
5210        {.vpane.lower.commarea.buttons.rescan conf -state}
5211
5212button .vpane.lower.commarea.buttons.incall -text {Add All} \
5213        -command do_add_all \
5214        -font font_ui
5215pack .vpane.lower.commarea.buttons.incall -side top -fill x
5216lappend disable_on_lock \
5217        {.vpane.lower.commarea.buttons.incall conf -state}
5218
5219button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5220        -command do_signoff \
5221        -font font_ui
5222pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5223
5224button .vpane.lower.commarea.buttons.commit -text {Commit} \
5225        -command do_commit \
5226        -font font_ui
5227pack .vpane.lower.commarea.buttons.commit -side top -fill x
5228lappend disable_on_lock \
5229        {.vpane.lower.commarea.buttons.commit conf -state}
5230
5231# -- Commit Message Buffer
5232#
5233frame .vpane.lower.commarea.buffer
5234frame .vpane.lower.commarea.buffer.header
5235set ui_comm .vpane.lower.commarea.buffer.t
5236set ui_coml .vpane.lower.commarea.buffer.header.l
5237radiobutton .vpane.lower.commarea.buffer.header.new \
5238        -text {New Commit} \
5239        -command do_select_commit_type \
5240        -variable selected_commit_type \
5241        -value new \
5242        -font font_ui
5243lappend disable_on_lock \
5244        [list .vpane.lower.commarea.buffer.header.new conf -state]
5245radiobutton .vpane.lower.commarea.buffer.header.amend \
5246        -text {Amend Last Commit} \
5247        -command do_select_commit_type \
5248        -variable selected_commit_type \
5249        -value amend \
5250        -font font_ui
5251lappend disable_on_lock \
5252        [list .vpane.lower.commarea.buffer.header.amend conf -state]
5253label $ui_coml \
5254        -anchor w \
5255        -justify left \
5256        -font font_ui
5257proc trace_commit_type {varname args} {
5258        global ui_coml commit_type
5259        switch -glob -- $commit_type {
5260        initial       {set txt {Initial Commit Message:}}
5261        amend         {set txt {Amended Commit Message:}}
5262        amend-initial {set txt {Amended Initial Commit Message:}}
5263        amend-merge   {set txt {Amended Merge Commit Message:}}
5264        merge         {set txt {Merge Commit Message:}}
5265        *             {set txt {Commit Message:}}
5266        }
5267        $ui_coml conf -text $txt
5268}
5269trace add variable commit_type write trace_commit_type
5270pack $ui_coml -side left -fill x
5271pack .vpane.lower.commarea.buffer.header.amend -side right
5272pack .vpane.lower.commarea.buffer.header.new -side right
5273
5274text $ui_comm -background white -borderwidth 1 \
5275        -undo true \
5276        -maxundo 20 \
5277        -autoseparators true \
5278        -relief sunken \
5279        -width 75 -height 9 -wrap none \
5280        -font font_diff \
5281        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5282scrollbar .vpane.lower.commarea.buffer.sby \
5283        -command [list $ui_comm yview]
5284pack .vpane.lower.commarea.buffer.header -side top -fill x
5285pack .vpane.lower.commarea.buffer.sby -side right -fill y
5286pack $ui_comm -side left -fill y
5287pack .vpane.lower.commarea.buffer -side left -fill y
5288
5289# -- Commit Message Buffer Context Menu
5290#
5291set ctxm .vpane.lower.commarea.buffer.ctxm
5292menu $ctxm -tearoff 0
5293$ctxm add command \
5294        -label {Cut} \
5295        -font font_ui \
5296        -command {tk_textCut $ui_comm}
5297$ctxm add command \
5298        -label {Copy} \
5299        -font font_ui \
5300        -command {tk_textCopy $ui_comm}
5301$ctxm add command \
5302        -label {Paste} \
5303        -font font_ui \
5304        -command {tk_textPaste $ui_comm}
5305$ctxm add command \
5306        -label {Delete} \
5307        -font font_ui \
5308        -command {$ui_comm delete sel.first sel.last}
5309$ctxm add separator
5310$ctxm add command \
5311        -label {Select All} \
5312        -font font_ui \
5313        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5314$ctxm add command \
5315        -label {Copy All} \
5316        -font font_ui \
5317        -command {
5318                $ui_comm tag add sel 0.0 end
5319                tk_textCopy $ui_comm
5320                $ui_comm tag remove sel 0.0 end
5321        }
5322$ctxm add separator
5323$ctxm add command \
5324        -label {Sign Off} \
5325        -font font_ui \
5326        -command do_signoff
5327bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5328
5329# -- Diff Header
5330#
5331set current_diff_path {}
5332set current_diff_side {}
5333set diff_actions [list]
5334proc trace_current_diff_path {varname args} {
5335        global current_diff_path diff_actions file_states
5336        if {$current_diff_path eq {}} {
5337                set s {}
5338                set f {}
5339                set p {}
5340                set o disabled
5341        } else {
5342                set p $current_diff_path
5343                set s [mapdesc [lindex $file_states($p) 0] $p]
5344                set f {File:}
5345                set p [escape_path $p]
5346                set o normal
5347        }
5348
5349        .vpane.lower.diff.header.status configure -text $s
5350        .vpane.lower.diff.header.file configure -text $f
5351        .vpane.lower.diff.header.path configure -text $p
5352        foreach w $diff_actions {
5353                uplevel #0 $w $o
5354        }
5355}
5356trace add variable current_diff_path write trace_current_diff_path
5357
5358frame .vpane.lower.diff.header -background orange
5359label .vpane.lower.diff.header.status \
5360        -background orange \
5361        -width $max_status_desc \
5362        -anchor w \
5363        -justify left \
5364        -font font_ui
5365label .vpane.lower.diff.header.file \
5366        -background orange \
5367        -anchor w \
5368        -justify left \
5369        -font font_ui
5370label .vpane.lower.diff.header.path \
5371        -background orange \
5372        -anchor w \
5373        -justify left \
5374        -font font_ui
5375pack .vpane.lower.diff.header.status -side left
5376pack .vpane.lower.diff.header.file -side left
5377pack .vpane.lower.diff.header.path -fill x
5378set ctxm .vpane.lower.diff.header.ctxm
5379menu $ctxm -tearoff 0
5380$ctxm add command \
5381        -label {Copy} \
5382        -font font_ui \
5383        -command {
5384                clipboard clear
5385                clipboard append \
5386                        -format STRING \
5387                        -type STRING \
5388                        -- $current_diff_path
5389        }
5390lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5391bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5392
5393# -- Diff Body
5394#
5395frame .vpane.lower.diff.body
5396set ui_diff .vpane.lower.diff.body.t
5397text $ui_diff -background white -borderwidth 0 \
5398        -width 80 -height 15 -wrap none \
5399        -font font_diff \
5400        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5401        -yscrollcommand {.vpane.lower.diff.body.sby set} \
5402        -state disabled
5403scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5404        -command [list $ui_diff xview]
5405scrollbar .vpane.lower.diff.body.sby -orient vertical \
5406        -command [list $ui_diff yview]
5407pack .vpane.lower.diff.body.sbx -side bottom -fill x
5408pack .vpane.lower.diff.body.sby -side right -fill y
5409pack $ui_diff -side left -fill both -expand 1
5410pack .vpane.lower.diff.header -side top -fill x
5411pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5412
5413$ui_diff tag conf d_cr -elide true
5414$ui_diff tag conf d_@ -foreground blue -font font_diffbold
5415$ui_diff tag conf d_+ -foreground {#00a000}
5416$ui_diff tag conf d_- -foreground red
5417
5418$ui_diff tag conf d_++ -foreground {#00a000}
5419$ui_diff tag conf d_-- -foreground red
5420$ui_diff tag conf d_+s \
5421        -foreground {#00a000} \
5422        -background {#e2effa}
5423$ui_diff tag conf d_-s \
5424        -foreground red \
5425        -background {#e2effa}
5426$ui_diff tag conf d_s+ \
5427        -foreground {#00a000} \
5428        -background ivory1
5429$ui_diff tag conf d_s- \
5430        -foreground red \
5431        -background ivory1
5432
5433$ui_diff tag conf d<<<<<<< \
5434        -foreground orange \
5435        -font font_diffbold
5436$ui_diff tag conf d======= \
5437        -foreground orange \
5438        -font font_diffbold
5439$ui_diff tag conf d>>>>>>> \
5440        -foreground orange \
5441        -font font_diffbold
5442
5443$ui_diff tag raise sel
5444
5445# -- Diff Body Context Menu
5446#
5447set ctxm .vpane.lower.diff.body.ctxm
5448menu $ctxm -tearoff 0
5449$ctxm add command \
5450        -label {Refresh} \
5451        -font font_ui \
5452        -command reshow_diff
5453lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5454$ctxm add command \
5455        -label {Copy} \
5456        -font font_ui \
5457        -command {tk_textCopy $ui_diff}
5458lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5459$ctxm add command \
5460        -label {Select All} \
5461        -font font_ui \
5462        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5463lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5464$ctxm add command \
5465        -label {Copy All} \
5466        -font font_ui \
5467        -command {
5468                $ui_diff tag add sel 0.0 end
5469                tk_textCopy $ui_diff
5470                $ui_diff tag remove sel 0.0 end
5471        }
5472lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5473$ctxm add separator
5474$ctxm add command \
5475        -label {Apply/Reverse Hunk} \
5476        -font font_ui \
5477        -command {apply_hunk $cursorX $cursorY}
5478set ui_diff_applyhunk [$ctxm index last]
5479lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5480$ctxm add separator
5481$ctxm add command \
5482        -label {Decrease Font Size} \
5483        -font font_ui \
5484        -command {incr_font_size font_diff -1}
5485lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5486$ctxm add command \
5487        -label {Increase Font Size} \
5488        -font font_ui \
5489        -command {incr_font_size font_diff 1}
5490lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5491$ctxm add separator
5492$ctxm add command \
5493        -label {Show Less Context} \
5494        -font font_ui \
5495        -command {if {$repo_config(gui.diffcontext) >= 2} {
5496                incr repo_config(gui.diffcontext) -1
5497                reshow_diff
5498        }}
5499lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5500$ctxm add command \
5501        -label {Show More Context} \
5502        -font font_ui \
5503        -command {
5504                incr repo_config(gui.diffcontext)
5505                reshow_diff
5506        }
5507lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5508$ctxm add separator
5509$ctxm add command -label {Options...} \
5510        -font font_ui \
5511        -command do_options
5512bind_button3 $ui_diff "
5513        set cursorX %x
5514        set cursorY %y
5515        if {\$ui_index eq \$current_diff_side} {
5516                $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5517        } else {
5518                $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5519        }
5520        tk_popup $ctxm %X %Y
5521"
5522unset ui_diff_applyhunk
5523
5524# -- Status Bar
5525#
5526set ui_status_value {Initializing...}
5527label .status -textvariable ui_status_value \
5528        -anchor w \
5529        -justify left \
5530        -borderwidth 1 \
5531        -relief sunken \
5532        -font font_ui
5533pack .status -anchor w -side bottom -fill x
5534
5535# -- Load geometry
5536#
5537catch {
5538set gm $repo_config(gui.geometry)
5539wm geometry . [lindex $gm 0]
5540.vpane sash place 0 \
5541        [lindex [.vpane sash coord 0] 0] \
5542        [lindex $gm 1]
5543.vpane.files sash place 0 \
5544        [lindex $gm 2] \
5545        [lindex [.vpane.files sash coord 0] 1]
5546unset gm
5547}
5548
5549# -- Key Bindings
5550#
5551bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5552bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5553bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5554bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5555bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5556bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5557bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5558bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5559bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5560bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5561bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5562
5563bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5564bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5565bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5566bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5567bind $ui_diff <$M1B-Key-v> {break}
5568bind $ui_diff <$M1B-Key-V> {break}
5569bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5570bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5571bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
5572bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
5573bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
5574bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
5575bind $ui_diff <Button-1>   {focus %W}
5576
5577if {!$single_commit} {
5578        bind . <$M1B-Key-n> do_create_branch
5579        bind . <$M1B-Key-N> do_create_branch
5580}
5581
5582bind .   <Destroy> do_quit
5583bind all <Key-F5> do_rescan
5584bind all <$M1B-Key-r> do_rescan
5585bind all <$M1B-Key-R> do_rescan
5586bind .   <$M1B-Key-s> do_signoff
5587bind .   <$M1B-Key-S> do_signoff
5588bind .   <$M1B-Key-i> do_add_all
5589bind .   <$M1B-Key-I> do_add_all
5590bind .   <$M1B-Key-Return> do_commit
5591bind all <$M1B-Key-q> do_quit
5592bind all <$M1B-Key-Q> do_quit
5593bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5594bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5595foreach i [list $ui_index $ui_workdir] {
5596        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
5597        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
5598        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5599}
5600unset i
5601
5602set file_lists($ui_index) [list]
5603set file_lists($ui_workdir) [list]
5604
5605set HEAD {}
5606set PARENT {}
5607set MERGE_HEAD [list]
5608set commit_type {}
5609set empty_tree {}
5610set current_branch {}
5611set current_diff_path {}
5612set selected_commit_type new
5613
5614wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5615focus -force $ui_comm
5616
5617# -- Warn the user about environmental problems.  Cygwin's Tcl
5618#    does *not* pass its env array onto any processes it spawns.
5619#    This means that git processes get none of our environment.
5620#
5621if {[is_Cygwin]} {
5622        set ignored_env 0
5623        set suggest_user {}
5624        set msg "Possible environment issues exist.
5625
5626The following environment variables are probably
5627going to be ignored by any Git subprocess run
5628by [appname]:
5629
5630"
5631        foreach name [array names env] {
5632                switch -regexp -- $name {
5633                {^GIT_INDEX_FILE$} -
5634                {^GIT_OBJECT_DIRECTORY$} -
5635                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5636                {^GIT_DIFF_OPTS$} -
5637                {^GIT_EXTERNAL_DIFF$} -
5638                {^GIT_PAGER$} -
5639                {^GIT_TRACE$} -
5640                {^GIT_CONFIG$} -
5641                {^GIT_CONFIG_LOCAL$} -
5642                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5643                        append msg " - $name\n"
5644                        incr ignored_env
5645                }
5646                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5647                        append msg " - $name\n"
5648                        incr ignored_env
5649                        set suggest_user $name
5650                }
5651                }
5652        }
5653        if {$ignored_env > 0} {
5654                append msg "
5655This is due to a known issue with the
5656Tcl binary distributed by Cygwin."
5657
5658                if {$suggest_user ne {}} {
5659                        append msg "
5660
5661A good replacement for $suggest_user
5662is placing values for the user.name and
5663user.email settings into your personal
5664~/.gitconfig file.
5665"
5666                }
5667                warn_popup $msg
5668        }
5669        unset ignored_env msg suggest_user name
5670}
5671
5672# -- Only initialize complex UI if we are going to stay running.
5673#
5674if {!$single_commit} {
5675        load_all_remotes
5676        load_all_heads
5677
5678        populate_branch_menu
5679        populate_fetch_menu
5680        populate_push_menu
5681}
5682
5683# -- Only suggest a gc run if we are going to stay running.
5684#
5685if {!$single_commit} {
5686        set object_limit 2000
5687        if {[is_Windows]} {set object_limit 200}
5688        regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5689        if {$objects_current >= $object_limit} {
5690                if {[ask_popup \
5691                        "This repository currently has $objects_current loose objects.
5692
5693To maintain optimal performance it is strongly
5694recommended that you compress the database
5695when more than $object_limit loose objects exist.
5696
5697Compress the database now?"] eq yes} {
5698                        do_gc
5699                }
5700        }
5701        unset object_limit _junk objects_current
5702}
5703
5704lock_index begin-read
5705after 1 do_rescan