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