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