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