Andrew's git / gitweb.git / git-gui
?
git-guion commit git-gui: Allow the user to disable diff stat summary during pull. (ebf336b)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright (C) 2006 Shawn Pearce, Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10set appname [lindex [file split $argv0] end]
  11set gitdir {}
  12
  13######################################################################
  14##
  15## config
  16
  17proc is_many_config {name} {
  18        switch -glob -- $name {
  19        remote.*.fetch -
  20        remote.*.push
  21                {return 1}
  22        *
  23                {return 0}
  24        }
  25}
  26
  27proc load_config {include_global} {
  28        global repo_config global_config default_config
  29
  30        array unset global_config
  31        if {$include_global} {
  32                catch {
  33                        set fd_rc [open "| git repo-config --global --list" r]
  34                        while {[gets $fd_rc line] >= 0} {
  35                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  36                                        if {[is_many_config $name]} {
  37                                                lappend global_config($name) $value
  38                                        } else {
  39                                                set global_config($name) $value
  40                                        }
  41                                }
  42                        }
  43                        close $fd_rc
  44                }
  45        }
  46
  47        array unset repo_config
  48        catch {
  49                set fd_rc [open "| git repo-config --list" r]
  50                while {[gets $fd_rc line] >= 0} {
  51                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  52                                if {[is_many_config $name]} {
  53                                        lappend repo_config($name) $value
  54                                } else {
  55                                        set repo_config($name) $value
  56                                }
  57                        }
  58                }
  59                close $fd_rc
  60        }
  61
  62        foreach name [array names default_config] {
  63                if {[catch {set v $global_config($name)}]} {
  64                        set global_config($name) $default_config($name)
  65                }
  66                if {[catch {set v $repo_config($name)}]} {
  67                        set repo_config($name) $default_config($name)
  68                }
  69        }
  70}
  71
  72proc save_config {} {
  73        global default_config font_descs
  74        global repo_config global_config
  75        global repo_config_new global_config_new
  76
  77        foreach option $font_descs {
  78                set name [lindex $option 0]
  79                set font [lindex $option 1]
  80                font configure $font \
  81                        -family $global_config_new(gui.$font^^family) \
  82                        -size $global_config_new(gui.$font^^size)
  83                font configure ${font}bold \
  84                        -family $global_config_new(gui.$font^^family) \
  85                        -size $global_config_new(gui.$font^^size)
  86                set global_config_new(gui.$name) [font configure $font]
  87                unset global_config_new(gui.$font^^family)
  88                unset global_config_new(gui.$font^^size)
  89        }
  90
  91        foreach name [array names default_config] {
  92                set value $global_config_new($name)
  93                if {$value != $global_config($name)} {
  94                        if {$value == $default_config($name)} {
  95                                catch {exec git repo-config --global --unset $name}
  96                        } else {
  97                                regsub -all "\[{}\]" $value {"} value
  98                                exec git repo-config --global $name $value
  99                        }
 100                        set global_config($name) $value
 101                        if {$value == $repo_config($name)} {
 102                                catch {exec git repo-config --unset $name}
 103                                set repo_config($name) $value
 104                        }
 105                }
 106        }
 107
 108        foreach name [array names default_config] {
 109                set value $repo_config_new($name)
 110                if {$value != $repo_config($name)} {
 111                        if {$value == $global_config($name)} {
 112                                catch {exec git repo-config --unset $name}
 113                        } else {
 114                                regsub -all "\[{}\]" $value {"} value
 115                                exec git repo-config $name $value
 116                        }
 117                        set repo_config($name) $value
 118                }
 119        }
 120}
 121
 122proc error_popup {msg} {
 123        global gitdir appname
 124
 125        set title $appname
 126        if {$gitdir != {}} {
 127                append title { (}
 128                append title [lindex \
 129                        [file split [file normalize [file dirname $gitdir]]] \
 130                        end]
 131                append title {)}
 132        }
 133        tk_messageBox \
 134                -parent . \
 135                -icon error \
 136                -type ok \
 137                -title "$title: error" \
 138                -message $msg
 139}
 140
 141proc info_popup {msg} {
 142        global gitdir appname
 143
 144        set title $appname
 145        if {$gitdir != {}} {
 146                append title { (}
 147                append title [lindex \
 148                        [file split [file normalize [file dirname $gitdir]]] \
 149                        end]
 150                append title {)}
 151        }
 152        tk_messageBox \
 153                -parent . \
 154                -icon error \
 155                -type ok \
 156                -title $title \
 157                -message $msg
 158}
 159
 160######################################################################
 161##
 162## repository setup
 163
 164if {   [catch {set cdup [exec git rev-parse --show-cdup]} err]
 165        || [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
 166        catch {wm withdraw .}
 167        error_popup "Cannot find the git directory:\n\n$err"
 168        exit 1
 169}
 170if {$cdup != ""} {
 171        cd $cdup
 172}
 173unset cdup
 174
 175set single_commit 0
 176if {$appname == {git-citool}} {
 177        set single_commit 1
 178}
 179
 180######################################################################
 181##
 182## task management
 183
 184set status_active 0
 185set diff_active 0
 186set commit_active 0
 187
 188set disable_on_lock [list]
 189set index_lock_type none
 190
 191set HEAD {}
 192set PARENT {}
 193set commit_type {}
 194
 195proc lock_index {type} {
 196        global index_lock_type disable_on_lock
 197
 198        if {$index_lock_type == {none}} {
 199                set index_lock_type $type
 200                foreach w $disable_on_lock {
 201                        uplevel #0 $w disabled
 202                }
 203                return 1
 204        } elseif {$index_lock_type == {begin-update} && $type == {update}} {
 205                set index_lock_type $type
 206                return 1
 207        }
 208        return 0
 209}
 210
 211proc unlock_index {} {
 212        global index_lock_type disable_on_lock
 213
 214        set index_lock_type none
 215        foreach w $disable_on_lock {
 216                uplevel #0 $w normal
 217        }
 218}
 219
 220######################################################################
 221##
 222## status
 223
 224proc repository_state {hdvar ctvar} {
 225        global gitdir
 226        upvar $hdvar hd $ctvar ct
 227
 228        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 229                set ct initial
 230        } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
 231                set ct merge
 232        } else {
 233                set ct normal
 234        }
 235}
 236
 237proc update_status {{final Ready.}} {
 238        global HEAD PARENT commit_type
 239        global ui_index ui_other ui_status_value ui_comm
 240        global status_active file_states
 241        global repo_config
 242
 243        if {$status_active || ![lock_index read]} return
 244
 245        repository_state new_HEAD new_type
 246        if {$commit_type == {amend} 
 247                && $new_type == {normal}
 248                && $new_HEAD == $HEAD} {
 249        } else {
 250                set HEAD $new_HEAD
 251                set PARENT $new_HEAD
 252                set commit_type $new_type
 253        }
 254
 255        array unset file_states
 256
 257        if {![$ui_comm edit modified]
 258                || [string trim [$ui_comm get 0.0 end]] == {}} {
 259                if {[load_message GITGUI_MSG]} {
 260                } elseif {[load_message MERGE_MSG]} {
 261                } elseif {[load_message SQUASH_MSG]} {
 262                }
 263                $ui_comm edit modified false
 264                $ui_comm edit reset
 265        }
 266
 267        if {$repo_config(gui.trustmtime) == {true}} {
 268                update_status_stage2 {} $final
 269        } else {
 270                set status_active 1
 271                set ui_status_value {Refreshing file status...}
 272                set cmd [list git update-index]
 273                lappend cmd -q
 274                lappend cmd --unmerged
 275                lappend cmd --ignore-missing
 276                lappend cmd --refresh
 277                set fd_rf [open "| $cmd" r]
 278                fconfigure $fd_rf -blocking 0 -translation binary
 279                fileevent $fd_rf readable \
 280                        [list update_status_stage2 $fd_rf $final]
 281        }
 282}
 283
 284proc update_status_stage2 {fd final} {
 285        global gitdir PARENT commit_type
 286        global ui_index ui_other ui_status_value ui_comm
 287        global status_active
 288        global buf_rdi buf_rdf buf_rlo
 289
 290        if {$fd != {}} {
 291                read $fd
 292                if {![eof $fd]} return
 293                close $fd
 294        }
 295
 296        set ls_others [list | git ls-files --others -z \
 297                --exclude-per-directory=.gitignore]
 298        set info_exclude [file join $gitdir info exclude]
 299        if {[file readable $info_exclude]} {
 300                lappend ls_others "--exclude-from=$info_exclude"
 301        }
 302
 303        set buf_rdi {}
 304        set buf_rdf {}
 305        set buf_rlo {}
 306
 307        set status_active 3
 308        set ui_status_value {Scanning for modified files ...}
 309        set fd_di [open "| git diff-index --cached -z $PARENT" r]
 310        set fd_df [open "| git diff-files -z" r]
 311        set fd_lo [open $ls_others r]
 312
 313        fconfigure $fd_di -blocking 0 -translation binary
 314        fconfigure $fd_df -blocking 0 -translation binary
 315        fconfigure $fd_lo -blocking 0 -translation binary
 316        fileevent $fd_di readable [list read_diff_index $fd_di $final]
 317        fileevent $fd_df readable [list read_diff_files $fd_df $final]
 318        fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
 319}
 320
 321proc load_message {file} {
 322        global gitdir ui_comm
 323
 324        set f [file join $gitdir $file]
 325        if {[file isfile $f]} {
 326                if {[catch {set fd [open $f r]}]} {
 327                        return 0
 328                }
 329                set content [string trim [read $fd]]
 330                close $fd
 331                $ui_comm delete 0.0 end
 332                $ui_comm insert end $content
 333                return 1
 334        }
 335        return 0
 336}
 337
 338proc read_diff_index {fd final} {
 339        global buf_rdi
 340
 341        append buf_rdi [read $fd]
 342        set c 0
 343        set n [string length $buf_rdi]
 344        while {$c < $n} {
 345                set z1 [string first "\0" $buf_rdi $c]
 346                if {$z1 == -1} break
 347                incr z1
 348                set z2 [string first "\0" $buf_rdi $z1]
 349                if {$z2 == -1} break
 350
 351                set c $z2
 352                incr z2 -1
 353                display_file \
 354                        [string range $buf_rdi $z1 $z2] \
 355                        [string index $buf_rdi [expr $z1 - 2]]_
 356                incr c
 357        }
 358        if {$c < $n} {
 359                set buf_rdi [string range $buf_rdi $c end]
 360        } else {
 361                set buf_rdi {}
 362        }
 363
 364        status_eof $fd buf_rdi $final
 365}
 366
 367proc read_diff_files {fd final} {
 368        global buf_rdf
 369
 370        append buf_rdf [read $fd]
 371        set c 0
 372        set n [string length $buf_rdf]
 373        while {$c < $n} {
 374                set z1 [string first "\0" $buf_rdf $c]
 375                if {$z1 == -1} break
 376                incr z1
 377                set z2 [string first "\0" $buf_rdf $z1]
 378                if {$z2 == -1} break
 379
 380                set c $z2
 381                incr z2 -1
 382                display_file \
 383                        [string range $buf_rdf $z1 $z2] \
 384                        _[string index $buf_rdf [expr $z1 - 2]]
 385                incr c
 386        }
 387        if {$c < $n} {
 388                set buf_rdf [string range $buf_rdf $c end]
 389        } else {
 390                set buf_rdf {}
 391        }
 392
 393        status_eof $fd buf_rdf $final
 394}
 395
 396proc read_ls_others {fd final} {
 397        global buf_rlo
 398
 399        append buf_rlo [read $fd]
 400        set pck [split $buf_rlo "\0"]
 401        set buf_rlo [lindex $pck end]
 402        foreach p [lrange $pck 0 end-1] {
 403                display_file $p _O
 404        }
 405        status_eof $fd buf_rlo $final
 406}
 407
 408proc status_eof {fd buf final} {
 409        global status_active ui_status_value
 410        upvar $buf to_clear
 411
 412        if {[eof $fd]} {
 413                set to_clear {}
 414                close $fd
 415
 416                if {[incr status_active -1] == 0} {
 417                        display_all_files
 418                        unlock_index
 419                        reshow_diff
 420                        set ui_status_value $final
 421                }
 422        }
 423}
 424
 425######################################################################
 426##
 427## diff
 428
 429proc clear_diff {} {
 430        global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
 431
 432        $ui_diff conf -state normal
 433        $ui_diff delete 0.0 end
 434        $ui_diff conf -state disabled
 435
 436        set ui_fname_value {}
 437        set ui_fstatus_value {}
 438
 439        $ui_index tag remove in_diff 0.0 end
 440        $ui_other tag remove in_diff 0.0 end
 441}
 442
 443proc reshow_diff {} {
 444        global ui_fname_value ui_status_value file_states
 445
 446        if {$ui_fname_value == {}
 447                || [catch {set s $file_states($ui_fname_value)}]} {
 448                clear_diff
 449        } else {
 450                show_diff $ui_fname_value
 451        }
 452}
 453
 454proc handle_empty_diff {} {
 455        global ui_fname_value file_states file_lists
 456
 457        set path $ui_fname_value
 458        set s $file_states($path)
 459        if {[lindex $s 0] != {_M}} return
 460
 461        info_popup "No differences detected.
 462
 463[short_path $path] has no changes.
 464
 465The modification date of this file was updated by another
 466application and you currently have the Trust File Modification
 467Timestamps option enabled, so Git did not automatically detect
 468that there are no content differences in this file.
 469
 470This file will now be removed from the modified files list, to
 471prevent possible confusion.
 472"
 473        if {[catch {exec git update-index -- $path} err]} {
 474                error_popup "Failed to refresh index:\n\n$err"
 475        }
 476
 477        clear_diff
 478        set old_w [mapcol [lindex $file_states($path) 0] $path]
 479        set lno [lsearch -sorted $file_lists($old_w) $path]
 480        if {$lno >= 0} {
 481                set file_lists($old_w) \
 482                        [lreplace $file_lists($old_w) $lno $lno]
 483                incr lno
 484                $old_w conf -state normal
 485                $old_w delete $lno.0 [expr $lno + 1].0
 486                $old_w conf -state disabled
 487        }
 488}
 489
 490proc show_diff {path {w {}} {lno {}}} {
 491        global file_states file_lists
 492        global PARENT diff_3way diff_active
 493        global ui_diff ui_fname_value ui_fstatus_value ui_status_value
 494
 495        if {$diff_active || ![lock_index read]} return
 496
 497        clear_diff
 498        if {$w == {} || $lno == {}} {
 499                foreach w [array names file_lists] {
 500                        set lno [lsearch -sorted $file_lists($w) $path]
 501                        if {$lno >= 0} {
 502                                incr lno
 503                                break
 504                        }
 505                }
 506        }
 507        if {$w != {} && $lno >= 1} {
 508                $w tag add in_diff $lno.0 [expr $lno + 1].0
 509        }
 510
 511        set s $file_states($path)
 512        set m [lindex $s 0]
 513        set diff_3way 0
 514        set diff_active 1
 515        set ui_fname_value [escape_path $path]
 516        set ui_fstatus_value [mapdesc $m $path]
 517        set ui_status_value "Loading diff of [escape_path $path]..."
 518
 519        set cmd [list | git diff-index -p $PARENT -- $path]
 520        switch $m {
 521        MM {
 522                set cmd [list | git diff-index -p -c $PARENT $path]
 523        }
 524        _O {
 525                if {[catch {
 526                                set fd [open $path r]
 527                                set content [read $fd]
 528                                close $fd
 529                        } err ]} {
 530                        set diff_active 0
 531                        unlock_index
 532                        set ui_status_value "Unable to display [escape_path $path]"
 533                        error_popup "Error loading file:\n\n$err"
 534                        return
 535                }
 536                $ui_diff conf -state normal
 537                $ui_diff insert end $content
 538                $ui_diff conf -state disabled
 539                set diff_active 0
 540                unlock_index
 541                set ui_status_value {Ready.}
 542                return
 543        }
 544        }
 545
 546        if {[catch {set fd [open $cmd r]} err]} {
 547                set diff_active 0
 548                unlock_index
 549                set ui_status_value "Unable to display [escape_path $path]"
 550                error_popup "Error loading diff:\n\n$err"
 551                return
 552        }
 553
 554        fconfigure $fd -blocking 0 -translation auto
 555        fileevent $fd readable [list read_diff $fd]
 556}
 557
 558proc read_diff {fd} {
 559        global ui_diff ui_status_value diff_3way diff_active
 560        global repo_config
 561
 562        while {[gets $fd line] >= 0} {
 563                if {[string match {diff --git *} $line]} continue
 564                if {[string match {diff --combined *} $line]} continue
 565                if {[string match {--- *} $line]} continue
 566                if {[string match {+++ *} $line]} continue
 567                if {[string match index* $line]} {
 568                        if {[string first , $line] >= 0} {
 569                                set diff_3way 1
 570                        }
 571                }
 572
 573                $ui_diff conf -state normal
 574                if {!$diff_3way} {
 575                        set x [string index $line 0]
 576                        switch -- $x {
 577                        "@" {set tags da}
 578                        "+" {set tags dp}
 579                        "-" {set tags dm}
 580                        default {set tags {}}
 581                        }
 582                } else {
 583                        set x [string range $line 0 1]
 584                        switch -- $x {
 585                        default {set tags {}}
 586                        "@@" {set tags da}
 587                        "++" {set tags dp; set x " +"}
 588                        " +" {set tags {di bold}; set x "++"}
 589                        "+ " {set tags dni; set x "-+"}
 590                        "--" {set tags dm; set x " -"}
 591                        " -" {set tags {dm bold}; set x "--"}
 592                        "- " {set tags di; set x "+-"}
 593                        default {set tags {}}
 594                        }
 595                        set line [string replace $line 0 1 $x]
 596                }
 597                $ui_diff insert end $line $tags
 598                $ui_diff insert end "\n"
 599                $ui_diff conf -state disabled
 600        }
 601
 602        if {[eof $fd]} {
 603                close $fd
 604                set diff_active 0
 605                unlock_index
 606                set ui_status_value {Ready.}
 607
 608                if {$repo_config(gui.trustmtime) == {true}
 609                        && [$ui_diff index end] == {2.0}} {
 610                        handle_empty_diff
 611                }
 612        }
 613}
 614
 615######################################################################
 616##
 617## commit
 618
 619proc load_last_commit {} {
 620        global HEAD PARENT commit_type ui_comm
 621
 622        if {$commit_type == {amend}} return
 623        if {$commit_type != {normal}} {
 624                error_popup "Can't amend a $commit_type commit."
 625                return
 626        }
 627
 628        set msg {}
 629        set parent {}
 630        set parent_count 0
 631        if {[catch {
 632                        set fd [open "| git cat-file commit $HEAD" r]
 633                        while {[gets $fd line] > 0} {
 634                                if {[string match {parent *} $line]} {
 635                                        set parent [string range $line 7 end]
 636                                        incr parent_count
 637                                }
 638                        }
 639                        set msg [string trim [read $fd]]
 640                        close $fd
 641                } err]} {
 642                error_popup "Error loading commit data for amend:\n\n$err"
 643                return
 644        }
 645
 646        if {$parent_count == 0} {
 647                set commit_type amend
 648                set HEAD {}
 649                set PARENT {}
 650                update_status
 651        } elseif {$parent_count == 1} {
 652                set commit_type amend
 653                set PARENT $parent
 654                $ui_comm delete 0.0 end
 655                $ui_comm insert end $msg
 656                $ui_comm edit modified false
 657                $ui_comm edit reset
 658                update_status
 659        } else {
 660                error_popup {You can't amend a merge commit.}
 661                return
 662        }
 663}
 664
 665proc commit_tree {} {
 666        global tcl_platform HEAD gitdir commit_type file_states
 667        global commit_active ui_status_value
 668        global ui_comm
 669
 670        if {$commit_active || ![lock_index update]} return
 671
 672        # -- Our in memory state should match the repository.
 673        #
 674        repository_state curHEAD cur_type
 675        if {$commit_type == {amend} 
 676                && $cur_type == {normal}
 677                && $curHEAD == $HEAD} {
 678        } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
 679                error_popup {Last scanned state does not match repository state.
 680
 681Its highly likely that another Git program modified the
 682repository since our last scan.  A rescan is required
 683before committing.
 684}
 685                unlock_index
 686                update_status
 687                return
 688        }
 689
 690        # -- At least one file should differ in the index.
 691        #
 692        set files_ready 0
 693        foreach path [array names file_states] {
 694                set s $file_states($path)
 695                switch -glob -- [lindex $s 0] {
 696                _? {continue}
 697                A? -
 698                D? -
 699                M? {set files_ready 1; break}
 700                U? {
 701                        error_popup "Unmerged files cannot be committed.
 702
 703File [short_path $path] has merge conflicts.
 704You must resolve them and include the file before committing.
 705"
 706                        unlock_index
 707                        return
 708                }
 709                default {
 710                        error_popup "Unknown file state [lindex $s 0] detected.
 711
 712File [short_path $path] cannot be committed by this program.
 713"
 714                }
 715                }
 716        }
 717        if {!$files_ready} {
 718                error_popup {No included files to commit.
 719
 720You must include at least 1 file before you can commit.
 721}
 722                unlock_index
 723                return
 724        }
 725
 726        # -- A message is required.
 727        #
 728        set msg [string trim [$ui_comm get 1.0 end]]
 729        if {$msg == {}} {
 730                error_popup {Please supply a commit message.
 731
 732A good commit message has the following format:
 733
 734- First line: Describe in one sentance what you did.
 735- Second line: Blank
 736- Remaining lines: Describe why this change is good.
 737}
 738                unlock_index
 739                return
 740        }
 741
 742        # -- Ask the pre-commit hook for the go-ahead.
 743        #
 744        set pchook [file join $gitdir hooks pre-commit]
 745        if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
 746                set pchook [list sh -c \
 747                        "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
 748        } elseif {[file executable $pchook]} {
 749                set pchook [list $pchook]
 750        } else {
 751                set pchook {}
 752        }
 753        if {$pchook != {} && [catch {eval exec $pchook} err]} {
 754                hook_failed_popup pre-commit $err
 755                unlock_index
 756                return
 757        }
 758
 759        # -- Write the tree in the background.
 760        #
 761        set commit_active 1
 762        set ui_status_value {Committing changes...}
 763
 764        set fd_wt [open "| git write-tree" r]
 765        fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
 766}
 767
 768proc commit_stage2 {fd_wt curHEAD msg} {
 769        global single_commit gitdir HEAD PARENT commit_type
 770        global commit_active ui_status_value ui_comm
 771        global file_states
 772
 773        gets $fd_wt tree_id
 774        if {$tree_id == {} || [catch {close $fd_wt} err]} {
 775                error_popup "write-tree failed:\n\n$err"
 776                set commit_active 0
 777                set ui_status_value {Commit failed.}
 778                unlock_index
 779                return
 780        }
 781
 782        # -- Create the commit.
 783        #
 784        set cmd [list git commit-tree $tree_id]
 785        if {$PARENT != {}} {
 786                lappend cmd -p $PARENT
 787        }
 788        if {$commit_type == {merge}} {
 789                if {[catch {
 790                                set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 791                                while {[gets $fd_mh merge_head] >= 0} {
 792                                        lappend cmd -p $merge_head
 793                                }
 794                                close $fd_mh
 795                        } err]} {
 796                        error_popup "Loading MERGE_HEAD failed:\n\n$err"
 797                        set commit_active 0
 798                        set ui_status_value {Commit failed.}
 799                        unlock_index
 800                        return
 801                }
 802        }
 803        if {$PARENT == {}} {
 804                # git commit-tree writes to stderr during initial commit.
 805                lappend cmd 2>/dev/null
 806        }
 807        lappend cmd << $msg
 808        if {[catch {set cmt_id [eval exec $cmd]} err]} {
 809                error_popup "commit-tree failed:\n\n$err"
 810                set commit_active 0
 811                set ui_status_value {Commit failed.}
 812                unlock_index
 813                return
 814        }
 815
 816        # -- Update the HEAD ref.
 817        #
 818        set reflogm commit
 819        if {$commit_type != {normal}} {
 820                append reflogm " ($commit_type)"
 821        }
 822        set i [string first "\n" $msg]
 823        if {$i >= 0} {
 824                append reflogm {: } [string range $msg 0 [expr $i - 1]]
 825        } else {
 826                append reflogm {: } $msg
 827        }
 828        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 829        if {[catch {eval exec $cmd} err]} {
 830                error_popup "update-ref failed:\n\n$err"
 831                set commit_active 0
 832                set ui_status_value {Commit failed.}
 833                unlock_index
 834                return
 835        }
 836
 837        # -- Cleanup after ourselves.
 838        #
 839        catch {file delete [file join $gitdir MERGE_HEAD]}
 840        catch {file delete [file join $gitdir MERGE_MSG]}
 841        catch {file delete [file join $gitdir SQUASH_MSG]}
 842        catch {file delete [file join $gitdir GITGUI_MSG]}
 843
 844        # -- Let rerere do its thing.
 845        #
 846        if {[file isdirectory [file join $gitdir rr-cache]]} {
 847                catch {exec git rerere}
 848        }
 849
 850        $ui_comm delete 0.0 end
 851        $ui_comm edit modified false
 852        $ui_comm edit reset
 853
 854        if {$single_commit} do_quit
 855
 856        # -- Update status without invoking any git commands.
 857        #
 858        set commit_active 0
 859        set commit_type normal
 860        set HEAD $cmt_id
 861        set PARENT $cmt_id
 862
 863        foreach path [array names file_states] {
 864                set s $file_states($path)
 865                set m [lindex $s 0]
 866                switch -glob -- $m {
 867                A? -
 868                M? -
 869                D? {set m _[string index $m 1]}
 870                }
 871
 872                if {$m == {__}} {
 873                        unset file_states($path)
 874                } else {
 875                        lset file_states($path) 0 $m
 876                }
 877        }
 878
 879        display_all_files
 880        unlock_index
 881        reshow_diff
 882        set ui_status_value \
 883                "Changes committed as [string range $cmt_id 0 7]."
 884}
 885
 886######################################################################
 887##
 888## fetch pull push
 889
 890proc fetch_from {remote} {
 891        set w [new_console "fetch $remote" \
 892                "Fetching new changes from $remote"]
 893        set cmd [list git fetch]
 894        lappend cmd $remote
 895        console_exec $w $cmd
 896}
 897
 898proc pull_remote {remote branch} {
 899        global HEAD commit_type file_states repo_config
 900
 901        if {![lock_index update]} return
 902
 903        # -- Our in memory state should match the repository.
 904        #
 905        repository_state curHEAD cur_type
 906        if {$commit_type != $cur_type || $HEAD != $curHEAD} {
 907                error_popup {Last scanned state does not match repository state.
 908
 909Its highly likely that another Git program modified the
 910repository since our last scan.  A rescan is required
 911before a pull can be started.
 912}
 913                unlock_index
 914                update_status
 915                return
 916        }
 917
 918        # -- No differences should exist before a pull.
 919        #
 920        if {[array size file_states] != 0} {
 921                error_popup {Uncommitted but modified files are present.
 922
 923You should not perform a pull with unmodified files in your working
 924directory as Git would be unable to recover from an incorrect merge.
 925
 926Commit or throw away all changes before starting a pull operation.
 927}
 928                unlock_index
 929                return
 930        }
 931
 932        set w [new_console "pull $remote $branch" \
 933                "Pulling new changes from branch $branch in $remote"]
 934        set cmd [list git pull]
 935        if {$repo_config(gui.pullsummary) == {false}} {
 936                lappend cmd --no-summary
 937        }
 938        lappend cmd $remote
 939        lappend cmd $branch
 940        console_exec $w $cmd [list post_pull_remote $remote $branch]
 941}
 942
 943proc post_pull_remote {remote branch success} {
 944        global HEAD PARENT commit_type
 945        global ui_status_value
 946
 947        unlock_index
 948        if {$success} {
 949                repository_state HEAD commit_type
 950                set PARENT $HEAD
 951                set $ui_status_value {Ready.}
 952        } else {
 953                update_status \
 954                        "Conflicts detected while pulling $branch from $remote."
 955        }
 956}
 957
 958proc push_to {remote} {
 959        set w [new_console "push $remote" \
 960                "Pushing changes to $remote"]
 961        set cmd [list git push]
 962        lappend cmd $remote
 963        console_exec $w $cmd
 964}
 965
 966######################################################################
 967##
 968## ui helpers
 969
 970proc mapcol {state path} {
 971        global all_cols ui_other
 972
 973        if {[catch {set r $all_cols($state)}]} {
 974                puts "error: no column for state={$state} $path"
 975                return $ui_other
 976        }
 977        return $r
 978}
 979
 980proc mapicon {state path} {
 981        global all_icons
 982
 983        if {[catch {set r $all_icons($state)}]} {
 984                puts "error: no icon for state={$state} $path"
 985                return file_plain
 986        }
 987        return $r
 988}
 989
 990proc mapdesc {state path} {
 991        global all_descs
 992
 993        if {[catch {set r $all_descs($state)}]} {
 994                puts "error: no desc for state={$state} $path"
 995                return $state
 996        }
 997        return $r
 998}
 999
1000proc escape_path {path} {
1001        regsub -all "\n" $path "\\n" path
1002        return $path
1003}
1004
1005proc short_path {path} {
1006        return [escape_path [lindex [file split $path] end]]
1007}
1008
1009set next_icon_id 0
1010
1011proc merge_state {path new_state} {
1012        global file_states next_icon_id
1013
1014        set s0 [string index $new_state 0]
1015        set s1 [string index $new_state 1]
1016
1017        if {[catch {set info $file_states($path)}]} {
1018                set state __
1019                set icon n[incr next_icon_id]
1020        } else {
1021                set state [lindex $info 0]
1022                set icon [lindex $info 1]
1023        }
1024
1025        if {$s0 == {_}} {
1026                set s0 [string index $state 0]
1027        } elseif {$s0 == {*}} {
1028                set s0 _
1029        }
1030
1031        if {$s1 == {_}} {
1032                set s1 [string index $state 1]
1033        } elseif {$s1 == {*}} {
1034                set s1 _
1035        }
1036
1037        set file_states($path) [list $s0$s1 $icon]
1038        return $state
1039}
1040
1041proc display_file {path state} {
1042        global file_states file_lists status_active
1043
1044        set old_m [merge_state $path $state]
1045        if {$status_active} return
1046
1047        set s $file_states($path)
1048        set new_m [lindex $s 0]
1049        set new_w [mapcol $new_m $path] 
1050        set old_w [mapcol $old_m $path]
1051        set new_icon [mapicon $new_m $path]
1052
1053        if {$new_w != $old_w} {
1054                set lno [lsearch -sorted $file_lists($old_w) $path]
1055                if {$lno >= 0} {
1056                        incr lno
1057                        $old_w conf -state normal
1058                        $old_w delete $lno.0 [expr $lno + 1].0
1059                        $old_w conf -state disabled
1060                }
1061
1062                lappend file_lists($new_w) $path
1063                set file_lists($new_w) [lsort $file_lists($new_w)]
1064                set lno [lsearch -sorted $file_lists($new_w) $path]
1065                incr lno
1066                $new_w conf -state normal
1067                $new_w image create $lno.0 \
1068                        -align center -padx 5 -pady 1 \
1069                        -name [lindex $s 1] \
1070                        -image $new_icon
1071                $new_w insert $lno.1 "[escape_path $path]\n"
1072                $new_w conf -state disabled
1073        } elseif {$new_icon != [mapicon $old_m $path]} {
1074                $new_w conf -state normal
1075                $new_w image conf [lindex $s 1] -image $new_icon
1076                $new_w conf -state disabled
1077        }
1078}
1079
1080proc display_all_files {} {
1081        global ui_index ui_other file_states file_lists
1082
1083        $ui_index conf -state normal
1084        $ui_other conf -state normal
1085
1086        $ui_index delete 0.0 end
1087        $ui_other delete 0.0 end
1088
1089        set file_lists($ui_index) [list]
1090        set file_lists($ui_other) [list]
1091
1092        foreach path [lsort [array names file_states]] {
1093                set s $file_states($path)
1094                set m [lindex $s 0]
1095                set w [mapcol $m $path]
1096                lappend file_lists($w) $path
1097                $w image create end \
1098                        -align center -padx 5 -pady 1 \
1099                        -name [lindex $s 1] \
1100                        -image [mapicon $m $path]
1101                $w insert end "[escape_path $path]\n"
1102        }
1103
1104        $ui_index conf -state disabled
1105        $ui_other conf -state disabled
1106}
1107
1108proc update_index {pathList} {
1109        global update_index_cp ui_status_value
1110
1111        if {![lock_index update]} return
1112
1113        set update_index_cp 0
1114        set totalCnt [llength $pathList]
1115        set batch [expr {int($totalCnt * .01) + 1}]
1116        if {$batch > 25} {set batch 25}
1117
1118        set ui_status_value "Including files ... 0/$totalCnt 0%"
1119        set ui_status_value [format \
1120                "Including files ... %i/%i files (%.2f%%)" \
1121                $update_index_cp \
1122                $totalCnt \
1123                0.0]
1124        set fd [open "| git update-index --add --remove -z --stdin" w]
1125        fconfigure $fd -blocking 0 -translation binary
1126        fileevent $fd writable [list \
1127                write_update_index \
1128                $fd \
1129                $pathList \
1130                $totalCnt \
1131                $batch \
1132                ]
1133}
1134
1135proc write_update_index {fd pathList totalCnt batch} {
1136        global update_index_cp ui_status_value
1137        global file_states ui_fname_value
1138
1139        if {$update_index_cp >= $totalCnt} {
1140                close $fd
1141                unlock_index
1142                set ui_status_value {Ready.}
1143                return
1144        }
1145
1146        for {set i $batch} \
1147                {$update_index_cp < $totalCnt && $i > 0} \
1148                {incr i -1} {
1149                set path [lindex $pathList $update_index_cp]
1150                incr update_index_cp
1151
1152                switch -- [lindex $file_states($path) 0] {
1153                AM -
1154                _O {set new A*}
1155                _M -
1156                MM {set new M*}
1157                AD -
1158                _D {set new D*}
1159                default {continue}
1160                }
1161
1162                puts -nonewline $fd $path
1163                puts -nonewline $fd "\0"
1164                display_file $path $new
1165                if {$ui_fname_value == $path} {
1166                        show_diff $path
1167                }
1168        }
1169
1170        set ui_status_value [format \
1171                "Including files ... %i/%i files (%.2f%%)" \
1172                $update_index_cp \
1173                $totalCnt \
1174                [expr {100.0 * $update_index_cp / $totalCnt}]]
1175}
1176
1177######################################################################
1178##
1179## remote management
1180
1181proc load_all_remotes {} {
1182        global gitdir all_remotes repo_config
1183
1184        set all_remotes [list]
1185        set rm_dir [file join $gitdir remotes]
1186        if {[file isdirectory $rm_dir]} {
1187                set all_remotes [concat $all_remotes [glob \
1188                        -types f \
1189                        -tails \
1190                        -nocomplain \
1191                        -directory $rm_dir *]]
1192        }
1193
1194        foreach line [array names repo_config remote.*.url] {
1195                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1196                        lappend all_remotes $name
1197                }
1198        }
1199
1200        set all_remotes [lsort -unique $all_remotes]
1201}
1202
1203proc populate_remote_menu {m pfx op} {
1204        global all_remotes
1205
1206        foreach remote $all_remotes {
1207                $m add command -label "$pfx $remote..." \
1208                        -command [list $op $remote] \
1209                        -font font_ui
1210        }
1211}
1212
1213proc populate_pull_menu {m} {
1214        global gitdir repo_config all_remotes disable_on_lock
1215
1216        foreach remote $all_remotes {
1217                set rb {}
1218                if {[array get repo_config remote.$remote.url] != {}} {
1219                        if {[array get repo_config remote.$remote.fetch] != {}} {
1220                                regexp {^([^:]+):} \
1221                                        [lindex $repo_config(remote.$remote.fetch) 0] \
1222                                        line rb
1223                        }
1224                } else {
1225                        catch {
1226                                set fd [open [file join $gitdir remotes $remote] r]
1227                                while {[gets $fd line] >= 0} {
1228                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1229                                                break
1230                                        }
1231                                }
1232                                close $fd
1233                        }
1234                }
1235
1236                set rb_short $rb
1237                regsub ^refs/heads/ $rb {} rb_short
1238                if {$rb_short != {}} {
1239                        $m add command \
1240                                -label "Branch $rb_short from $remote..." \
1241                                -command [list pull_remote $remote $rb] \
1242                                -font font_ui
1243                        lappend disable_on_lock \
1244                                [list $m entryconf [$m index last] -state]
1245                }
1246        }
1247}
1248
1249######################################################################
1250##
1251## icons
1252
1253set filemask {
1254#define mask_width 14
1255#define mask_height 15
1256static unsigned char mask_bits[] = {
1257   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1258   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1259   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1260}
1261
1262image create bitmap file_plain -background white -foreground black -data {
1263#define plain_width 14
1264#define plain_height 15
1265static unsigned char plain_bits[] = {
1266   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1267   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1268   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1269} -maskdata $filemask
1270
1271image create bitmap file_mod -background white -foreground blue -data {
1272#define mod_width 14
1273#define mod_height 15
1274static unsigned char mod_bits[] = {
1275   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1276   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1277   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1278} -maskdata $filemask
1279
1280image create bitmap file_fulltick -background white -foreground "#007000" -data {
1281#define file_fulltick_width 14
1282#define file_fulltick_height 15
1283static unsigned char file_fulltick_bits[] = {
1284   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1285   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1286   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1287} -maskdata $filemask
1288
1289image create bitmap file_parttick -background white -foreground "#005050" -data {
1290#define parttick_width 14
1291#define parttick_height 15
1292static unsigned char parttick_bits[] = {
1293   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1294   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1295   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1296} -maskdata $filemask
1297
1298image create bitmap file_question -background white -foreground black -data {
1299#define file_question_width 14
1300#define file_question_height 15
1301static unsigned char file_question_bits[] = {
1302   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1303   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1304   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1305} -maskdata $filemask
1306
1307image create bitmap file_removed -background white -foreground red -data {
1308#define file_removed_width 14
1309#define file_removed_height 15
1310static unsigned char file_removed_bits[] = {
1311   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1312   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1313   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1314} -maskdata $filemask
1315
1316image create bitmap file_merge -background white -foreground blue -data {
1317#define file_merge_width 14
1318#define file_merge_height 15
1319static unsigned char file_merge_bits[] = {
1320   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1321   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1322   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1323} -maskdata $filemask
1324
1325set ui_index .vpane.files.index.list
1326set ui_other .vpane.files.other.list
1327set max_status_desc 0
1328foreach i {
1329                {__ i plain    "Unmodified"}
1330                {_M i mod      "Modified"}
1331                {M_ i fulltick "Checked in"}
1332                {MM i parttick "Partially included"}
1333
1334                {_O o plain    "Untracked"}
1335                {A_ o fulltick "Added"}
1336                {AM o parttick "Partially added"}
1337                {AD o question "Added (but now gone)"}
1338
1339                {_D i question "Missing"}
1340                {D_ i removed  "Removed"}
1341                {DD i removed  "Removed"}
1342                {DO i removed  "Removed (still exists)"}
1343
1344                {UM i merge    "Merge conflicts"}
1345                {U_ i merge    "Merge conflicts"}
1346        } {
1347        if {$max_status_desc < [string length [lindex $i 3]]} {
1348                set max_status_desc [string length [lindex $i 3]]
1349        }
1350        if {[lindex $i 1] == {i}} {
1351                set all_cols([lindex $i 0]) $ui_index
1352        } else {
1353                set all_cols([lindex $i 0]) $ui_other
1354        }
1355        set all_icons([lindex $i 0]) file_[lindex $i 2]
1356        set all_descs([lindex $i 0]) [lindex $i 3]
1357}
1358unset filemask i
1359
1360######################################################################
1361##
1362## util
1363
1364proc is_MacOSX {} {
1365        global tcl_platform tk_library
1366        if {$tcl_platform(platform) == {unix}
1367                && $tcl_platform(os) == {Darwin}
1368                && [string match /Library/Frameworks/* $tk_library]} {
1369                return 1
1370        }
1371        return 0
1372}
1373
1374proc bind_button3 {w cmd} {
1375        bind $w <Any-Button-3> $cmd
1376        if {[is_MacOSX]} {
1377                bind $w <Control-Button-1> $cmd
1378        }
1379}
1380
1381proc incr_font_size {font {amt 1}} {
1382        set sz [font configure $font -size]
1383        incr sz $amt
1384        font configure $font -size $sz
1385        font configure ${font}bold -size $sz
1386}
1387
1388proc hook_failed_popup {hook msg} {
1389        global gitdir appname
1390
1391        set w .hookfail
1392        toplevel $w
1393
1394        frame $w.m
1395        label $w.m.l1 -text "$hook hook failed:" \
1396                -anchor w \
1397                -justify left \
1398                -font font_uibold
1399        text $w.m.t \
1400                -background white -borderwidth 1 \
1401                -relief sunken \
1402                -width 80 -height 10 \
1403                -font font_diff \
1404                -yscrollcommand [list $w.m.sby set]
1405        label $w.m.l2 \
1406                -text {You must correct the above errors before committing.} \
1407                -anchor w \
1408                -justify left \
1409                -font font_uibold
1410        scrollbar $w.m.sby -command [list $w.m.t yview]
1411        pack $w.m.l1 -side top -fill x
1412        pack $w.m.l2 -side bottom -fill x
1413        pack $w.m.sby -side right -fill y
1414        pack $w.m.t -side left -fill both -expand 1
1415        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1416
1417        $w.m.t insert 1.0 $msg
1418        $w.m.t conf -state disabled
1419
1420        button $w.ok -text OK \
1421                -width 15 \
1422                -font font_ui \
1423                -command "destroy $w"
1424        pack $w.ok -side bottom
1425
1426        bind $w <Visibility> "grab $w; focus $w"
1427        bind $w <Key-Return> "destroy $w"
1428        wm title $w "$appname ([lindex [file split \
1429                [file normalize [file dirname $gitdir]]] \
1430                end]): error"
1431        tkwait window $w
1432}
1433
1434set next_console_id 0
1435
1436proc new_console {short_title long_title} {
1437        global next_console_id console_data
1438        set w .console[incr next_console_id]
1439        set console_data($w) [list $short_title $long_title]
1440        return [console_init $w]
1441}
1442
1443proc console_init {w} {
1444        global console_cr console_data
1445        global gitdir appname M1B
1446
1447        set console_cr($w) 1.0
1448        toplevel $w
1449        frame $w.m
1450        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1451                -anchor w \
1452                -justify left \
1453                -font font_uibold
1454        text $w.m.t \
1455                -background white -borderwidth 1 \
1456                -relief sunken \
1457                -width 80 -height 10 \
1458                -font font_diff \
1459                -state disabled \
1460                -yscrollcommand [list $w.m.sby set]
1461        label $w.m.s -anchor w \
1462                -justify left \
1463                -font font_uibold
1464        scrollbar $w.m.sby -command [list $w.m.t yview]
1465        pack $w.m.l1 -side top -fill x
1466        pack $w.m.s -side bottom -fill x
1467        pack $w.m.sby -side right -fill y
1468        pack $w.m.t -side left -fill both -expand 1
1469        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1470
1471        menu $w.ctxm -tearoff 0
1472        $w.ctxm add command -label "Copy" \
1473                -font font_ui \
1474                -command "tk_textCopy $w.m.t"
1475        $w.ctxm add command -label "Select All" \
1476                -font font_ui \
1477                -command "$w.m.t tag add sel 0.0 end"
1478        $w.ctxm add command -label "Copy All" \
1479                -font font_ui \
1480                -command "
1481                        $w.m.t tag add sel 0.0 end
1482                        tk_textCopy $w.m.t
1483                        $w.m.t tag remove sel 0.0 end
1484                "
1485
1486        button $w.ok -text {Running...} \
1487                -width 15 \
1488                -font font_ui \
1489                -state disabled \
1490                -command "destroy $w"
1491        pack $w.ok -side bottom
1492
1493        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1494        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1495        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1496        bind $w <Visibility> "focus $w"
1497        wm title $w "$appname ([lindex [file split \
1498                [file normalize [file dirname $gitdir]]] \
1499                end]): [lindex $console_data($w) 0]"
1500        return $w
1501}
1502
1503proc console_exec {w cmd {after {}}} {
1504        global tcl_platform
1505
1506        # -- Windows tosses the enviroment when we exec our child.
1507        #    But most users need that so we have to relogin. :-(
1508        #
1509        if {$tcl_platform(platform) == {windows}} {
1510                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1511        }
1512
1513        # -- Tcl won't let us redirect both stdout and stderr to
1514        #    the same pipe.  So pass it through cat...
1515        #
1516        set cmd [concat | $cmd |& cat]
1517
1518        set fd_f [open $cmd r]
1519        fconfigure $fd_f -blocking 0 -translation binary
1520        fileevent $fd_f readable [list console_read $w $fd_f $after]
1521}
1522
1523proc console_read {w fd after} {
1524        global console_cr console_data
1525
1526        set buf [read $fd]
1527        if {$buf != {}} {
1528                if {![winfo exists $w]} {console_init $w}
1529                $w.m.t conf -state normal
1530                set c 0
1531                set n [string length $buf]
1532                while {$c < $n} {
1533                        set cr [string first "\r" $buf $c]
1534                        set lf [string first "\n" $buf $c]
1535                        if {$cr < 0} {set cr [expr $n + 1]}
1536                        if {$lf < 0} {set lf [expr $n + 1]}
1537
1538                        if {$lf < $cr} {
1539                                $w.m.t insert end [string range $buf $c $lf]
1540                                set console_cr($w) [$w.m.t index {end -1c}]
1541                                set c $lf
1542                                incr c
1543                        } else {
1544                                $w.m.t delete $console_cr($w) end
1545                                $w.m.t insert end "\n"
1546                                $w.m.t insert end [string range $buf $c $cr]
1547                                set c $cr
1548                                incr c
1549                        }
1550                }
1551                $w.m.t conf -state disabled
1552                $w.m.t see end
1553        }
1554
1555        fconfigure $fd -blocking 1
1556        if {[eof $fd]} {
1557                if {[catch {close $fd}]} {
1558                        if {![winfo exists $w]} {console_init $w}
1559                        $w.m.s conf -background red -text {Error: Command Failed}
1560                        $w.ok conf -text Close
1561                        $w.ok conf -state normal
1562                        set ok 0
1563                } elseif {[winfo exists $w]} {
1564                        $w.m.s conf -background green -text {Success}
1565                        $w.ok conf -text Close
1566                        $w.ok conf -state normal
1567                        set ok 1
1568                }
1569                array unset console_cr $w
1570                array unset console_data $w
1571                if {$after != {}} {
1572                        uplevel #0 $after $ok
1573                }
1574                return
1575        }
1576        fconfigure $fd -blocking 0
1577}
1578
1579######################################################################
1580##
1581## ui commands
1582
1583set starting_gitk_msg {Please wait... Starting gitk...}
1584
1585proc do_gitk {} {
1586        global tcl_platform ui_status_value starting_gitk_msg
1587
1588        set ui_status_value $starting_gitk_msg
1589        after 10000 {
1590                if {$ui_status_value == $starting_gitk_msg} {
1591                        set ui_status_value {Ready.}
1592                }
1593        }
1594
1595        if {$tcl_platform(platform) == {windows}} {
1596                exec sh -c gitk &
1597        } else {
1598                exec gitk &
1599        }
1600}
1601
1602proc do_repack {} {
1603        set w [new_console "repack" "Repacking the object database"]
1604        set cmd [list git repack]
1605        lappend cmd -a
1606        lappend cmd -d
1607        console_exec $w $cmd
1608}
1609
1610set is_quitting 0
1611
1612proc do_quit {} {
1613        global gitdir ui_comm is_quitting repo_config
1614
1615        if {$is_quitting} return
1616        set is_quitting 1
1617
1618        # -- Stash our current commit buffer.
1619        #
1620        set save [file join $gitdir GITGUI_MSG]
1621        set msg [string trim [$ui_comm get 0.0 end]]
1622        if {[$ui_comm edit modified] && $msg != {}} {
1623                catch {
1624                        set fd [open $save w]
1625                        puts $fd [string trim [$ui_comm get 0.0 end]]
1626                        close $fd
1627                }
1628        } elseif {$msg == {} && [file exists $save]} {
1629                file delete $save
1630        }
1631
1632        # -- Stash our current window geometry into this repository.
1633        #
1634        set cfg_geometry [list]
1635        lappend cfg_geometry [wm geometry .]
1636        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1637        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1638        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1639                set rc_geometry {}
1640        }
1641        if {$cfg_geometry != $rc_geometry} {
1642                catch {exec git repo-config gui.geometry $cfg_geometry}
1643        }
1644
1645        destroy .
1646}
1647
1648proc do_rescan {} {
1649        update_status
1650}
1651
1652proc do_include_all {} {
1653        global file_states
1654
1655        if {![lock_index begin-update]} return
1656
1657        set pathList [list]
1658        foreach path [array names file_states] {
1659                set s $file_states($path)
1660                set m [lindex $s 0]
1661                switch -- $m {
1662                AM -
1663                MM -
1664                _M -
1665                _D {lappend pathList $path}
1666                }
1667        }
1668        if {$pathList == {}} {
1669                unlock_index
1670        } else {
1671                update_index $pathList
1672        }
1673}
1674
1675set GIT_COMMITTER_IDENT {}
1676
1677proc do_signoff {} {
1678        global ui_comm GIT_COMMITTER_IDENT
1679
1680        if {$GIT_COMMITTER_IDENT == {}} {
1681                if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1682                        error_popup "Unable to obtain your identity:\n\n$err"
1683                        return
1684                }
1685                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1686                        $me me GIT_COMMITTER_IDENT]} {
1687                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1688                        return
1689                }
1690        }
1691
1692        set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1693        set last [$ui_comm get {end -1c linestart} {end -1c}]
1694        if {$last != $sob} {
1695                $ui_comm edit separator
1696                if {$last != {}
1697                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1698                        $ui_comm insert end "\n"
1699                }
1700                $ui_comm insert end "\n$sob"
1701                $ui_comm edit separator
1702                $ui_comm see end
1703        }
1704}
1705
1706proc do_amend_last {} {
1707        load_last_commit
1708}
1709
1710proc do_commit {} {
1711        commit_tree
1712}
1713
1714proc do_options {} {
1715        global appname gitdir font_descs
1716        global repo_config global_config
1717        global repo_config_new global_config_new
1718
1719        load_config 1
1720        array unset repo_config_new
1721        array unset global_config_new
1722        foreach name [array names repo_config] {
1723                set repo_config_new($name) $repo_config($name)
1724        }
1725        foreach name [array names global_config] {
1726                set global_config_new($name) $global_config($name)
1727        }
1728        set reponame [lindex [file split \
1729                [file normalize [file dirname $gitdir]]] \
1730                end]
1731
1732        set w .options_editor
1733        toplevel $w
1734        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1735
1736        label $w.header -text "$appname Options" \
1737                -font font_uibold
1738        pack $w.header -side top -fill x
1739
1740        frame $w.buttons
1741        button $w.buttons.restore -text {Restore Defaults} \
1742                -font font_ui \
1743                -command do_restore_defaults
1744        pack $w.buttons.restore -side left
1745        button $w.buttons.save -text Save \
1746                -font font_ui \
1747                -command [list do_save_config $w]
1748        pack $w.buttons.save -side right
1749        button $w.buttons.cancel -text {Cancel} \
1750                -font font_ui \
1751                -command [list destroy $w]
1752        pack $w.buttons.cancel -side right
1753        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1754
1755        labelframe $w.repo -text "$reponame Repository" \
1756                -font font_ui \
1757                -relief raised -borderwidth 2
1758        labelframe $w.global -text {Global (All Repositories)} \
1759                -font font_ui \
1760                -relief raised -borderwidth 2
1761        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1762        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1763
1764        foreach option {
1765                {pullsummary {Show Pull Summary}}
1766                {trustmtime {Trust File Modification Timestamps}}
1767                } {
1768                set name [lindex $option 0]
1769                set text [lindex $option 1]
1770                foreach f {repo global} {
1771                        checkbutton $w.$f.$name -text $text \
1772                                -variable ${f}_config_new(gui.$name) \
1773                                -onvalue true \
1774                                -offvalue false \
1775                                -font font_ui
1776                        pack $w.$f.$name -side top -anchor w
1777                }
1778        }
1779
1780        set all_fonts [lsort [font families]]
1781        foreach option $font_descs {
1782                set name [lindex $option 0]
1783                set font [lindex $option 1]
1784                set text [lindex $option 2]
1785
1786                set global_config_new(gui.$font^^family) \
1787                        [font configure $font -family]
1788                set global_config_new(gui.$font^^size) \
1789                        [font configure $font -size]
1790
1791                frame $w.global.$name
1792                label $w.global.$name.l -text "$text:" -font font_ui
1793                pack $w.global.$name.l -side left -anchor w -fill x
1794                eval tk_optionMenu $w.global.$name.family \
1795                        global_config_new(gui.$font^^family) \
1796                        $all_fonts
1797                spinbox $w.global.$name.size \
1798                        -textvariable global_config_new(gui.$font^^size) \
1799                        -from 2 -to 80 -increment 1 \
1800                        -width 3 \
1801                        -font font_ui
1802                pack $w.global.$name.size -side right -anchor e
1803                pack $w.global.$name.family -side right -anchor e
1804                pack $w.global.$name -side top -anchor w -fill x
1805        }
1806
1807        bind $w <Visibility> "grab $w; focus $w"
1808        bind $w <Key-Escape> "destroy $w"
1809        wm title $w "$appname ($reponame): Options"
1810        tkwait window $w
1811}
1812
1813proc do_restore_defaults {} {
1814        global font_descs default_config repo_config
1815        global repo_config_new global_config_new
1816
1817        foreach name [array names default_config] {
1818                set repo_config_new($name) $default_config($name)
1819                set global_config_new($name) $default_config($name)
1820        }
1821
1822        foreach option $font_descs {
1823                set name [lindex $option 0]
1824                set repo_config(gui.$name) $default_config(gui.$name)
1825        }
1826        apply_config
1827
1828        foreach option $font_descs {
1829                set name [lindex $option 0]
1830                set font [lindex $option 1]
1831                set global_config_new(gui.$font^^family) \
1832                        [font configure $font -family]
1833                set global_config_new(gui.$font^^size) \
1834                        [font configure $font -size]
1835        }
1836}
1837
1838proc do_save_config {w} {
1839        if {[catch {save_config} err]} {
1840                error_popup "Failed to completely save options:\n\n$err"
1841        }
1842        destroy $w
1843}
1844
1845# shift == 1: left click
1846#          3: right click  
1847proc click {w x y shift wx wy} {
1848        global ui_index ui_other file_lists
1849
1850        set pos [split [$w index @$x,$y] .]
1851        set lno [lindex $pos 0]
1852        set col [lindex $pos 1]
1853        set path [lindex $file_lists($w) [expr $lno - 1]]
1854        if {$path == {}} return
1855
1856        if {$col > 0 && $shift == 1} {
1857                show_diff $path $w $lno
1858        }
1859}
1860
1861proc unclick {w x y} {
1862        global file_lists
1863
1864        set pos [split [$w index @$x,$y] .]
1865        set lno [lindex $pos 0]
1866        set col [lindex $pos 1]
1867        set path [lindex $file_lists($w) [expr $lno - 1]]
1868        if {$path == {}} return
1869
1870        if {$col == 0} {
1871                update_index [list $path]
1872        }
1873}
1874
1875######################################################################
1876##
1877## config defaults
1878
1879set cursor_ptr arrow
1880font create font_diff -family Courier -size 10
1881font create font_ui
1882catch {
1883        label .dummy
1884        eval font configure font_ui [font actual [.dummy cget -font]]
1885        destroy .dummy
1886}
1887
1888font create font_uibold
1889font create font_diffbold
1890
1891set M1B M1
1892set M1T M1
1893if {$tcl_platform(platform) == {windows}} {
1894        set M1B Control
1895        set M1T Ctrl
1896} elseif {[is_MacOSX]} {
1897        set M1B M1
1898        set M1T Cmd
1899}
1900
1901proc apply_config {} {
1902        global repo_config font_descs
1903
1904        foreach option $font_descs {
1905                set name [lindex $option 0]
1906                set font [lindex $option 1]
1907                if {[catch {
1908                        foreach {cn cv} $repo_config(gui.$name) {
1909                                font configure $font $cn $cv
1910                        }
1911                        } err]} {
1912                        error_popup "Invalid font specified in gui.$name:\n\n$err"
1913                }
1914                foreach {cn cv} [font configure $font] {
1915                        font configure ${font}bold $cn $cv
1916                }
1917                font configure ${font}bold -weight bold
1918        }
1919}
1920
1921set default_config(gui.trustmtime) false
1922set default_config(gui.pullsummary) true
1923set default_config(gui.fontui) [font configure font_ui]
1924set default_config(gui.fontdiff) [font configure font_diff]
1925set font_descs {
1926        {fontui   font_ui   {Main Font}}
1927        {fontdiff font_diff {Diff/Console Font}}
1928}
1929load_config 0
1930apply_config
1931
1932######################################################################
1933##
1934## ui construction
1935
1936# -- Menu Bar
1937menu .mbar -tearoff 0
1938.mbar add cascade -label Project -menu .mbar.project
1939.mbar add cascade -label Edit -menu .mbar.edit
1940.mbar add cascade -label Commit -menu .mbar.commit
1941if {!$single_commit} {
1942        .mbar add cascade -label Fetch -menu .mbar.fetch
1943        .mbar add cascade -label Pull -menu .mbar.pull
1944        .mbar add cascade -label Push -menu .mbar.push
1945}
1946. configure -menu .mbar
1947
1948# -- Project Menu
1949menu .mbar.project
1950.mbar.project add command -label Visualize \
1951        -command do_gitk \
1952        -font font_ui
1953if {!$single_commit} {
1954        .mbar.project add command -label {Repack Database} \
1955                -command do_repack \
1956                -font font_ui
1957}
1958.mbar.project add command -label Quit \
1959        -command do_quit \
1960        -accelerator $M1T-Q \
1961        -font font_ui
1962
1963# -- Edit Menu
1964#
1965menu .mbar.edit
1966.mbar.edit add command -label Undo \
1967        -command {catch {[focus] edit undo}} \
1968        -accelerator $M1T-Z \
1969        -font font_ui
1970.mbar.edit add command -label Redo \
1971        -command {catch {[focus] edit redo}} \
1972        -accelerator $M1T-Y \
1973        -font font_ui
1974.mbar.edit add separator
1975.mbar.edit add command -label Cut \
1976        -command {catch {tk_textCut [focus]}} \
1977        -accelerator $M1T-X \
1978        -font font_ui
1979.mbar.edit add command -label Copy \
1980        -command {catch {tk_textCopy [focus]}} \
1981        -accelerator $M1T-C \
1982        -font font_ui
1983.mbar.edit add command -label Paste \
1984        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1985        -accelerator $M1T-V \
1986        -font font_ui
1987.mbar.edit add command -label Delete \
1988        -command {catch {[focus] delete sel.first sel.last}} \
1989        -accelerator Del \
1990        -font font_ui
1991.mbar.edit add separator
1992.mbar.edit add command -label {Select All} \
1993        -command {catch {[focus] tag add sel 0.0 end}} \
1994        -accelerator $M1T-A \
1995        -font font_ui
1996.mbar.edit add separator
1997.mbar.edit add command -label {Options...} \
1998        -command do_options \
1999        -font font_ui
2000
2001# -- Commit Menu
2002menu .mbar.commit
2003.mbar.commit add command -label Rescan \
2004        -command do_rescan \
2005        -accelerator F5 \
2006        -font font_ui
2007lappend disable_on_lock \
2008        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2009.mbar.commit add command -label {Amend Last Commit} \
2010        -command do_amend_last \
2011        -font font_ui
2012lappend disable_on_lock \
2013        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2014.mbar.commit add command -label {Include All Files} \
2015        -command do_include_all \
2016        -accelerator $M1T-I \
2017        -font font_ui
2018lappend disable_on_lock \
2019        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2020.mbar.commit add command -label {Sign Off} \
2021        -command do_signoff \
2022        -accelerator $M1T-S \
2023        -font font_ui
2024.mbar.commit add command -label Commit \
2025        -command do_commit \
2026        -accelerator $M1T-Return \
2027        -font font_ui
2028lappend disable_on_lock \
2029        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2030
2031if {!$single_commit} {
2032        # -- Fetch Menu
2033        menu .mbar.fetch
2034
2035        # -- Pull Menu
2036        menu .mbar.pull
2037
2038        # -- Push Menu
2039        menu .mbar.push
2040}
2041
2042# -- Main Window Layout
2043panedwindow .vpane -orient vertical
2044panedwindow .vpane.files -orient horizontal
2045.vpane add .vpane.files -sticky nsew -height 100 -width 400
2046pack .vpane -anchor n -side top -fill both -expand 1
2047
2048# -- Index File List
2049frame .vpane.files.index -height 100 -width 400
2050label .vpane.files.index.title -text {Modified Files} \
2051        -background green \
2052        -font font_ui
2053text $ui_index -background white -borderwidth 0 \
2054        -width 40 -height 10 \
2055        -font font_ui \
2056        -cursor $cursor_ptr \
2057        -yscrollcommand {.vpane.files.index.sb set} \
2058        -state disabled
2059scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2060pack .vpane.files.index.title -side top -fill x
2061pack .vpane.files.index.sb -side right -fill y
2062pack $ui_index -side left -fill both -expand 1
2063.vpane.files add .vpane.files.index -sticky nsew
2064
2065# -- Other (Add) File List
2066frame .vpane.files.other -height 100 -width 100
2067label .vpane.files.other.title -text {Untracked Files} \
2068        -background red \
2069        -font font_ui
2070text $ui_other -background white -borderwidth 0 \
2071        -width 40 -height 10 \
2072        -font font_ui \
2073        -cursor $cursor_ptr \
2074        -yscrollcommand {.vpane.files.other.sb set} \
2075        -state disabled
2076scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2077pack .vpane.files.other.title -side top -fill x
2078pack .vpane.files.other.sb -side right -fill y
2079pack $ui_other -side left -fill both -expand 1
2080.vpane.files add .vpane.files.other -sticky nsew
2081
2082$ui_index tag conf in_diff -font font_uibold
2083$ui_other tag conf in_diff -font font_uibold
2084
2085# -- Diff and Commit Area
2086frame .vpane.lower -height 300 -width 400
2087frame .vpane.lower.commarea
2088frame .vpane.lower.diff -relief sunken -borderwidth 1
2089pack .vpane.lower.commarea -side top -fill x
2090pack .vpane.lower.diff -side bottom -fill both -expand 1
2091.vpane add .vpane.lower -stick nsew
2092
2093# -- Commit Area Buttons
2094frame .vpane.lower.commarea.buttons
2095label .vpane.lower.commarea.buttons.l -text {} \
2096        -anchor w \
2097        -justify left \
2098        -font font_ui
2099pack .vpane.lower.commarea.buttons.l -side top -fill x
2100pack .vpane.lower.commarea.buttons -side left -fill y
2101
2102button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2103        -command do_rescan \
2104        -font font_ui
2105pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2106lappend disable_on_lock \
2107        {.vpane.lower.commarea.buttons.rescan conf -state}
2108
2109button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2110        -command do_amend_last \
2111        -font font_ui
2112pack .vpane.lower.commarea.buttons.amend -side top -fill x
2113lappend disable_on_lock \
2114        {.vpane.lower.commarea.buttons.amend conf -state}
2115
2116button .vpane.lower.commarea.buttons.incall -text {Include All} \
2117        -command do_include_all \
2118        -font font_ui
2119pack .vpane.lower.commarea.buttons.incall -side top -fill x
2120lappend disable_on_lock \
2121        {.vpane.lower.commarea.buttons.incall conf -state}
2122
2123button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2124        -command do_signoff \
2125        -font font_ui
2126pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2127
2128button .vpane.lower.commarea.buttons.commit -text {Commit} \
2129        -command do_commit \
2130        -font font_ui
2131pack .vpane.lower.commarea.buttons.commit -side top -fill x
2132lappend disable_on_lock \
2133        {.vpane.lower.commarea.buttons.commit conf -state}
2134
2135# -- Commit Message Buffer
2136frame .vpane.lower.commarea.buffer
2137set ui_comm .vpane.lower.commarea.buffer.t
2138set ui_coml .vpane.lower.commarea.buffer.l
2139label $ui_coml -text {Commit Message:} \
2140        -anchor w \
2141        -justify left \
2142        -font font_ui
2143trace add variable commit_type write {uplevel #0 {
2144        switch -glob $commit_type \
2145        initial {$ui_coml conf -text {Initial Commit Message:}} \
2146        amend   {$ui_coml conf -text {Amended Commit Message:}} \
2147        merge   {$ui_coml conf -text {Merge Commit Message:}} \
2148        *       {$ui_coml conf -text {Commit Message:}}
2149}}
2150text $ui_comm -background white -borderwidth 1 \
2151        -undo true \
2152        -maxundo 20 \
2153        -autoseparators true \
2154        -relief sunken \
2155        -width 75 -height 9 -wrap none \
2156        -font font_diff \
2157        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2158scrollbar .vpane.lower.commarea.buffer.sby \
2159        -command [list $ui_comm yview]
2160pack $ui_coml -side top -fill x
2161pack .vpane.lower.commarea.buffer.sby -side right -fill y
2162pack $ui_comm -side left -fill y
2163pack .vpane.lower.commarea.buffer -side left -fill y
2164
2165# -- Commit Message Buffer Context Menu
2166#
2167menu $ui_comm.ctxm -tearoff 0
2168$ui_comm.ctxm add command -label "Cut" \
2169        -font font_ui \
2170        -command "tk_textCut $ui_comm"
2171$ui_comm.ctxm add command -label "Copy" \
2172        -font font_ui \
2173        -command "tk_textCopy $ui_comm"
2174$ui_comm.ctxm add command -label "Paste" \
2175        -font font_ui \
2176        -command "tk_textPaste $ui_comm"
2177$ui_comm.ctxm add command -label "Delete" \
2178        -font font_ui \
2179        -command "$ui_comm delete sel.first sel.last"
2180$ui_comm.ctxm add separator
2181$ui_comm.ctxm add command -label "Select All" \
2182        -font font_ui \
2183        -command "$ui_comm tag add sel 0.0 end"
2184$ui_comm.ctxm add command -label "Copy All" \
2185        -font font_ui \
2186        -command "
2187                $ui_comm tag add sel 0.0 end
2188                tk_textCopy $ui_comm
2189                $ui_comm tag remove sel 0.0 end
2190        "
2191$ui_comm.ctxm add separator
2192$ui_comm.ctxm add command -label "Sign Off" \
2193        -font font_ui \
2194        -command do_signoff
2195bind_button3 $ui_comm "tk_popup $ui_comm.ctxm %X %Y"
2196
2197# -- Diff Header
2198set ui_fname_value {}
2199set ui_fstatus_value {}
2200frame .vpane.lower.diff.header -background orange
2201label .vpane.lower.diff.header.l1 -text {File:} \
2202        -background orange \
2203        -font font_ui
2204label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
2205        -background orange \
2206        -anchor w \
2207        -justify left \
2208        -font font_ui
2209label .vpane.lower.diff.header.l3 -text {Status:} \
2210        -background orange \
2211        -font font_ui
2212label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
2213        -background orange \
2214        -width $max_status_desc \
2215        -anchor w \
2216        -justify left \
2217        -font font_ui
2218pack .vpane.lower.diff.header.l1 -side left
2219pack .vpane.lower.diff.header.l2 -side left -fill x
2220pack .vpane.lower.diff.header.l4 -side right
2221pack .vpane.lower.diff.header.l3 -side right
2222
2223# -- Diff Body
2224frame .vpane.lower.diff.body
2225set ui_diff .vpane.lower.diff.body.t
2226text $ui_diff -background white -borderwidth 0 \
2227        -width 80 -height 15 -wrap none \
2228        -font font_diff \
2229        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2230        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2231        -state disabled
2232scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2233        -command [list $ui_diff xview]
2234scrollbar .vpane.lower.diff.body.sby -orient vertical \
2235        -command [list $ui_diff yview]
2236pack .vpane.lower.diff.body.sbx -side bottom -fill x
2237pack .vpane.lower.diff.body.sby -side right -fill y
2238pack $ui_diff -side left -fill both -expand 1
2239pack .vpane.lower.diff.header -side top -fill x
2240pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2241
2242$ui_diff tag conf dm -foreground red
2243$ui_diff tag conf dp -foreground blue
2244$ui_diff tag conf di -foreground {#00a000}
2245$ui_diff tag conf dni -foreground {#a000a0}
2246$ui_diff tag conf da -font font_diffbold
2247$ui_diff tag conf bold -font font_diffbold
2248
2249# -- Diff Body Context Menu
2250#
2251menu $ui_diff.ctxm -tearoff 0
2252$ui_diff.ctxm add command -label "Copy" \
2253        -font font_ui \
2254        -command "tk_textCopy $ui_diff"
2255$ui_diff.ctxm add command -label "Select All" \
2256        -font font_ui \
2257        -command "$ui_diff tag add sel 0.0 end"
2258$ui_diff.ctxm add command -label "Copy All" \
2259        -font font_ui \
2260        -command "
2261                $ui_diff tag add sel 0.0 end
2262                tk_textCopy $ui_diff
2263                $ui_diff tag remove sel 0.0 end
2264        "
2265$ui_diff.ctxm add separator
2266$ui_diff.ctxm add command -label "Decrease Font Size" \
2267        -font font_ui \
2268        -command {incr_font_size font_diff -1}
2269$ui_diff.ctxm add command -label "Increase Font Size" \
2270        -font font_ui \
2271        -command {incr_font_size font_diff 1}
2272$ui_diff.ctxm add command -label {Options...} \
2273        -font font_ui \
2274        -command do_options
2275bind_button3 $ui_diff "tk_popup $ui_diff.ctxm %X %Y"
2276
2277# -- Status Bar
2278set ui_status_value {Initializing...}
2279label .status -textvariable ui_status_value \
2280        -anchor w \
2281        -justify left \
2282        -borderwidth 1 \
2283        -relief sunken \
2284        -font font_ui
2285pack .status -anchor w -side bottom -fill x
2286
2287# -- Load geometry
2288catch {
2289set gm $repo_config(gui.geometry)
2290wm geometry . [lindex $gm 0]
2291.vpane sash place 0 \
2292        [lindex [.vpane sash coord 0] 0] \
2293        [lindex $gm 1]
2294.vpane.files sash place 0 \
2295        [lindex $gm 2] \
2296        [lindex [.vpane.files sash coord 0] 1]
2297unset gm
2298}
2299
2300# -- Key Bindings
2301bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2302bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2303bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2304bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2305bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2306bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2307bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2308bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2309bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2310bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2311bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2312
2313bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2314bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2315bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2316bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2317bind $ui_diff <$M1B-Key-v> {break}
2318bind $ui_diff <$M1B-Key-V> {break}
2319bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2320bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2321bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2322bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2323bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2324bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2325
2326bind .   <Destroy> do_quit
2327bind all <Key-F5> do_rescan
2328bind all <$M1B-Key-r> do_rescan
2329bind all <$M1B-Key-R> do_rescan
2330bind .   <$M1B-Key-s> do_signoff
2331bind .   <$M1B-Key-S> do_signoff
2332bind .   <$M1B-Key-i> do_include_all
2333bind .   <$M1B-Key-I> do_include_all
2334bind .   <$M1B-Key-Return> do_commit
2335bind all <$M1B-Key-q> do_quit
2336bind all <$M1B-Key-Q> do_quit
2337bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2338bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2339foreach i [list $ui_index $ui_other] {
2340        bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
2341        bind $i <ButtonRelease-1> {unclick %W %x %y; break}
2342        bind_button3 $i {click %W %x %y 3 %X %Y; break}
2343}
2344unset i
2345
2346set file_lists($ui_index) [list]
2347set file_lists($ui_other) [list]
2348
2349wm title . "$appname ([file normalize [file dirname $gitdir]])"
2350focus -force $ui_comm
2351if {!$single_commit} {
2352        load_all_remotes
2353        populate_remote_menu .mbar.fetch From fetch_from
2354        populate_remote_menu .mbar.push To push_to
2355        populate_pull_menu .mbar.pull
2356}
2357after 1 update_status