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