811e20217db06cbd8e72aa46191bd2b55f1bae21
   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        $m add separator
1826        foreach b $all_heads {
1827                $m add radiobutton \
1828                        -label $b \
1829                        -command [list switch_branch $b] \
1830                        -variable current_branch \
1831                        -value $b \
1832                        -font font_ui
1833                lappend disable_on_lock \
1834                        [list $m entryconf [$m index last] -state]
1835        }
1836}
1837
1838proc all_tracking_branches {} {
1839        global tracking_branches
1840
1841        set all_trackings {}
1842        set cmd {}
1843        foreach name [array names tracking_branches] {
1844                if {[regsub {/\*$} $name {} name]} {
1845                        lappend cmd $name
1846                } else {
1847                        regsub ^refs/(heads|remotes)/ $name {} name
1848                        lappend all_trackings $name
1849                }
1850        }
1851
1852        if {$cmd ne {}} {
1853                set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1854                while {[gets $fd name] > 0} {
1855                        regsub ^refs/(heads|remotes)/ $name {} name
1856                        lappend all_trackings $name
1857                }
1858                close $fd
1859        }
1860
1861        return [lsort -unique $all_trackings]
1862}
1863
1864proc do_create_branch_action {w} {
1865        global all_heads null_sha1 repo_config
1866        global create_branch_checkout create_branch_revtype
1867        global create_branch_head create_branch_trackinghead
1868        global create_branch_name create_branch_revexp
1869
1870        set newbranch $create_branch_name
1871        if {$newbranch eq {}
1872                || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1873                tk_messageBox \
1874                        -icon error \
1875                        -type ok \
1876                        -title [wm title $w] \
1877                        -parent $w \
1878                        -message "Please supply a branch name."
1879                focus $w.desc.name_t
1880                return
1881        }
1882        if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1883                tk_messageBox \
1884                        -icon error \
1885                        -type ok \
1886                        -title [wm title $w] \
1887                        -parent $w \
1888                        -message "Branch '$newbranch' already exists."
1889                focus $w.desc.name_t
1890                return
1891        }
1892        if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1893                tk_messageBox \
1894                        -icon error \
1895                        -type ok \
1896                        -title [wm title $w] \
1897                        -parent $w \
1898                        -message "We do not like '$newbranch' as a branch name."
1899                focus $w.desc.name_t
1900                return
1901        }
1902
1903        set rev {}
1904        switch -- $create_branch_revtype {
1905        head {set rev $create_branch_head}
1906        tracking {set rev $create_branch_trackinghead}
1907        expression {set rev $create_branch_revexp}
1908        }
1909        if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1910                tk_messageBox \
1911                        -icon error \
1912                        -type ok \
1913                        -title [wm title $w] \
1914                        -parent $w \
1915                        -message "Invalid starting revision: $rev"
1916                return
1917        }
1918        set cmd [list git update-ref]
1919        lappend cmd -m
1920        lappend cmd "branch: Created from $rev"
1921        lappend cmd "refs/heads/$newbranch"
1922        lappend cmd $cmt
1923        lappend cmd $null_sha1
1924        if {[catch {eval exec $cmd} err]} {
1925                tk_messageBox \
1926                        -icon error \
1927                        -type ok \
1928                        -title [wm title $w] \
1929                        -parent $w \
1930                        -message "Failed to create '$newbranch'.\n\n$err"
1931                return
1932        }
1933
1934        lappend all_heads $newbranch
1935        set all_heads [lsort $all_heads]
1936        populate_branch_menu
1937        destroy $w
1938        if {$create_branch_checkout} {
1939                switch_branch $newbranch
1940        }
1941}
1942
1943proc radio_selector {varname value args} {
1944        upvar #0 $varname var
1945        set var $value
1946}
1947
1948trace add variable create_branch_head write \
1949        [list radio_selector create_branch_revtype head]
1950trace add variable create_branch_trackinghead write \
1951        [list radio_selector create_branch_revtype tracking]
1952
1953trace add variable delete_branch_head write \
1954        [list radio_selector delete_branch_checktype head]
1955trace add variable delete_branch_trackinghead write \
1956        [list radio_selector delete_branch_checktype tracking]
1957
1958proc do_create_branch {} {
1959        global all_heads current_branch repo_config
1960        global create_branch_checkout create_branch_revtype
1961        global create_branch_head create_branch_trackinghead
1962        global create_branch_name create_branch_revexp
1963
1964        set w .branch_editor
1965        toplevel $w
1966        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1967
1968        label $w.header -text {Create New Branch} \
1969                -font font_uibold
1970        pack $w.header -side top -fill x
1971
1972        frame $w.buttons
1973        button $w.buttons.create -text Create \
1974                -font font_ui \
1975                -default active \
1976                -command [list do_create_branch_action $w]
1977        pack $w.buttons.create -side right
1978        button $w.buttons.cancel -text {Cancel} \
1979                -font font_ui \
1980                -command [list destroy $w]
1981        pack $w.buttons.cancel -side right -padx 5
1982        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1983
1984        labelframe $w.desc \
1985                -text {Branch Description} \
1986                -font font_ui
1987        label $w.desc.name_l -text {Name:} -font font_ui
1988        entry $w.desc.name_t \
1989                -borderwidth 1 \
1990                -relief sunken \
1991                -width 40 \
1992                -textvariable create_branch_name \
1993                -font font_ui \
1994                -validate key \
1995                -validatecommand {
1996                        if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
1997                        return 1
1998                }
1999        grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2000        grid columnconfigure $w.desc 1 -weight 1
2001        pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2002
2003        labelframe $w.from \
2004                -text {Starting Revision} \
2005                -font font_ui
2006        radiobutton $w.from.head_r \
2007                -text {Local Branch:} \
2008                -value head \
2009                -variable create_branch_revtype \
2010                -font font_ui
2011        eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2012        grid $w.from.head_r $w.from.head_m -sticky w
2013        set all_trackings [all_tracking_branches]
2014        if {$all_trackings ne {}} {
2015                set create_branch_trackinghead [lindex $all_trackings 0]
2016                radiobutton $w.from.tracking_r \
2017                        -text {Tracking Branch:} \
2018                        -value tracking \
2019                        -variable create_branch_revtype \
2020                        -font font_ui
2021                eval tk_optionMenu $w.from.tracking_m \
2022                        create_branch_trackinghead \
2023                        $all_trackings
2024                grid $w.from.tracking_r $w.from.tracking_m -sticky w
2025        }
2026        radiobutton $w.from.exp_r \
2027                -text {Revision Expression:} \
2028                -value expression \
2029                -variable create_branch_revtype \
2030                -font font_ui
2031        entry $w.from.exp_t \
2032                -borderwidth 1 \
2033                -relief sunken \
2034                -width 50 \
2035                -textvariable create_branch_revexp \
2036                -font font_ui \
2037                -validate key \
2038                -validatecommand {
2039                        if {%d == 1 && [regexp {\s} %S]} {return 0}
2040                        if {%d == 1 && [string length %S] > 0} {
2041                                set create_branch_revtype expression
2042                        }
2043                        return 1
2044                }
2045        grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2046        grid columnconfigure $w.from 1 -weight 1
2047        pack $w.from -anchor nw -fill x -pady 5 -padx 5
2048
2049        labelframe $w.postActions \
2050                -text {Post Creation Actions} \
2051                -font font_ui
2052        checkbutton $w.postActions.checkout \
2053                -text {Checkout after creation} \
2054                -variable create_branch_checkout \
2055                -font font_ui
2056        pack $w.postActions.checkout -anchor nw
2057        pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2058
2059        set create_branch_checkout 1
2060        set create_branch_head $current_branch
2061        set create_branch_revtype head
2062        set create_branch_name $repo_config(gui.newbranchtemplate)
2063        set create_branch_revexp {}
2064
2065        bind $w <Visibility> "
2066                grab $w
2067                $w.desc.name_t icursor end
2068                focus $w.desc.name_t
2069        "
2070        bind $w <Key-Escape> "destroy $w"
2071        bind $w <Key-Return> "do_create_branch_action $w;break"
2072        wm title $w "[appname] ([reponame]): Create Branch"
2073        tkwait window $w
2074}
2075
2076proc do_delete_branch_action {w} {
2077        global all_heads
2078        global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2079
2080        set check_rev {}
2081        switch -- $delete_branch_checktype {
2082        head {set check_rev $delete_branch_head}
2083        tracking {set check_rev $delete_branch_trackinghead}
2084        always {set check_rev {:none}}
2085        }
2086        if {$check_rev eq {:none}} {
2087                set check_cmt {}
2088        } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2089                tk_messageBox \
2090                        -icon error \
2091                        -type ok \
2092                        -title [wm title $w] \
2093                        -parent $w \
2094                        -message "Invalid check revision: $check_rev"
2095                return
2096        }
2097
2098        set to_delete [list]
2099        set not_merged [list]
2100        foreach i [$w.list.l curselection] {
2101                set b [$w.list.l get $i]
2102                if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2103                if {$check_cmt ne {}} {
2104                        if {$b eq $check_rev} continue
2105                        if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2106                        if {$o ne $m} {
2107                                lappend not_merged $b
2108                                continue
2109                        }
2110                }
2111                lappend to_delete [list $b $o]
2112        }
2113        if {$not_merged ne {}} {
2114                set msg "The following branches are not completely merged into $check_rev:
2115
2116 - [join $not_merged "\n - "]"
2117                tk_messageBox \
2118                        -icon info \
2119                        -type ok \
2120                        -title [wm title $w] \
2121                        -parent $w \
2122                        -message $msg
2123        }
2124        if {$to_delete eq {}} return
2125        if {$delete_branch_checktype eq {always}} {
2126                set msg {Recovering deleted branches is difficult.
2127
2128Delete the selected branches?}
2129                if {[tk_messageBox \
2130                        -icon warning \
2131                        -type yesno \
2132                        -title [wm title $w] \
2133                        -parent $w \
2134                        -message $msg] ne yes} {
2135                        return
2136                }
2137        }
2138
2139        set failed {}
2140        foreach i $to_delete {
2141                set b [lindex $i 0]
2142                set o [lindex $i 1]
2143                if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2144                        append failed " - $b: $err\n"
2145                } else {
2146                        set x [lsearch -sorted $all_heads $b]
2147                        if {$x >= 0} {
2148                                set all_heads [lreplace $all_heads $x $x]
2149                        }
2150                }
2151        }
2152
2153        if {$failed ne {}} {
2154                tk_messageBox \
2155                        -icon error \
2156                        -type ok \
2157                        -title [wm title $w] \
2158                        -parent $w \
2159                        -message "Failed to delete branches:\n$failed"
2160        }
2161
2162        set all_heads [lsort $all_heads]
2163        populate_branch_menu
2164        destroy $w
2165}
2166
2167proc do_delete_branch {} {
2168        global all_heads tracking_branches current_branch
2169        global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2170
2171        set w .branch_editor
2172        toplevel $w
2173        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2174
2175        label $w.header -text {Delete Local Branch} \
2176                -font font_uibold
2177        pack $w.header -side top -fill x
2178
2179        frame $w.buttons
2180        button $w.buttons.create -text Delete \
2181                -font font_ui \
2182                -command [list do_delete_branch_action $w]
2183        pack $w.buttons.create -side right
2184        button $w.buttons.cancel -text {Cancel} \
2185                -font font_ui \
2186                -command [list destroy $w]
2187        pack $w.buttons.cancel -side right -padx 5
2188        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2189
2190        labelframe $w.list \
2191                -text {Local Branches} \
2192                -font font_ui
2193        listbox $w.list.l \
2194                -height 10 \
2195                -width 50 \
2196                -selectmode extended \
2197                -font font_ui
2198        foreach h $all_heads {
2199                if {$h ne $current_branch} {
2200                        $w.list.l insert end $h
2201                }
2202        }
2203        pack $w.list.l -fill both -pady 5 -padx 5
2204        pack $w.list -fill both -pady 5 -padx 5
2205
2206        labelframe $w.validate \
2207                -text {Delete Only If} \
2208                -font font_ui
2209        radiobutton $w.validate.head_r \
2210                -text {Merged Into Local Branch:} \
2211                -value head \
2212                -variable delete_branch_checktype \
2213                -font font_ui
2214        eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2215        grid $w.validate.head_r $w.validate.head_m -sticky w
2216        set all_trackings [all_tracking_branches]
2217        if {$all_trackings ne {}} {
2218                set delete_branch_trackinghead [lindex $all_trackings 0]
2219                radiobutton $w.validate.tracking_r \
2220                        -text {Merged Into Tracking Branch:} \
2221                        -value tracking \
2222                        -variable delete_branch_checktype \
2223                        -font font_ui
2224                eval tk_optionMenu $w.validate.tracking_m \
2225                        delete_branch_trackinghead \
2226                        $all_trackings
2227                grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2228        }
2229        radiobutton $w.validate.always_r \
2230                -text {Always (Do not perform merge checks)} \
2231                -value always \
2232                -variable delete_branch_checktype \
2233                -font font_ui
2234        grid $w.validate.always_r -columnspan 2 -sticky w
2235        grid columnconfigure $w.validate 1 -weight 1
2236        pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2237
2238        set delete_branch_head $current_branch
2239        set delete_branch_checktype head
2240
2241        bind $w <Visibility> "grab $w; focus $w"
2242        bind $w <Key-Escape> "destroy $w"
2243        wm title $w "[appname] ([reponame]): Delete Branch"
2244        tkwait window $w
2245}
2246
2247proc switch_branch {new_branch} {
2248        global HEAD commit_type current_branch repo_config
2249
2250        if {![lock_index switch]} return
2251
2252        # -- Our in memory state should match the repository.
2253        #
2254        repository_state curType curHEAD curMERGE_HEAD
2255        if {[string match amend* $commit_type]
2256                && $curType eq {normal}
2257                && $curHEAD eq $HEAD} {
2258        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2259                info_popup {Last scanned state does not match repository state.
2260
2261Another Git program has modified this repository
2262since the last scan.  A rescan must be performed
2263before the current branch can be changed.
2264
2265The rescan will be automatically started now.
2266}
2267                unlock_index
2268                rescan {set ui_status_value {Ready.}}
2269                return
2270        }
2271
2272        if {$repo_config(gui.trustmtime) eq {true}} {
2273                switch_branch_stage2 {} $new_branch
2274        } else {
2275                set ui_status_value {Refreshing file status...}
2276                set cmd [list git update-index]
2277                lappend cmd -q
2278                lappend cmd --unmerged
2279                lappend cmd --ignore-missing
2280                lappend cmd --refresh
2281                set fd_rf [open "| $cmd" r]
2282                fconfigure $fd_rf -blocking 0 -translation binary
2283                fileevent $fd_rf readable \
2284                        [list switch_branch_stage2 $fd_rf $new_branch]
2285        }
2286}
2287
2288proc switch_branch_stage2 {fd_rf new_branch} {
2289        global ui_status_value HEAD
2290
2291        if {$fd_rf ne {}} {
2292                read $fd_rf
2293                if {![eof $fd_rf]} return
2294                close $fd_rf
2295        }
2296
2297        set ui_status_value "Updating working directory to '$new_branch'..."
2298        set cmd [list git read-tree]
2299        lappend cmd -m
2300        lappend cmd -u
2301        lappend cmd --exclude-per-directory=.gitignore
2302        lappend cmd $HEAD
2303        lappend cmd $new_branch
2304        set fd_rt [open "| $cmd" r]
2305        fconfigure $fd_rt -blocking 0 -translation binary
2306        fileevent $fd_rt readable \
2307                [list switch_branch_readtree_wait $fd_rt $new_branch]
2308}
2309
2310proc switch_branch_readtree_wait {fd_rt new_branch} {
2311        global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2312        global current_branch
2313        global ui_comm ui_status_value
2314
2315        # -- We never get interesting output on stdout; only stderr.
2316        #
2317        read $fd_rt
2318        fconfigure $fd_rt -blocking 1
2319        if {![eof $fd_rt]} {
2320                fconfigure $fd_rt -blocking 0
2321                return
2322        }
2323
2324        # -- The working directory wasn't in sync with the index and
2325        #    we'd have to overwrite something to make the switch. A
2326        #    merge is required.
2327        #
2328        if {[catch {close $fd_rt} err]} {
2329                regsub {^fatal: } $err {} err
2330                warn_popup "File level merge required.
2331
2332$err
2333
2334Staying on branch '$current_branch'."
2335                set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2336                unlock_index
2337                return
2338        }
2339
2340        # -- Update the symbolic ref.  Core git doesn't even check for failure
2341        #    here, it Just Works(tm).  If it doesn't we are in some really ugly
2342        #    state that is difficult to recover from within git-gui.
2343        #
2344        if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2345                error_popup "Failed to set current branch.
2346
2347This working directory is only partially switched.
2348We successfully updated your files, but failed to
2349update an internal Git file.
2350
2351This should not have occurred.  [appname] will now
2352close and give up.
2353
2354$err"
2355                do_quit
2356                return
2357        }
2358
2359        # -- Update our repository state.  If we were previously in amend mode
2360        #    we need to toss the current buffer and do a full rescan to update
2361        #    our file lists.  If we weren't in amend mode our file lists are
2362        #    accurate and we can avoid the rescan.
2363        #
2364        unlock_index
2365        set selected_commit_type new
2366        if {[string match amend* $commit_type]} {
2367                $ui_comm delete 0.0 end
2368                $ui_comm edit reset
2369                $ui_comm edit modified false
2370                rescan {set ui_status_value "Checked out branch '$current_branch'."}
2371        } else {
2372                repository_state commit_type HEAD MERGE_HEAD
2373                set PARENT $HEAD
2374                set ui_status_value "Checked out branch '$current_branch'."
2375        }
2376}
2377
2378######################################################################
2379##
2380## remote management
2381
2382proc load_all_remotes {} {
2383        global repo_config
2384        global all_remotes tracking_branches
2385
2386        set all_remotes [list]
2387        array unset tracking_branches
2388
2389        set rm_dir [gitdir remotes]
2390        if {[file isdirectory $rm_dir]} {
2391                set all_remotes [glob \
2392                        -types f \
2393                        -tails \
2394                        -nocomplain \
2395                        -directory $rm_dir *]
2396
2397                foreach name $all_remotes {
2398                        catch {
2399                                set fd [open [file join $rm_dir $name] r]
2400                                while {[gets $fd line] >= 0} {
2401                                        if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2402                                                $line line src dst]} continue
2403                                        if {![regexp ^refs/ $dst]} {
2404                                                set dst "refs/heads/$dst"
2405                                        }
2406                                        set tracking_branches($dst) [list $name $src]
2407                                }
2408                                close $fd
2409                        }
2410                }
2411        }
2412
2413        foreach line [array names repo_config remote.*.url] {
2414                if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2415                lappend all_remotes $name
2416
2417                if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2418                        set fl {}
2419                }
2420                foreach line $fl {
2421                        if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2422                        if {![regexp ^refs/ $dst]} {
2423                                set dst "refs/heads/$dst"
2424                        }
2425                        set tracking_branches($dst) [list $name $src]
2426                }
2427        }
2428
2429        set all_remotes [lsort -unique $all_remotes]
2430}
2431
2432proc populate_fetch_menu {m} {
2433        global all_remotes repo_config
2434
2435        foreach r $all_remotes {
2436                set enable 0
2437                if {![catch {set a $repo_config(remote.$r.url)}]} {
2438                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2439                                set enable 1
2440                        }
2441                } else {
2442                        catch {
2443                                set fd [open [gitdir remotes $r] r]
2444                                while {[gets $fd n] >= 0} {
2445                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2446                                                set enable 1
2447                                                break
2448                                        }
2449                                }
2450                                close $fd
2451                        }
2452                }
2453
2454                if {$enable} {
2455                        $m add command \
2456                                -label "Fetch from $r..." \
2457                                -command [list fetch_from $r] \
2458                                -font font_ui
2459                }
2460        }
2461}
2462
2463proc populate_push_menu {m} {
2464        global all_remotes repo_config
2465
2466        foreach r $all_remotes {
2467                set enable 0
2468                if {![catch {set a $repo_config(remote.$r.url)}]} {
2469                        if {![catch {set a $repo_config(remote.$r.push)}]} {
2470                                set enable 1
2471                        }
2472                } else {
2473                        catch {
2474                                set fd [open [gitdir remotes $r] r]
2475                                while {[gets $fd n] >= 0} {
2476                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2477                                                set enable 1
2478                                                break
2479                                        }
2480                                }
2481                                close $fd
2482                        }
2483                }
2484
2485                if {$enable} {
2486                        $m add command \
2487                                -label "Push to $r..." \
2488                                -command [list push_to $r] \
2489                                -font font_ui
2490                }
2491        }
2492}
2493
2494proc populate_pull_menu {m} {
2495        global repo_config all_remotes disable_on_lock
2496
2497        foreach remote $all_remotes {
2498                set rb_list [list]
2499                if {[array get repo_config remote.$remote.url] ne {}} {
2500                        if {[array get repo_config remote.$remote.fetch] ne {}} {
2501                                foreach line $repo_config(remote.$remote.fetch) {
2502                                        if {[regexp {^([^:]+):} $line line rb]} {
2503                                                lappend rb_list $rb
2504                                        }
2505                                }
2506                        }
2507                } else {
2508                        catch {
2509                                set fd [open [gitdir remotes $remote] r]
2510                                while {[gets $fd line] >= 0} {
2511                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
2512                                                lappend rb_list $rb
2513                                        }
2514                                }
2515                                close $fd
2516                        }
2517                }
2518
2519                foreach rb $rb_list {
2520                        regsub ^refs/heads/ $rb {} rb_short
2521                        $m add command \
2522                                -label "Branch $rb_short from $remote..." \
2523                                -command [list pull_remote $remote $rb] \
2524                                -font font_ui
2525                        lappend disable_on_lock \
2526                                [list $m entryconf [$m index last] -state]
2527                }
2528        }
2529}
2530
2531######################################################################
2532##
2533## icons
2534
2535set filemask {
2536#define mask_width 14
2537#define mask_height 15
2538static unsigned char mask_bits[] = {
2539   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2540   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2541   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2542}
2543
2544image create bitmap file_plain -background white -foreground black -data {
2545#define plain_width 14
2546#define plain_height 15
2547static unsigned char plain_bits[] = {
2548   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2549   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2550   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2551} -maskdata $filemask
2552
2553image create bitmap file_mod -background white -foreground blue -data {
2554#define mod_width 14
2555#define mod_height 15
2556static unsigned char mod_bits[] = {
2557   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2558   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2559   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2560} -maskdata $filemask
2561
2562image create bitmap file_fulltick -background white -foreground "#007000" -data {
2563#define file_fulltick_width 14
2564#define file_fulltick_height 15
2565static unsigned char file_fulltick_bits[] = {
2566   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2567   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2568   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2569} -maskdata $filemask
2570
2571image create bitmap file_parttick -background white -foreground "#005050" -data {
2572#define parttick_width 14
2573#define parttick_height 15
2574static unsigned char parttick_bits[] = {
2575   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2576   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2577   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2578} -maskdata $filemask
2579
2580image create bitmap file_question -background white -foreground black -data {
2581#define file_question_width 14
2582#define file_question_height 15
2583static unsigned char file_question_bits[] = {
2584   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2585   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2586   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2587} -maskdata $filemask
2588
2589image create bitmap file_removed -background white -foreground red -data {
2590#define file_removed_width 14
2591#define file_removed_height 15
2592static unsigned char file_removed_bits[] = {
2593   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2594   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2595   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2596} -maskdata $filemask
2597
2598image create bitmap file_merge -background white -foreground blue -data {
2599#define file_merge_width 14
2600#define file_merge_height 15
2601static unsigned char file_merge_bits[] = {
2602   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2603   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2604   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2605} -maskdata $filemask
2606
2607set ui_index .vpane.files.index.list
2608set ui_workdir .vpane.files.workdir.list
2609
2610set all_icons(_$ui_index)   file_plain
2611set all_icons(A$ui_index)   file_fulltick
2612set all_icons(M$ui_index)   file_fulltick
2613set all_icons(D$ui_index)   file_removed
2614set all_icons(U$ui_index)   file_merge
2615
2616set all_icons(_$ui_workdir) file_plain
2617set all_icons(M$ui_workdir) file_mod
2618set all_icons(D$ui_workdir) file_question
2619set all_icons(U$ui_workdir) file_merge
2620set all_icons(O$ui_workdir) file_plain
2621
2622set max_status_desc 0
2623foreach i {
2624                {__ "Unmodified"}
2625
2626                {_M "Modified, not staged"}
2627                {M_ "Staged for commit"}
2628                {MM "Portions staged for commit"}
2629                {MD "Staged for commit, missing"}
2630
2631                {_O "Untracked, not staged"}
2632                {A_ "Staged for commit"}
2633                {AM "Portions staged for commit"}
2634                {AD "Staged for commit, missing"}
2635
2636                {_D "Missing"}
2637                {D_ "Staged for removal"}
2638                {DO "Staged for removal, still present"}
2639
2640                {U_ "Requires merge resolution"}
2641                {UU "Requires merge resolution"}
2642                {UM "Requires merge resolution"}
2643                {UD "Requires merge resolution"}
2644        } {
2645        if {$max_status_desc < [string length [lindex $i 1]]} {
2646                set max_status_desc [string length [lindex $i 1]]
2647        }
2648        set all_descs([lindex $i 0]) [lindex $i 1]
2649}
2650unset i
2651
2652######################################################################
2653##
2654## util
2655
2656proc is_MacOSX {} {
2657        global tcl_platform tk_library
2658        if {[tk windowingsystem] eq {aqua}} {
2659                return 1
2660        }
2661        return 0
2662}
2663
2664proc is_Windows {} {
2665        global tcl_platform
2666        if {$tcl_platform(platform) eq {windows}} {
2667                return 1
2668        }
2669        return 0
2670}
2671
2672proc bind_button3 {w cmd} {
2673        bind $w <Any-Button-3> $cmd
2674        if {[is_MacOSX]} {
2675                bind $w <Control-Button-1> $cmd
2676        }
2677}
2678
2679proc incr_font_size {font {amt 1}} {
2680        set sz [font configure $font -size]
2681        incr sz $amt
2682        font configure $font -size $sz
2683        font configure ${font}bold -size $sz
2684}
2685
2686proc hook_failed_popup {hook msg} {
2687        set w .hookfail
2688        toplevel $w
2689
2690        frame $w.m
2691        label $w.m.l1 -text "$hook hook failed:" \
2692                -anchor w \
2693                -justify left \
2694                -font font_uibold
2695        text $w.m.t \
2696                -background white -borderwidth 1 \
2697                -relief sunken \
2698                -width 80 -height 10 \
2699                -font font_diff \
2700                -yscrollcommand [list $w.m.sby set]
2701        label $w.m.l2 \
2702                -text {You must correct the above errors before committing.} \
2703                -anchor w \
2704                -justify left \
2705                -font font_uibold
2706        scrollbar $w.m.sby -command [list $w.m.t yview]
2707        pack $w.m.l1 -side top -fill x
2708        pack $w.m.l2 -side bottom -fill x
2709        pack $w.m.sby -side right -fill y
2710        pack $w.m.t -side left -fill both -expand 1
2711        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2712
2713        $w.m.t insert 1.0 $msg
2714        $w.m.t conf -state disabled
2715
2716        button $w.ok -text OK \
2717                -width 15 \
2718                -font font_ui \
2719                -command "destroy $w"
2720        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2721
2722        bind $w <Visibility> "grab $w; focus $w"
2723        bind $w <Key-Return> "destroy $w"
2724        wm title $w "[appname] ([reponame]): error"
2725        tkwait window $w
2726}
2727
2728set next_console_id 0
2729
2730proc new_console {short_title long_title} {
2731        global next_console_id console_data
2732        set w .console[incr next_console_id]
2733        set console_data($w) [list $short_title $long_title]
2734        return [console_init $w]
2735}
2736
2737proc console_init {w} {
2738        global console_cr console_data M1B
2739
2740        set console_cr($w) 1.0
2741        toplevel $w
2742        frame $w.m
2743        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2744                -anchor w \
2745                -justify left \
2746                -font font_uibold
2747        text $w.m.t \
2748                -background white -borderwidth 1 \
2749                -relief sunken \
2750                -width 80 -height 10 \
2751                -font font_diff \
2752                -state disabled \
2753                -yscrollcommand [list $w.m.sby set]
2754        label $w.m.s -text {Working... please wait...} \
2755                -anchor w \
2756                -justify left \
2757                -font font_uibold
2758        scrollbar $w.m.sby -command [list $w.m.t yview]
2759        pack $w.m.l1 -side top -fill x
2760        pack $w.m.s -side bottom -fill x
2761        pack $w.m.sby -side right -fill y
2762        pack $w.m.t -side left -fill both -expand 1
2763        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2764
2765        menu $w.ctxm -tearoff 0
2766        $w.ctxm add command -label "Copy" \
2767                -font font_ui \
2768                -command "tk_textCopy $w.m.t"
2769        $w.ctxm add command -label "Select All" \
2770                -font font_ui \
2771                -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
2772        $w.ctxm add command -label "Copy All" \
2773                -font font_ui \
2774                -command "
2775                        $w.m.t tag add sel 0.0 end
2776                        tk_textCopy $w.m.t
2777                        $w.m.t tag remove sel 0.0 end
2778                "
2779
2780        button $w.ok -text {Close} \
2781                -font font_ui \
2782                -state disabled \
2783                -command "destroy $w"
2784        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2785
2786        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2787        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2788        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2789        bind $w <Visibility> "focus $w"
2790        wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2791        return $w
2792}
2793
2794proc console_exec {w cmd {after {}}} {
2795        # -- Windows tosses the enviroment when we exec our child.
2796        #    But most users need that so we have to relogin. :-(
2797        #
2798        if {[is_Windows]} {
2799                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2800        }
2801
2802        # -- Tcl won't let us redirect both stdout and stderr to
2803        #    the same pipe.  So pass it through cat...
2804        #
2805        set cmd [concat | $cmd |& cat]
2806
2807        set fd_f [open $cmd r]
2808        fconfigure $fd_f -blocking 0 -translation binary
2809        fileevent $fd_f readable [list console_read $w $fd_f $after]
2810}
2811
2812proc console_read {w fd after} {
2813        global console_cr console_data
2814
2815        set buf [read $fd]
2816        if {$buf ne {}} {
2817                if {![winfo exists $w]} {console_init $w}
2818                $w.m.t conf -state normal
2819                set c 0
2820                set n [string length $buf]
2821                while {$c < $n} {
2822                        set cr [string first "\r" $buf $c]
2823                        set lf [string first "\n" $buf $c]
2824                        if {$cr < 0} {set cr [expr {$n + 1}]}
2825                        if {$lf < 0} {set lf [expr {$n + 1}]}
2826
2827                        if {$lf < $cr} {
2828                                $w.m.t insert end [string range $buf $c $lf]
2829                                set console_cr($w) [$w.m.t index {end -1c}]
2830                                set c $lf
2831                                incr c
2832                        } else {
2833                                $w.m.t delete $console_cr($w) end
2834                                $w.m.t insert end "\n"
2835                                $w.m.t insert end [string range $buf $c $cr]
2836                                set c $cr
2837                                incr c
2838                        }
2839                }
2840                $w.m.t conf -state disabled
2841                $w.m.t see end
2842        }
2843
2844        fconfigure $fd -blocking 1
2845        if {[eof $fd]} {
2846                if {[catch {close $fd}]} {
2847                        if {![winfo exists $w]} {console_init $w}
2848                        $w.m.s conf -background red -text {Error: Command Failed}
2849                        $w.ok conf -state normal
2850                        set ok 0
2851                } elseif {[winfo exists $w]} {
2852                        $w.m.s conf -background green -text {Success}
2853                        $w.ok conf -state normal
2854                        set ok 1
2855                }
2856                array unset console_cr $w
2857                array unset console_data $w
2858                if {$after ne {}} {
2859                        uplevel #0 $after $ok
2860                }
2861                return
2862        }
2863        fconfigure $fd -blocking 0
2864}
2865
2866######################################################################
2867##
2868## ui commands
2869
2870set starting_gitk_msg {Starting gitk... please wait...}
2871
2872proc do_gitk {revs} {
2873        global ui_status_value starting_gitk_msg
2874
2875        set cmd gitk
2876        if {$revs ne {}} {
2877                append cmd { }
2878                append cmd $revs
2879        }
2880        if {[is_Windows]} {
2881                set cmd "sh -c \"exec $cmd\""
2882        }
2883        append cmd { &}
2884
2885        if {[catch {eval exec $cmd} err]} {
2886                error_popup "Failed to start gitk:\n\n$err"
2887        } else {
2888                set ui_status_value $starting_gitk_msg
2889                after 10000 {
2890                        if {$ui_status_value eq $starting_gitk_msg} {
2891                                set ui_status_value {Ready.}
2892                        }
2893                }
2894        }
2895}
2896
2897proc do_stats {} {
2898        set fd [open "| git count-objects -v" r]
2899        while {[gets $fd line] > 0} {
2900                if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
2901                        set stats($name) $value
2902                }
2903        }
2904        close $fd
2905
2906        set packed_sz 0
2907        foreach p [glob -directory [gitdir objects pack] \
2908                -type f \
2909                -nocomplain -- *] {
2910                incr packed_sz [file size $p]
2911        }
2912        if {$packed_sz > 0} {
2913                set stats(size-pack) [expr {$packed_sz / 1024}]
2914        }
2915
2916        set w .stats_view
2917        toplevel $w
2918        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2919
2920        label $w.header -text {Database Statistics} \
2921                -font font_uibold
2922        pack $w.header -side top -fill x
2923
2924        frame $w.buttons -border 1
2925        button $w.buttons.close -text Close \
2926                -font font_ui \
2927                -command [list destroy $w]
2928        button $w.buttons.gc -text {Compress Database} \
2929                -font font_ui \
2930                -command "destroy $w;do_gc"
2931        pack $w.buttons.close -side right
2932        pack $w.buttons.gc -side left
2933        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2934
2935        frame $w.stat -borderwidth 1 -relief solid
2936        foreach s {
2937                {count           {Number of loose objects}}
2938                {size            {Disk space used by loose objects} { KiB}}
2939                {in-pack         {Number of packed objects}}
2940                {packs           {Number of packs}}
2941                {size-pack       {Disk space used by packed objects} { KiB}}
2942                {prune-packable  {Packed objects waiting for pruning}}
2943                {garbage         {Garbage files}}
2944                } {
2945                set name [lindex $s 0]
2946                set label [lindex $s 1]
2947                if {[catch {set value $stats($name)}]} continue
2948                if {[llength $s] > 2} {
2949                        set value "$value[lindex $s 2]"
2950                }
2951
2952                label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
2953                label $w.stat.v_$name -text $value -anchor w -font font_ui
2954                grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
2955        }
2956        pack $w.stat -pady 10 -padx 10
2957
2958        bind $w <Visibility> "grab $w; focus $w"
2959        bind $w <Key-Escape> [list destroy $w]
2960        bind $w <Key-Return> [list destroy $w]
2961        wm title $w "[appname] ([reponame]): Database Statistics"
2962        tkwait window $w
2963}
2964
2965proc do_gc {} {
2966        set w [new_console {gc} {Compressing the object database}]
2967        console_exec $w {git gc}
2968}
2969
2970proc do_fsck_objects {} {
2971        set w [new_console {fsck-objects} \
2972                {Verifying the object database with fsck-objects}]
2973        set cmd [list git fsck-objects]
2974        lappend cmd --full
2975        lappend cmd --cache
2976        lappend cmd --strict
2977        console_exec $w $cmd
2978}
2979
2980set is_quitting 0
2981
2982proc do_quit {} {
2983        global ui_comm is_quitting repo_config commit_type
2984
2985        if {$is_quitting} return
2986        set is_quitting 1
2987
2988        # -- Stash our current commit buffer.
2989        #
2990        set save [gitdir GITGUI_MSG]
2991        set msg [string trim [$ui_comm get 0.0 end]]
2992        regsub -all -line {[ \r\t]+$} $msg {} msg
2993        if {(![string match amend* $commit_type]
2994                || [$ui_comm edit modified])
2995                && $msg ne {}} {
2996                catch {
2997                        set fd [open $save w]
2998                        puts -nonewline $fd $msg
2999                        close $fd
3000                }
3001        } else {
3002                catch {file delete $save}
3003        }
3004
3005        # -- Stash our current window geometry into this repository.
3006        #
3007        set cfg_geometry [list]
3008        lappend cfg_geometry [wm geometry .]
3009        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
3010        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
3011        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
3012                set rc_geometry {}
3013        }
3014        if {$cfg_geometry ne $rc_geometry} {
3015                catch {exec git repo-config gui.geometry $cfg_geometry}
3016        }
3017
3018        destroy .
3019}
3020
3021proc do_rescan {} {
3022        rescan {set ui_status_value {Ready.}}
3023}
3024
3025proc unstage_helper {txt paths} {
3026        global file_states current_diff_path
3027
3028        if {![lock_index begin-update]} return
3029
3030        set pathList [list]
3031        set after {}
3032        foreach path $paths {
3033                switch -glob -- [lindex $file_states($path) 0] {
3034                A? -
3035                M? -
3036                D? {
3037                        lappend pathList $path
3038                        if {$path eq $current_diff_path} {
3039                                set after {reshow_diff;}
3040                        }
3041                }
3042                }
3043        }
3044        if {$pathList eq {}} {
3045                unlock_index
3046        } else {
3047                update_indexinfo \
3048                        $txt \
3049                        $pathList \
3050                        [concat $after {set ui_status_value {Ready.}}]
3051        }
3052}
3053
3054proc do_unstage_selection {} {
3055        global current_diff_path selected_paths
3056
3057        if {[array size selected_paths] > 0} {
3058                unstage_helper \
3059                        {Unstaging selected files from commit} \
3060                        [array names selected_paths]
3061        } elseif {$current_diff_path ne {}} {
3062                unstage_helper \
3063                        "Unstaging [short_path $current_diff_path] from commit" \
3064                        [list $current_diff_path]
3065        }
3066}
3067
3068proc add_helper {txt paths} {
3069        global file_states current_diff_path
3070
3071        if {![lock_index begin-update]} return
3072
3073        set pathList [list]
3074        set after {}
3075        foreach path $paths {
3076                switch -glob -- [lindex $file_states($path) 0] {
3077                _O -
3078                ?M -
3079                ?D -
3080                U? {
3081                        lappend pathList $path
3082                        if {$path eq $current_diff_path} {
3083                                set after {reshow_diff;}
3084                        }
3085                }
3086                }
3087        }
3088        if {$pathList eq {}} {
3089                unlock_index
3090        } else {
3091                update_index \
3092                        $txt \
3093                        $pathList \
3094                        [concat $after {set ui_status_value {Ready to commit.}}]
3095        }
3096}
3097
3098proc do_add_selection {} {
3099        global current_diff_path selected_paths
3100
3101        if {[array size selected_paths] > 0} {
3102                add_helper \
3103                        {Adding selected files} \
3104                        [array names selected_paths]
3105        } elseif {$current_diff_path ne {}} {
3106                add_helper \
3107                        "Adding [short_path $current_diff_path]" \
3108                        [list $current_diff_path]
3109        }
3110}
3111
3112proc do_add_all {} {
3113        global file_states
3114
3115        set paths [list]
3116        foreach path [array names file_states] {
3117                switch -glob -- [lindex $file_states($path) 0] {
3118                U? {continue}
3119                ?M -
3120                ?D {lappend paths $path}
3121                }
3122        }
3123        add_helper {Adding all changed files} $paths
3124}
3125
3126proc revert_helper {txt paths} {
3127        global file_states current_diff_path
3128
3129        if {![lock_index begin-update]} return
3130
3131        set pathList [list]
3132        set after {}
3133        foreach path $paths {
3134                switch -glob -- [lindex $file_states($path) 0] {
3135                U? {continue}
3136                ?M -
3137                ?D {
3138                        lappend pathList $path
3139                        if {$path eq $current_diff_path} {
3140                                set after {reshow_diff;}
3141                        }
3142                }
3143                }
3144        }
3145
3146        set n [llength $pathList]
3147        if {$n == 0} {
3148                unlock_index
3149                return
3150        } elseif {$n == 1} {
3151                set s "[short_path [lindex $pathList]]"
3152        } else {
3153                set s "these $n files"
3154        }
3155
3156        set reply [tk_dialog \
3157                .confirm_revert \
3158                "[appname] ([reponame])" \
3159                "Revert changes in $s?
3160
3161Any unadded changes will be permanently lost by the revert." \
3162                question \
3163                1 \
3164                {Do Nothing} \
3165                {Revert Changes} \
3166                ]
3167        if {$reply == 1} {
3168                checkout_index \
3169                        $txt \
3170                        $pathList \
3171                        [concat $after {set ui_status_value {Ready.}}]
3172        } else {
3173                unlock_index
3174        }
3175}
3176
3177proc do_revert_selection {} {
3178        global current_diff_path selected_paths
3179
3180        if {[array size selected_paths] > 0} {
3181                revert_helper \
3182                        {Reverting selected files} \
3183                        [array names selected_paths]
3184        } elseif {$current_diff_path ne {}} {
3185                revert_helper \
3186                        "Reverting [short_path $current_diff_path]" \
3187                        [list $current_diff_path]
3188        }
3189}
3190
3191proc do_signoff {} {
3192        global ui_comm
3193
3194        set me [committer_ident]
3195        if {$me eq {}} return
3196
3197        set sob "Signed-off-by: $me"
3198        set last [$ui_comm get {end -1c linestart} {end -1c}]
3199        if {$last ne $sob} {
3200                $ui_comm edit separator
3201                if {$last ne {}
3202                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
3203                        $ui_comm insert end "\n"
3204                }
3205                $ui_comm insert end "\n$sob"
3206                $ui_comm edit separator
3207                $ui_comm see end
3208        }
3209}
3210
3211proc do_select_commit_type {} {
3212        global commit_type selected_commit_type
3213
3214        if {$selected_commit_type eq {new}
3215                && [string match amend* $commit_type]} {
3216                create_new_commit
3217        } elseif {$selected_commit_type eq {amend}
3218                && ![string match amend* $commit_type]} {
3219                load_last_commit
3220
3221                # The amend request was rejected...
3222                #
3223                if {![string match amend* $commit_type]} {
3224                        set selected_commit_type new
3225                }
3226        }
3227}
3228
3229proc do_commit {} {
3230        commit_tree
3231}
3232
3233proc do_about {} {
3234        global appvers copyright
3235        global tcl_patchLevel tk_patchLevel
3236
3237        set w .about_dialog
3238        toplevel $w
3239        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3240
3241        label $w.header -text "About [appname]" \
3242                -font font_uibold
3243        pack $w.header -side top -fill x
3244
3245        frame $w.buttons
3246        button $w.buttons.close -text {Close} \
3247                -font font_ui \
3248                -command [list destroy $w]
3249        pack $w.buttons.close -side right
3250        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3251
3252        label $w.desc \
3253                -text "[appname] - a commit creation tool for Git.
3254$copyright" \
3255                -padx 5 -pady 5 \
3256                -justify left \
3257                -anchor w \
3258                -borderwidth 1 \
3259                -relief solid \
3260                -font font_ui
3261        pack $w.desc -side top -fill x -padx 5 -pady 5
3262
3263        set v {}
3264        append v "[appname] version $appvers\n"
3265        append v "[exec git version]\n"
3266        append v "\n"
3267        if {$tcl_patchLevel eq $tk_patchLevel} {
3268                append v "Tcl/Tk version $tcl_patchLevel"
3269        } else {
3270                append v "Tcl version $tcl_patchLevel"
3271                append v ", Tk version $tk_patchLevel"
3272        }
3273
3274        label $w.vers \
3275                -text $v \
3276                -padx 5 -pady 5 \
3277                -justify left \
3278                -anchor w \
3279                -borderwidth 1 \
3280                -relief solid \
3281                -font font_ui
3282        pack $w.vers -side top -fill x -padx 5 -pady 5
3283
3284        menu $w.ctxm -tearoff 0
3285        $w.ctxm add command \
3286                -label {Copy} \
3287                -font font_ui \
3288                -command "
3289                clipboard clear
3290                clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3291        "
3292
3293        bind $w <Visibility> "grab $w; focus $w"
3294        bind $w <Key-Escape> "destroy $w"
3295        bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3296        wm title $w "About [appname]"
3297        tkwait window $w
3298}
3299
3300proc do_options {} {
3301        global repo_config global_config font_descs
3302        global repo_config_new global_config_new
3303
3304        array unset repo_config_new
3305        array unset global_config_new
3306        foreach name [array names repo_config] {
3307                set repo_config_new($name) $repo_config($name)
3308        }
3309        load_config 1
3310        foreach name [array names repo_config] {
3311                switch -- $name {
3312                gui.diffcontext {continue}
3313                }
3314                set repo_config_new($name) $repo_config($name)
3315        }
3316        foreach name [array names global_config] {
3317                set global_config_new($name) $global_config($name)
3318        }
3319
3320        set w .options_editor
3321        toplevel $w
3322        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3323
3324        label $w.header -text "[appname] Options" \
3325                -font font_uibold
3326        pack $w.header -side top -fill x
3327
3328        frame $w.buttons
3329        button $w.buttons.restore -text {Restore Defaults} \
3330                -font font_ui \
3331                -command do_restore_defaults
3332        pack $w.buttons.restore -side left
3333        button $w.buttons.save -text Save \
3334                -font font_ui \
3335                -command [list do_save_config $w]
3336        pack $w.buttons.save -side right
3337        button $w.buttons.cancel -text {Cancel} \
3338                -font font_ui \
3339                -command [list destroy $w]
3340        pack $w.buttons.cancel -side right -padx 5
3341        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3342
3343        labelframe $w.repo -text "[reponame] Repository" \
3344                -font font_ui
3345        labelframe $w.global -text {Global (All Repositories)} \
3346                -font font_ui
3347        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
3348        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
3349
3350        foreach option {
3351                {b pullsummary {Show Pull Summary}}
3352                {b trustmtime  {Trust File Modification Timestamps}}
3353                {i diffcontext {Number of Diff Context Lines}}
3354                {t newbranchtemplate {New Branch Name Template}}
3355                } {
3356                set type [lindex $option 0]
3357                set name [lindex $option 1]
3358                set text [lindex $option 2]
3359                foreach f {repo global} {
3360                        switch $type {
3361                        b {
3362                                checkbutton $w.$f.$name -text $text \
3363                                        -variable ${f}_config_new(gui.$name) \
3364                                        -onvalue true \
3365                                        -offvalue false \
3366                                        -font font_ui
3367                                pack $w.$f.$name -side top -anchor w
3368                        }
3369                        i {
3370                                frame $w.$f.$name
3371                                label $w.$f.$name.l -text "$text:" -font font_ui
3372                                pack $w.$f.$name.l -side left -anchor w -fill x
3373                                spinbox $w.$f.$name.v \
3374                                        -textvariable ${f}_config_new(gui.$name) \
3375                                        -from 1 -to 99 -increment 1 \
3376                                        -width 3 \
3377                                        -font font_ui
3378                                bind $w.$f.$name.v <FocusIn> {%W selection range 0 end}
3379                                pack $w.$f.$name.v -side right -anchor e -padx 5
3380                                pack $w.$f.$name -side top -anchor w -fill x
3381                        }
3382                        t {
3383                                frame $w.$f.$name
3384                                label $w.$f.$name.l -text "$text:" -font font_ui
3385                                entry $w.$f.$name.v \
3386                                        -borderwidth 1 \
3387                                        -relief sunken \
3388                                        -width 20 \
3389                                        -textvariable ${f}_config_new(gui.$name) \
3390                                        -font font_ui
3391                                pack $w.$f.$name.l -side left -anchor w
3392                                pack $w.$f.$name.v -side left -anchor w \
3393                                        -fill x -expand 1 \
3394                                        -padx 5
3395                                pack $w.$f.$name -side top -anchor w -fill x
3396                        }
3397                        }
3398                }
3399        }
3400
3401        set all_fonts [lsort [font families]]
3402        foreach option $font_descs {
3403                set name [lindex $option 0]
3404                set font [lindex $option 1]
3405                set text [lindex $option 2]
3406
3407                set global_config_new(gui.$font^^family) \
3408                        [font configure $font -family]
3409                set global_config_new(gui.$font^^size) \
3410                        [font configure $font -size]
3411
3412                frame $w.global.$name
3413                label $w.global.$name.l -text "$text:" -font font_ui
3414                pack $w.global.$name.l -side left -anchor w -fill x
3415                eval tk_optionMenu $w.global.$name.family \
3416                        global_config_new(gui.$font^^family) \
3417                        $all_fonts
3418                spinbox $w.global.$name.size \
3419                        -textvariable global_config_new(gui.$font^^size) \
3420                        -from 2 -to 80 -increment 1 \
3421                        -width 3 \
3422                        -font font_ui
3423                bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3424                pack $w.global.$name.size -side right -anchor e
3425                pack $w.global.$name.family -side right -anchor e
3426                pack $w.global.$name -side top -anchor w -fill x
3427        }
3428
3429        bind $w <Visibility> "grab $w; focus $w"
3430        bind $w <Key-Escape> "destroy $w"
3431        wm title $w "[appname] ([reponame]): Options"
3432        tkwait window $w
3433}
3434
3435proc do_restore_defaults {} {
3436        global font_descs default_config repo_config
3437        global repo_config_new global_config_new
3438
3439        foreach name [array names default_config] {
3440                set repo_config_new($name) $default_config($name)
3441                set global_config_new($name) $default_config($name)
3442        }
3443
3444        foreach option $font_descs {
3445                set name [lindex $option 0]
3446                set repo_config(gui.$name) $default_config(gui.$name)
3447        }
3448        apply_config
3449
3450        foreach option $font_descs {
3451                set name [lindex $option 0]
3452                set font [lindex $option 1]
3453                set global_config_new(gui.$font^^family) \
3454                        [font configure $font -family]
3455                set global_config_new(gui.$font^^size) \
3456                        [font configure $font -size]
3457        }
3458}
3459
3460proc do_save_config {w} {
3461        if {[catch {save_config} err]} {
3462                error_popup "Failed to completely save options:\n\n$err"
3463        }
3464        reshow_diff
3465        destroy $w
3466}
3467
3468proc do_windows_shortcut {} {
3469        global argv0
3470
3471        if {[catch {
3472                set desktop [exec cygpath \
3473                        --windows \
3474                        --absolute \
3475                        --long-name \
3476                        --desktop]
3477                }]} {
3478                        set desktop .
3479        }
3480        set fn [tk_getSaveFile \
3481                -parent . \
3482                -title "[appname] ([reponame]): Create Desktop Icon" \
3483                -initialdir $desktop \
3484                -initialfile "Git [reponame].bat"]
3485        if {$fn != {}} {
3486                if {[catch {
3487                                set fd [open $fn w]
3488                                set sh [exec cygpath \
3489                                        --windows \
3490                                        --absolute \
3491                                        /bin/sh]
3492                                set me [exec cygpath \
3493                                        --unix \
3494                                        --absolute \
3495                                        $argv0]
3496                                set gd [exec cygpath \
3497                                        --unix \
3498                                        --absolute \
3499                                        [gitdir]]
3500                                set gw [exec cygpath \
3501                                        --windows \
3502                                        --absolute \
3503                                        [file dirname [gitdir]]]
3504                                regsub -all ' $me "'\\''" me
3505                                regsub -all ' $gd "'\\''" gd
3506                                puts $fd "@ECHO Entering $gw"
3507                                puts $fd "@ECHO Starting git-gui... please wait..."
3508                                puts -nonewline $fd "@\"$sh\" --login -c \""
3509                                puts -nonewline $fd "GIT_DIR='$gd'"
3510                                puts -nonewline $fd " '$me'"
3511                                puts $fd "&\""
3512                                close $fd
3513                        } err]} {
3514                        error_popup "Cannot write script:\n\n$err"
3515                }
3516        }
3517}
3518
3519proc do_macosx_app {} {
3520        global argv0 env
3521
3522        set fn [tk_getSaveFile \
3523                -parent . \
3524                -title "[appname] ([reponame]): Create Desktop Icon" \
3525                -initialdir [file join $env(HOME) Desktop] \
3526                -initialfile "Git [reponame].app"]
3527        if {$fn != {}} {
3528                if {[catch {
3529                                set Contents [file join $fn Contents]
3530                                set MacOS [file join $Contents MacOS]
3531                                set exe [file join $MacOS git-gui]
3532
3533                                file mkdir $MacOS
3534
3535                                set fd [open [file join $Contents Info.plist] w]
3536                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3537<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3538<plist version="1.0">
3539<dict>
3540        <key>CFBundleDevelopmentRegion</key>
3541        <string>English</string>
3542        <key>CFBundleExecutable</key>
3543        <string>git-gui</string>
3544        <key>CFBundleIdentifier</key>
3545        <string>org.spearce.git-gui</string>
3546        <key>CFBundleInfoDictionaryVersion</key>
3547        <string>6.0</string>
3548        <key>CFBundlePackageType</key>
3549        <string>APPL</string>
3550        <key>CFBundleSignature</key>
3551        <string>????</string>
3552        <key>CFBundleVersion</key>
3553        <string>1.0</string>
3554        <key>NSPrincipalClass</key>
3555        <string>NSApplication</string>
3556</dict>
3557</plist>}
3558                                close $fd
3559
3560                                set fd [open $exe w]
3561                                set gd [file normalize [gitdir]]
3562                                set ep [file normalize [exec git --exec-path]]
3563                                regsub -all ' $gd "'\\''" gd
3564                                regsub -all ' $ep "'\\''" ep
3565                                puts $fd "#!/bin/sh"
3566                                foreach name [array names env] {
3567                                        if {[string match GIT_* $name]} {
3568                                                regsub -all ' $env($name) "'\\''" v
3569                                                puts $fd "export $name='$v'"
3570                                        }
3571                                }
3572                                puts $fd "export PATH='$ep':\$PATH"
3573                                puts $fd "export GIT_DIR='$gd'"
3574                                puts $fd "exec [file normalize $argv0]"
3575                                close $fd
3576
3577                                file attributes $exe -permissions u+x,g+x,o+x
3578                        } err]} {
3579                        error_popup "Cannot write icon:\n\n$err"
3580                }
3581        }
3582}
3583
3584proc toggle_or_diff {w x y} {
3585        global file_states file_lists current_diff_path ui_index ui_workdir
3586        global last_clicked selected_paths
3587
3588        set pos [split [$w index @$x,$y] .]
3589        set lno [lindex $pos 0]
3590        set col [lindex $pos 1]
3591        set path [lindex $file_lists($w) [expr {$lno - 1}]]
3592        if {$path eq {}} {
3593                set last_clicked {}
3594                return
3595        }
3596
3597        set last_clicked [list $w $lno]
3598        array unset selected_paths
3599        $ui_index tag remove in_sel 0.0 end
3600        $ui_workdir tag remove in_sel 0.0 end
3601
3602        if {$col == 0} {
3603                if {$current_diff_path eq $path} {
3604                        set after {reshow_diff;}
3605                } else {
3606                        set after {}
3607                }
3608                if {$w eq $ui_index} {
3609                        update_indexinfo \
3610                                "Unstaging [short_path $path] from commit" \
3611                                [list $path] \
3612                                [concat $after {set ui_status_value {Ready.}}]
3613                } elseif {$w eq $ui_workdir} {
3614                        update_index \
3615                                "Adding [short_path $path]" \
3616                                [list $path] \
3617                                [concat $after {set ui_status_value {Ready.}}]
3618                }
3619        } else {
3620                show_diff $path $w $lno
3621        }
3622}
3623
3624proc add_one_to_selection {w x y} {
3625        global file_lists last_clicked selected_paths
3626
3627        set lno [lindex [split [$w index @$x,$y] .] 0]
3628        set path [lindex $file_lists($w) [expr {$lno - 1}]]
3629        if {$path eq {}} {
3630                set last_clicked {}
3631                return
3632        }
3633
3634        if {$last_clicked ne {}
3635                && [lindex $last_clicked 0] ne $w} {
3636                array unset selected_paths
3637                [lindex $last_clicked 0] tag remove in_sel 0.0 end
3638        }
3639
3640        set last_clicked [list $w $lno]
3641        if {[catch {set in_sel $selected_paths($path)}]} {
3642                set in_sel 0
3643        }
3644        if {$in_sel} {
3645                unset selected_paths($path)
3646                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3647        } else {
3648                set selected_paths($path) 1
3649                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3650        }
3651}
3652
3653proc add_range_to_selection {w x y} {
3654        global file_lists last_clicked selected_paths
3655
3656        if {[lindex $last_clicked 0] ne $w} {
3657                toggle_or_diff $w $x $y
3658                return
3659        }
3660
3661        set lno [lindex [split [$w index @$x,$y] .] 0]
3662        set lc [lindex $last_clicked 1]
3663        if {$lc < $lno} {
3664                set begin $lc
3665                set end $lno
3666        } else {
3667                set begin $lno
3668                set end $lc
3669        }
3670
3671        foreach path [lrange $file_lists($w) \
3672                [expr {$begin - 1}] \
3673                [expr {$end - 1}]] {
3674                set selected_paths($path) 1
3675        }
3676        $w tag add in_sel $begin.0 [expr {$end + 1}].0
3677}
3678
3679######################################################################
3680##
3681## config defaults
3682
3683set cursor_ptr arrow
3684font create font_diff -family Courier -size 10
3685font create font_ui
3686catch {
3687        label .dummy
3688        eval font configure font_ui [font actual [.dummy cget -font]]
3689        destroy .dummy
3690}
3691
3692font create font_uibold
3693font create font_diffbold
3694
3695if {[is_Windows]} {
3696        set M1B Control
3697        set M1T Ctrl
3698} elseif {[is_MacOSX]} {
3699        set M1B M1
3700        set M1T Cmd
3701} else {
3702        set M1B M1
3703        set M1T M1
3704}
3705
3706proc apply_config {} {
3707        global repo_config font_descs
3708
3709        foreach option $font_descs {
3710                set name [lindex $option 0]
3711                set font [lindex $option 1]
3712                if {[catch {
3713                        foreach {cn cv} $repo_config(gui.$name) {
3714                                font configure $font $cn $cv
3715                        }
3716                        } err]} {
3717                        error_popup "Invalid font specified in gui.$name:\n\n$err"
3718                }
3719                foreach {cn cv} [font configure $font] {
3720                        font configure ${font}bold $cn $cv
3721                }
3722                font configure ${font}bold -weight bold
3723        }
3724}
3725
3726set default_config(gui.trustmtime) false
3727set default_config(gui.pullsummary) true
3728set default_config(gui.diffcontext) 5
3729set default_config(gui.newbranchtemplate) {}
3730set default_config(gui.fontui) [font configure font_ui]
3731set default_config(gui.fontdiff) [font configure font_diff]
3732set font_descs {
3733        {fontui   font_ui   {Main Font}}
3734        {fontdiff font_diff {Diff/Console Font}}
3735}
3736load_config 0
3737apply_config
3738
3739######################################################################
3740##
3741## ui construction
3742
3743# -- Menu Bar
3744#
3745menu .mbar -tearoff 0
3746.mbar add cascade -label Repository -menu .mbar.repository
3747.mbar add cascade -label Edit -menu .mbar.edit
3748if {!$single_commit} {
3749        .mbar add cascade -label Branch -menu .mbar.branch
3750}
3751.mbar add cascade -label Commit -menu .mbar.commit
3752if {!$single_commit} {
3753        .mbar add cascade -label Fetch -menu .mbar.fetch
3754        .mbar add cascade -label Pull -menu .mbar.pull
3755        .mbar add cascade -label Push -menu .mbar.push
3756}
3757. configure -menu .mbar
3758
3759# -- Repository Menu
3760#
3761menu .mbar.repository
3762.mbar.repository add command \
3763        -label {Visualize Current Branch} \
3764        -command {do_gitk {}} \
3765        -font font_ui
3766.mbar.repository add command \
3767        -label {Visualize All Branches} \
3768        -command {do_gitk {--all}} \
3769        -font font_ui
3770.mbar.repository add separator
3771
3772if {!$single_commit} {
3773        .mbar.repository add command -label {Database Statistics} \
3774                -command do_stats \
3775                -font font_ui
3776
3777        .mbar.repository add command -label {Compress Database} \
3778                -command do_gc \
3779                -font font_ui
3780
3781        .mbar.repository add command -label {Verify Database} \
3782                -command do_fsck_objects \
3783                -font font_ui
3784
3785        .mbar.repository add separator
3786
3787        if {[is_Windows]} {
3788                .mbar.repository add command \
3789                        -label {Create Desktop Icon} \
3790                        -command do_windows_shortcut \
3791                        -font font_ui
3792        } elseif {[is_MacOSX]} {
3793                .mbar.repository add command \
3794                        -label {Create Desktop Icon} \
3795                        -command do_macosx_app \
3796                        -font font_ui
3797        }
3798}
3799
3800.mbar.repository add command -label Quit \
3801        -command do_quit \
3802        -accelerator $M1T-Q \
3803        -font font_ui
3804
3805# -- Edit Menu
3806#
3807menu .mbar.edit
3808.mbar.edit add command -label Undo \
3809        -command {catch {[focus] edit undo}} \
3810        -accelerator $M1T-Z \
3811        -font font_ui
3812.mbar.edit add command -label Redo \
3813        -command {catch {[focus] edit redo}} \
3814        -accelerator $M1T-Y \
3815        -font font_ui
3816.mbar.edit add separator
3817.mbar.edit add command -label Cut \
3818        -command {catch {tk_textCut [focus]}} \
3819        -accelerator $M1T-X \
3820        -font font_ui
3821.mbar.edit add command -label Copy \
3822        -command {catch {tk_textCopy [focus]}} \
3823        -accelerator $M1T-C \
3824        -font font_ui
3825.mbar.edit add command -label Paste \
3826        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3827        -accelerator $M1T-V \
3828        -font font_ui
3829.mbar.edit add command -label Delete \
3830        -command {catch {[focus] delete sel.first sel.last}} \
3831        -accelerator Del \
3832        -font font_ui
3833.mbar.edit add separator
3834.mbar.edit add command -label {Select All} \
3835        -command {catch {[focus] tag add sel 0.0 end}} \
3836        -accelerator $M1T-A \
3837        -font font_ui
3838
3839# -- Branch Menu
3840#
3841if {!$single_commit} {
3842        menu .mbar.branch
3843
3844        .mbar.branch add command -label {Create...} \
3845                -command do_create_branch \
3846                -accelerator $M1T-N \
3847                -font font_ui
3848        lappend disable_on_lock [list .mbar.branch entryconf \
3849                [.mbar.branch index last] -state]
3850
3851        .mbar.branch add command -label {Delete...} \
3852                -command do_delete_branch \
3853                -font font_ui
3854        lappend disable_on_lock [list .mbar.branch entryconf \
3855                [.mbar.branch index last] -state]
3856}
3857
3858# -- Commit Menu
3859#
3860menu .mbar.commit
3861
3862.mbar.commit add radiobutton \
3863        -label {New Commit} \
3864        -command do_select_commit_type \
3865        -variable selected_commit_type \
3866        -value new \
3867        -font font_ui
3868lappend disable_on_lock \
3869        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3870
3871.mbar.commit add radiobutton \
3872        -label {Amend Last Commit} \
3873        -command do_select_commit_type \
3874        -variable selected_commit_type \
3875        -value amend \
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 Rescan \
3883        -command do_rescan \
3884        -accelerator F5 \
3885        -font font_ui
3886lappend disable_on_lock \
3887        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3888
3889.mbar.commit add command -label {Add To Commit} \
3890        -command do_add_selection \
3891        -font font_ui
3892lappend disable_on_lock \
3893        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3894
3895.mbar.commit add command -label {Add All To Commit} \
3896        -command do_add_all \
3897        -accelerator $M1T-I \
3898        -font font_ui
3899lappend disable_on_lock \
3900        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3901
3902.mbar.commit add command -label {Unstage From Commit} \
3903        -command do_unstage_selection \
3904        -font font_ui
3905lappend disable_on_lock \
3906        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3907
3908.mbar.commit add command -label {Revert Changes} \
3909        -command do_revert_selection \
3910        -font font_ui
3911lappend disable_on_lock \
3912        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3913
3914.mbar.commit add separator
3915
3916.mbar.commit add command -label {Sign Off} \
3917        -command do_signoff \
3918        -accelerator $M1T-S \
3919        -font font_ui
3920
3921.mbar.commit add command -label Commit \
3922        -command do_commit \
3923        -accelerator $M1T-Return \
3924        -font font_ui
3925lappend disable_on_lock \
3926        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3927
3928# -- Transport menus
3929#
3930if {!$single_commit} {
3931        menu .mbar.fetch
3932        menu .mbar.pull
3933        menu .mbar.push
3934}
3935
3936if {[is_MacOSX]} {
3937        # -- Apple Menu (Mac OS X only)
3938        #
3939        .mbar add cascade -label Apple -menu .mbar.apple
3940        menu .mbar.apple
3941
3942        .mbar.apple add command -label "About [appname]" \
3943                -command do_about \
3944                -font font_ui
3945        .mbar.apple add command -label "[appname] Options..." \
3946                -command do_options \
3947                -font font_ui
3948} else {
3949        # -- Edit Menu
3950        #
3951        .mbar.edit add separator
3952        .mbar.edit add command -label {Options...} \
3953                -command do_options \
3954                -font font_ui
3955
3956        # -- Tools Menu
3957        #
3958        if {[file exists /usr/local/miga/lib/gui-miga]
3959                && [file exists .pvcsrc]} {
3960        proc do_miga {} {
3961                global ui_status_value
3962                if {![lock_index update]} return
3963                set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3964                set miga_fd [open "|$cmd" r]
3965                fconfigure $miga_fd -blocking 0
3966                fileevent $miga_fd readable [list miga_done $miga_fd]
3967                set ui_status_value {Running miga...}
3968        }
3969        proc miga_done {fd} {
3970                read $fd 512
3971                if {[eof $fd]} {
3972                        close $fd
3973                        unlock_index
3974                        rescan [list set ui_status_value {Ready.}]
3975                }
3976        }
3977        .mbar add cascade -label Tools -menu .mbar.tools
3978        menu .mbar.tools
3979        .mbar.tools add command -label "Migrate" \
3980                -command do_miga \
3981                -font font_ui
3982        lappend disable_on_lock \
3983                [list .mbar.tools entryconf [.mbar.tools index last] -state]
3984        }
3985
3986        # -- Help Menu
3987        #
3988        .mbar add cascade -label Help -menu .mbar.help
3989        menu .mbar.help
3990
3991        .mbar.help add command -label "About [appname]" \
3992                -command do_about \
3993                -font font_ui
3994}
3995
3996
3997# -- Branch Control
3998#
3999frame .branch \
4000        -borderwidth 1 \
4001        -relief sunken
4002label .branch.l1 \
4003        -text {Current Branch:} \
4004        -anchor w \
4005        -justify left \
4006        -font font_ui
4007label .branch.cb \
4008        -textvariable current_branch \
4009        -anchor w \
4010        -justify left \
4011        -font font_ui
4012pack .branch.l1 -side left
4013pack .branch.cb -side left -fill x
4014pack .branch -side top -fill x
4015
4016# -- Main Window Layout
4017#
4018panedwindow .vpane -orient vertical
4019panedwindow .vpane.files -orient horizontal
4020.vpane add .vpane.files -sticky nsew -height 100 -width 200
4021pack .vpane -anchor n -side top -fill both -expand 1
4022
4023# -- Index File List
4024#
4025frame .vpane.files.index -height 100 -width 200
4026label .vpane.files.index.title -text {Changes To Be Committed} \
4027        -background green \
4028        -font font_ui
4029text $ui_index -background white -borderwidth 0 \
4030        -width 20 -height 10 \
4031        -wrap none \
4032        -font font_ui \
4033        -cursor $cursor_ptr \
4034        -xscrollcommand {.vpane.files.index.sx set} \
4035        -yscrollcommand {.vpane.files.index.sy set} \
4036        -state disabled
4037scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4038scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4039pack .vpane.files.index.title -side top -fill x
4040pack .vpane.files.index.sx -side bottom -fill x
4041pack .vpane.files.index.sy -side right -fill y
4042pack $ui_index -side left -fill both -expand 1
4043.vpane.files add .vpane.files.index -sticky nsew
4044
4045# -- Working Directory File List
4046#
4047frame .vpane.files.workdir -height 100 -width 200
4048label .vpane.files.workdir.title -text {Changed But Not Updated} \
4049        -background red \
4050        -font font_ui
4051text $ui_workdir -background white -borderwidth 0 \
4052        -width 20 -height 10 \
4053        -wrap none \
4054        -font font_ui \
4055        -cursor $cursor_ptr \
4056        -xscrollcommand {.vpane.files.workdir.sx set} \
4057        -yscrollcommand {.vpane.files.workdir.sy set} \
4058        -state disabled
4059scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4060scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4061pack .vpane.files.workdir.title -side top -fill x
4062pack .vpane.files.workdir.sx -side bottom -fill x
4063pack .vpane.files.workdir.sy -side right -fill y
4064pack $ui_workdir -side left -fill both -expand 1
4065.vpane.files add .vpane.files.workdir -sticky nsew
4066
4067foreach i [list $ui_index $ui_workdir] {
4068        $i tag conf in_diff -font font_uibold
4069        $i tag conf in_sel \
4070                -background [$i cget -foreground] \
4071                -foreground [$i cget -background]
4072}
4073unset i
4074
4075# -- Diff and Commit Area
4076#
4077frame .vpane.lower -height 300 -width 400
4078frame .vpane.lower.commarea
4079frame .vpane.lower.diff -relief sunken -borderwidth 1
4080pack .vpane.lower.commarea -side top -fill x
4081pack .vpane.lower.diff -side bottom -fill both -expand 1
4082.vpane add .vpane.lower -sticky nsew
4083
4084# -- Commit Area Buttons
4085#
4086frame .vpane.lower.commarea.buttons
4087label .vpane.lower.commarea.buttons.l -text {} \
4088        -anchor w \
4089        -justify left \
4090        -font font_ui
4091pack .vpane.lower.commarea.buttons.l -side top -fill x
4092pack .vpane.lower.commarea.buttons -side left -fill y
4093
4094button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4095        -command do_rescan \
4096        -font font_ui
4097pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4098lappend disable_on_lock \
4099        {.vpane.lower.commarea.buttons.rescan conf -state}
4100
4101button .vpane.lower.commarea.buttons.incall -text {Add All} \
4102        -command do_add_all \
4103        -font font_ui
4104pack .vpane.lower.commarea.buttons.incall -side top -fill x
4105lappend disable_on_lock \
4106        {.vpane.lower.commarea.buttons.incall conf -state}
4107
4108button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4109        -command do_signoff \
4110        -font font_ui
4111pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4112
4113button .vpane.lower.commarea.buttons.commit -text {Commit} \
4114        -command do_commit \
4115        -font font_ui
4116pack .vpane.lower.commarea.buttons.commit -side top -fill x
4117lappend disable_on_lock \
4118        {.vpane.lower.commarea.buttons.commit conf -state}
4119
4120# -- Commit Message Buffer
4121#
4122frame .vpane.lower.commarea.buffer
4123frame .vpane.lower.commarea.buffer.header
4124set ui_comm .vpane.lower.commarea.buffer.t
4125set ui_coml .vpane.lower.commarea.buffer.header.l
4126radiobutton .vpane.lower.commarea.buffer.header.new \
4127        -text {New Commit} \
4128        -command do_select_commit_type \
4129        -variable selected_commit_type \
4130        -value new \
4131        -font font_ui
4132lappend disable_on_lock \
4133        [list .vpane.lower.commarea.buffer.header.new conf -state]
4134radiobutton .vpane.lower.commarea.buffer.header.amend \
4135        -text {Amend Last Commit} \
4136        -command do_select_commit_type \
4137        -variable selected_commit_type \
4138        -value amend \
4139        -font font_ui
4140lappend disable_on_lock \
4141        [list .vpane.lower.commarea.buffer.header.amend conf -state]
4142label $ui_coml \
4143        -anchor w \
4144        -justify left \
4145        -font font_ui
4146proc trace_commit_type {varname args} {
4147        global ui_coml commit_type
4148        switch -glob -- $commit_type {
4149        initial       {set txt {Initial Commit Message:}}
4150        amend         {set txt {Amended Commit Message:}}
4151        amend-initial {set txt {Amended Initial Commit Message:}}
4152        amend-merge   {set txt {Amended Merge Commit Message:}}
4153        merge         {set txt {Merge Commit Message:}}
4154        *             {set txt {Commit Message:}}
4155        }
4156        $ui_coml conf -text $txt
4157}
4158trace add variable commit_type write trace_commit_type
4159pack $ui_coml -side left -fill x
4160pack .vpane.lower.commarea.buffer.header.amend -side right
4161pack .vpane.lower.commarea.buffer.header.new -side right
4162
4163text $ui_comm -background white -borderwidth 1 \
4164        -undo true \
4165        -maxundo 20 \
4166        -autoseparators true \
4167        -relief sunken \
4168        -width 75 -height 9 -wrap none \
4169        -font font_diff \
4170        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4171scrollbar .vpane.lower.commarea.buffer.sby \
4172        -command [list $ui_comm yview]
4173pack .vpane.lower.commarea.buffer.header -side top -fill x
4174pack .vpane.lower.commarea.buffer.sby -side right -fill y
4175pack $ui_comm -side left -fill y
4176pack .vpane.lower.commarea.buffer -side left -fill y
4177
4178# -- Commit Message Buffer Context Menu
4179#
4180set ctxm .vpane.lower.commarea.buffer.ctxm
4181menu $ctxm -tearoff 0
4182$ctxm add command \
4183        -label {Cut} \
4184        -font font_ui \
4185        -command {tk_textCut $ui_comm}
4186$ctxm add command \
4187        -label {Copy} \
4188        -font font_ui \
4189        -command {tk_textCopy $ui_comm}
4190$ctxm add command \
4191        -label {Paste} \
4192        -font font_ui \
4193        -command {tk_textPaste $ui_comm}
4194$ctxm add command \
4195        -label {Delete} \
4196        -font font_ui \
4197        -command {$ui_comm delete sel.first sel.last}
4198$ctxm add separator
4199$ctxm add command \
4200        -label {Select All} \
4201        -font font_ui \
4202        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4203$ctxm add command \
4204        -label {Copy All} \
4205        -font font_ui \
4206        -command {
4207                $ui_comm tag add sel 0.0 end
4208                tk_textCopy $ui_comm
4209                $ui_comm tag remove sel 0.0 end
4210        }
4211$ctxm add separator
4212$ctxm add command \
4213        -label {Sign Off} \
4214        -font font_ui \
4215        -command do_signoff
4216bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
4217
4218# -- Diff Header
4219#
4220set current_diff_path {}
4221set current_diff_side {}
4222set diff_actions [list]
4223proc trace_current_diff_path {varname args} {
4224        global current_diff_path diff_actions file_states
4225        if {$current_diff_path eq {}} {
4226                set s {}
4227                set f {}
4228                set p {}
4229                set o disabled
4230        } else {
4231                set p $current_diff_path
4232                set s [mapdesc [lindex $file_states($p) 0] $p]
4233                set f {File:}
4234                set p [escape_path $p]
4235                set o normal
4236        }
4237
4238        .vpane.lower.diff.header.status configure -text $s
4239        .vpane.lower.diff.header.file configure -text $f
4240        .vpane.lower.diff.header.path configure -text $p
4241        foreach w $diff_actions {
4242                uplevel #0 $w $o
4243        }
4244}
4245trace add variable current_diff_path write trace_current_diff_path
4246
4247frame .vpane.lower.diff.header -background orange
4248label .vpane.lower.diff.header.status \
4249        -background orange \
4250        -width $max_status_desc \
4251        -anchor w \
4252        -justify left \
4253        -font font_ui
4254label .vpane.lower.diff.header.file \
4255        -background orange \
4256        -anchor w \
4257        -justify left \
4258        -font font_ui
4259label .vpane.lower.diff.header.path \
4260        -background orange \
4261        -anchor w \
4262        -justify left \
4263        -font font_ui
4264pack .vpane.lower.diff.header.status -side left
4265pack .vpane.lower.diff.header.file -side left
4266pack .vpane.lower.diff.header.path -fill x
4267set ctxm .vpane.lower.diff.header.ctxm
4268menu $ctxm -tearoff 0
4269$ctxm add command \
4270        -label {Copy} \
4271        -font font_ui \
4272        -command {
4273                clipboard clear
4274                clipboard append \
4275                        -format STRING \
4276                        -type STRING \
4277                        -- $current_diff_path
4278        }
4279lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4280bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
4281
4282# -- Diff Body
4283#
4284frame .vpane.lower.diff.body
4285set ui_diff .vpane.lower.diff.body.t
4286text $ui_diff -background white -borderwidth 0 \
4287        -width 80 -height 15 -wrap none \
4288        -font font_diff \
4289        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4290        -yscrollcommand {.vpane.lower.diff.body.sby set} \
4291        -state disabled
4292scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4293        -command [list $ui_diff xview]
4294scrollbar .vpane.lower.diff.body.sby -orient vertical \
4295        -command [list $ui_diff yview]
4296pack .vpane.lower.diff.body.sbx -side bottom -fill x
4297pack .vpane.lower.diff.body.sby -side right -fill y
4298pack $ui_diff -side left -fill both -expand 1
4299pack .vpane.lower.diff.header -side top -fill x
4300pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4301
4302$ui_diff tag conf d_cr -elide true
4303$ui_diff tag conf d_@ -foreground blue -font font_diffbold
4304$ui_diff tag conf d_+ -foreground {#00a000}
4305$ui_diff tag conf d_- -foreground red
4306
4307$ui_diff tag conf d_++ -foreground {#00a000}
4308$ui_diff tag conf d_-- -foreground red
4309$ui_diff tag conf d_+s \
4310        -foreground {#00a000} \
4311        -background {#e2effa}
4312$ui_diff tag conf d_-s \
4313        -foreground red \
4314        -background {#e2effa}
4315$ui_diff tag conf d_s+ \
4316        -foreground {#00a000} \
4317        -background ivory1
4318$ui_diff tag conf d_s- \
4319        -foreground red \
4320        -background ivory1
4321
4322$ui_diff tag conf d<<<<<<< \
4323        -foreground orange \
4324        -font font_diffbold
4325$ui_diff tag conf d======= \
4326        -foreground orange \
4327        -font font_diffbold
4328$ui_diff tag conf d>>>>>>> \
4329        -foreground orange \
4330        -font font_diffbold
4331
4332$ui_diff tag raise sel
4333
4334# -- Diff Body Context Menu
4335#
4336set ctxm .vpane.lower.diff.body.ctxm
4337menu $ctxm -tearoff 0
4338$ctxm add command \
4339        -label {Refresh} \
4340        -font font_ui \
4341        -command reshow_diff
4342lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4343$ctxm add command \
4344        -label {Copy} \
4345        -font font_ui \
4346        -command {tk_textCopy $ui_diff}
4347lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4348$ctxm add command \
4349        -label {Select All} \
4350        -font font_ui \
4351        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4352lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4353$ctxm add command \
4354        -label {Copy All} \
4355        -font font_ui \
4356        -command {
4357                $ui_diff tag add sel 0.0 end
4358                tk_textCopy $ui_diff
4359                $ui_diff tag remove sel 0.0 end
4360        }
4361lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4362$ctxm add separator
4363$ctxm add command \
4364        -label {Apply/Reverse Hunk} \
4365        -font font_ui \
4366        -command {apply_hunk $cursorX $cursorY}
4367set ui_diff_applyhunk [$ctxm index last]
4368lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4369$ctxm add separator
4370$ctxm add command \
4371        -label {Decrease Font Size} \
4372        -font font_ui \
4373        -command {incr_font_size font_diff -1}
4374lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4375$ctxm add command \
4376        -label {Increase Font Size} \
4377        -font font_ui \
4378        -command {incr_font_size font_diff 1}
4379lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4380$ctxm add separator
4381$ctxm add command \
4382        -label {Show Less Context} \
4383        -font font_ui \
4384        -command {if {$repo_config(gui.diffcontext) >= 2} {
4385                incr repo_config(gui.diffcontext) -1
4386                reshow_diff
4387        }}
4388lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4389$ctxm add command \
4390        -label {Show More Context} \
4391        -font font_ui \
4392        -command {
4393                incr repo_config(gui.diffcontext)
4394                reshow_diff
4395        }
4396lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4397$ctxm add separator
4398$ctxm add command -label {Options...} \
4399        -font font_ui \
4400        -command do_options
4401bind_button3 $ui_diff "
4402        set cursorX %x
4403        set cursorY %y
4404        if {\$ui_index eq \$current_diff_side} {
4405                $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
4406        } else {
4407                $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
4408        }
4409        tk_popup $ctxm %X %Y
4410"
4411unset ui_diff_applyhunk
4412
4413# -- Status Bar
4414#
4415set ui_status_value {Initializing...}
4416label .status -textvariable ui_status_value \
4417        -anchor w \
4418        -justify left \
4419        -borderwidth 1 \
4420        -relief sunken \
4421        -font font_ui
4422pack .status -anchor w -side bottom -fill x
4423
4424# -- Load geometry
4425#
4426catch {
4427set gm $repo_config(gui.geometry)
4428wm geometry . [lindex $gm 0]
4429.vpane sash place 0 \
4430        [lindex [.vpane sash coord 0] 0] \
4431        [lindex $gm 1]
4432.vpane.files sash place 0 \
4433        [lindex $gm 2] \
4434        [lindex [.vpane.files sash coord 0] 1]
4435unset gm
4436}
4437
4438# -- Key Bindings
4439#
4440bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4441bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4442bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4443bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4444bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4445bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4446bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4447bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4448bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4449bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4450bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4451
4452bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4453bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4454bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4455bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4456bind $ui_diff <$M1B-Key-v> {break}
4457bind $ui_diff <$M1B-Key-V> {break}
4458bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4459bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4460bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
4461bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
4462bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
4463bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
4464bind $ui_diff <Button-1>   {focus %W}
4465
4466if {!$single_commit} {
4467        bind . <$M1B-Key-n> do_create_branch
4468        bind . <$M1B-Key-N> do_create_branch
4469}
4470
4471bind .   <Destroy> do_quit
4472bind all <Key-F5> do_rescan
4473bind all <$M1B-Key-r> do_rescan
4474bind all <$M1B-Key-R> do_rescan
4475bind .   <$M1B-Key-s> do_signoff
4476bind .   <$M1B-Key-S> do_signoff
4477bind .   <$M1B-Key-i> do_add_all
4478bind .   <$M1B-Key-I> do_add_all
4479bind .   <$M1B-Key-Return> do_commit
4480bind all <$M1B-Key-q> do_quit
4481bind all <$M1B-Key-Q> do_quit
4482bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4483bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4484foreach i [list $ui_index $ui_workdir] {
4485        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
4486        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
4487        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4488}
4489unset i
4490
4491set file_lists($ui_index) [list]
4492set file_lists($ui_workdir) [list]
4493
4494set HEAD {}
4495set PARENT {}
4496set MERGE_HEAD [list]
4497set commit_type {}
4498set empty_tree {}
4499set current_branch {}
4500set current_diff_path {}
4501set selected_commit_type new
4502
4503wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
4504focus -force $ui_comm
4505
4506# -- Warn the user about environmental problems.  Cygwin's Tcl
4507#    does *not* pass its env array onto any processes it spawns.
4508#    This means that git processes get none of our environment.
4509#
4510if {[is_Windows]} {
4511        set ignored_env 0
4512        set suggest_user {}
4513        set msg "Possible environment issues exist.
4514
4515The following environment variables are probably
4516going to be ignored by any Git subprocess run
4517by [appname]:
4518
4519"
4520        foreach name [array names env] {
4521                switch -regexp -- $name {
4522                {^GIT_INDEX_FILE$} -
4523                {^GIT_OBJECT_DIRECTORY$} -
4524                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4525                {^GIT_DIFF_OPTS$} -
4526                {^GIT_EXTERNAL_DIFF$} -
4527                {^GIT_PAGER$} -
4528                {^GIT_TRACE$} -
4529                {^GIT_CONFIG$} -
4530                {^GIT_CONFIG_LOCAL$} -
4531                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4532                        append msg " - $name\n"
4533                        incr ignored_env
4534                }
4535                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4536                        append msg " - $name\n"
4537                        incr ignored_env
4538                        set suggest_user $name
4539                }
4540                }
4541        }
4542        if {$ignored_env > 0} {
4543                append msg "
4544This is due to a known issue with the
4545Tcl binary distributed by Cygwin."
4546
4547                if {$suggest_user ne {}} {
4548                        append msg "
4549
4550A good replacement for $suggest_user
4551is placing values for the user.name and
4552user.email settings into your personal
4553~/.gitconfig file.
4554"
4555                }
4556                warn_popup $msg
4557        }
4558        unset ignored_env msg suggest_user name
4559}
4560
4561# -- Only initialize complex UI if we are going to stay running.
4562#
4563if {!$single_commit} {
4564        load_all_remotes
4565        load_all_heads
4566
4567        populate_branch_menu
4568        populate_fetch_menu .mbar.fetch
4569        populate_pull_menu .mbar.pull
4570        populate_push_menu .mbar.push
4571}
4572
4573# -- Only suggest a gc run if we are going to stay running.
4574#
4575if {!$single_commit} {
4576        set object_limit 2000
4577        if {[is_Windows]} {set object_limit 200}
4578        regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4579        if {$objects_current >= $object_limit} {
4580                if {[ask_popup \
4581                        "This repository currently has $objects_current loose objects.
4582
4583To maintain optimal performance it is strongly
4584recommended that you compress the database
4585when more than $object_limit loose objects exist.
4586
4587Compress the database now?"] eq yes} {
4588                        do_gc
4589                }
4590        }
4591        unset object_limit _junk objects_current
4592}
4593
4594lock_index begin-read
4595after 1 do_rescan