Andrew's git / gitweb.git /
fbb3090ed16b851bbde11257c976bcb9d69a8db4
   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
 900        global file_states
 901
 902        if {![lock_index update]} return
 903
 904        # -- Our in memory state should match the repository.
 905        #
 906        repository_state curHEAD cur_type
 907        if {$commit_type != $cur_type || $HEAD != $curHEAD} {
 908                error_popup {Last scanned state does not match repository state.
 909
 910Its highly likely that another Git program modified the
 911repository since our last scan.  A rescan is required
 912before a pull can be started.
 913}
 914                unlock_index
 915                update_status
 916                return
 917        }
 918
 919        # -- No differences should exist before a pull.
 920        #
 921        if {[array size file_states] != 0} {
 922                error_popup {Uncommitted but modified files are present.
 923
 924You should not perform a pull with unmodified files in your working
 925directory as Git would be unable to recover from an incorrect merge.
 926
 927Commit or throw away all changes before starting a pull operation.
 928}
 929                unlock_index
 930                return
 931        }
 932
 933        set w [new_console "pull $remote $branch" \
 934                "Pulling new changes from branch $branch in $remote"]
 935        set cmd [list git pull]
 936        lappend cmd $remote
 937        lappend cmd $branch
 938        console_exec $w $cmd [list post_pull_remote $remote $branch]
 939}
 940
 941proc post_pull_remote {remote branch success} {
 942        global HEAD PARENT commit_type
 943        global ui_status_value
 944
 945        unlock_index
 946        if {$success} {
 947                repository_state HEAD commit_type
 948                set PARENT $HEAD
 949                set $ui_status_value {Ready.}
 950        } else {
 951                update_status \
 952                        "Conflicts detected while pulling $branch from $remote."
 953        }
 954}
 955
 956proc push_to {remote} {
 957        set w [new_console "push $remote" \
 958                "Pushing changes to $remote"]
 959        set cmd [list git push]
 960        lappend cmd $remote
 961        console_exec $w $cmd
 962}
 963
 964######################################################################
 965##
 966## ui helpers
 967
 968proc mapcol {state path} {
 969        global all_cols ui_other
 970
 971        if {[catch {set r $all_cols($state)}]} {
 972                puts "error: no column for state={$state} $path"
 973                return $ui_other
 974        }
 975        return $r
 976}
 977
 978proc mapicon {state path} {
 979        global all_icons
 980
 981        if {[catch {set r $all_icons($state)}]} {
 982                puts "error: no icon for state={$state} $path"
 983                return file_plain
 984        }
 985        return $r
 986}
 987
 988proc mapdesc {state path} {
 989        global all_descs
 990
 991        if {[catch {set r $all_descs($state)}]} {
 992                puts "error: no desc for state={$state} $path"
 993                return $state
 994        }
 995        return $r
 996}
 997
 998proc escape_path {path} {
 999        regsub -all "\n" $path "\\n" path
1000        return $path
1001}
1002
1003proc short_path {path} {
1004        return [escape_path [lindex [file split $path] end]]
1005}
1006
1007set next_icon_id 0
1008
1009proc merge_state {path new_state} {
1010        global file_states next_icon_id
1011
1012        set s0 [string index $new_state 0]
1013        set s1 [string index $new_state 1]
1014
1015        if {[catch {set info $file_states($path)}]} {
1016                set state __
1017                set icon n[incr next_icon_id]
1018        } else {
1019                set state [lindex $info 0]
1020                set icon [lindex $info 1]
1021        }
1022
1023        if {$s0 == {_}} {
1024                set s0 [string index $state 0]
1025        } elseif {$s0 == {*}} {
1026                set s0 _
1027        }
1028
1029        if {$s1 == {_}} {
1030                set s1 [string index $state 1]
1031        } elseif {$s1 == {*}} {
1032                set s1 _
1033        }
1034
1035        set file_states($path) [list $s0$s1 $icon]
1036        return $state
1037}
1038
1039proc display_file {path state} {
1040        global file_states file_lists status_active
1041
1042        set old_m [merge_state $path $state]
1043        if {$status_active} return
1044
1045        set s $file_states($path)
1046        set new_m [lindex $s 0]
1047        set new_w [mapcol $new_m $path] 
1048        set old_w [mapcol $old_m $path]
1049        set new_icon [mapicon $new_m $path]
1050
1051        if {$new_w != $old_w} {
1052                set lno [lsearch -sorted $file_lists($old_w) $path]
1053                if {$lno >= 0} {
1054                        incr lno
1055                        $old_w conf -state normal
1056                        $old_w delete $lno.0 [expr $lno + 1].0
1057                        $old_w conf -state disabled
1058                }
1059
1060                lappend file_lists($new_w) $path
1061                set file_lists($new_w) [lsort $file_lists($new_w)]
1062                set lno [lsearch -sorted $file_lists($new_w) $path]
1063                incr lno
1064                $new_w conf -state normal
1065                $new_w image create $lno.0 \
1066                        -align center -padx 5 -pady 1 \
1067                        -name [lindex $s 1] \
1068                        -image $new_icon
1069                $new_w insert $lno.1 "[escape_path $path]\n"
1070                $new_w conf -state disabled
1071        } elseif {$new_icon != [mapicon $old_m $path]} {
1072                $new_w conf -state normal
1073                $new_w image conf [lindex $s 1] -image $new_icon
1074                $new_w conf -state disabled
1075        }
1076}
1077
1078proc display_all_files {} {
1079        global ui_index ui_other file_states file_lists
1080
1081        $ui_index conf -state normal
1082        $ui_other conf -state normal
1083
1084        $ui_index delete 0.0 end
1085        $ui_other delete 0.0 end
1086
1087        set file_lists($ui_index) [list]
1088        set file_lists($ui_other) [list]
1089
1090        foreach path [lsort [array names file_states]] {
1091                set s $file_states($path)
1092                set m [lindex $s 0]
1093                set w [mapcol $m $path]
1094                lappend file_lists($w) $path
1095                $w image create end \
1096                        -align center -padx 5 -pady 1 \
1097                        -name [lindex $s 1] \
1098                        -image [mapicon $m $path]
1099                $w insert end "[escape_path $path]\n"
1100        }
1101
1102        $ui_index conf -state disabled
1103        $ui_other conf -state disabled
1104}
1105
1106proc update_index {pathList} {
1107        global update_index_cp ui_status_value
1108
1109        if {![lock_index update]} return
1110
1111        set update_index_cp 0
1112        set totalCnt [llength $pathList]
1113        set batch [expr {int($totalCnt * .01) + 1}]
1114        if {$batch > 25} {set batch 25}
1115
1116        set ui_status_value "Including files ... 0/$totalCnt 0%"
1117        set ui_status_value [format \
1118                "Including files ... %i/%i files (%.2f%%)" \
1119                $update_index_cp \
1120                $totalCnt \
1121                0.0]
1122        set fd [open "| git update-index --add --remove -z --stdin" w]
1123        fconfigure $fd -blocking 0 -translation binary
1124        fileevent $fd writable [list \
1125                write_update_index \
1126                $fd \
1127                $pathList \
1128                $totalCnt \
1129                $batch \
1130                ]
1131}
1132
1133proc write_update_index {fd pathList totalCnt batch} {
1134        global update_index_cp ui_status_value
1135        global file_states ui_fname_value
1136
1137        if {$update_index_cp >= $totalCnt} {
1138                close $fd
1139                unlock_index
1140                set ui_status_value {Ready.}
1141                return
1142        }
1143
1144        for {set i $batch} \
1145                {$update_index_cp < $totalCnt && $i > 0} \
1146                {incr i -1} {
1147                set path [lindex $pathList $update_index_cp]
1148                incr update_index_cp
1149
1150                switch -- [lindex $file_states($path) 0] {
1151                AM -
1152                _O {set new A*}
1153                _M -
1154                MM {set new M*}
1155                AD -
1156                _D {set new D*}
1157                default {continue}
1158                }
1159
1160                puts -nonewline $fd $path
1161                puts -nonewline $fd "\0"
1162                display_file $path $new
1163                if {$ui_fname_value == $path} {
1164                        show_diff $path
1165                }
1166        }
1167
1168        set ui_status_value [format \
1169                "Including files ... %i/%i files (%.2f%%)" \
1170                $update_index_cp \
1171                $totalCnt \
1172                [expr {100.0 * $update_index_cp / $totalCnt}]]
1173}
1174
1175######################################################################
1176##
1177## remote management
1178
1179proc load_all_remotes {} {
1180        global gitdir all_remotes repo_config
1181
1182        set all_remotes [list]
1183        set rm_dir [file join $gitdir remotes]
1184        if {[file isdirectory $rm_dir]} {
1185                set all_remotes [concat $all_remotes [glob \
1186                        -types f \
1187                        -tails \
1188                        -nocomplain \
1189                        -directory $rm_dir *]]
1190        }
1191
1192        foreach line [array names repo_config remote.*.url] {
1193                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1194                        lappend all_remotes $name
1195                }
1196        }
1197
1198        set all_remotes [lsort -unique $all_remotes]
1199}
1200
1201proc populate_remote_menu {m pfx op} {
1202        global all_remotes
1203
1204        foreach remote $all_remotes {
1205                $m add command -label "$pfx $remote..." \
1206                        -command [list $op $remote] \
1207                        -font font_ui
1208        }
1209}
1210
1211proc populate_pull_menu {m} {
1212        global gitdir repo_config all_remotes disable_on_lock
1213
1214        foreach remote $all_remotes {
1215                set rb {}
1216                if {[array get repo_config remote.$remote.url] != {}} {
1217                        if {[array get repo_config remote.$remote.fetch] != {}} {
1218                                regexp {^([^:]+):} \
1219                                        [lindex $repo_config(remote.$remote.fetch) 0] \
1220                                        line rb
1221                        }
1222                } else {
1223                        catch {
1224                                set fd [open [file join $gitdir remotes $remote] r]
1225                                while {[gets $fd line] >= 0} {
1226                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1227                                                break
1228                                        }
1229                                }
1230                                close $fd
1231                        }
1232                }
1233
1234                set rb_short $rb
1235                regsub ^refs/heads/ $rb {} rb_short
1236                if {$rb_short != {}} {
1237                        $m add command \
1238                                -label "Branch $rb_short from $remote..." \
1239                                -command [list pull_remote $remote $rb] \
1240                                -font font_ui
1241                        lappend disable_on_lock \
1242                                [list $m entryconf [$m index last] -state]
1243                }
1244        }
1245}
1246
1247######################################################################
1248##
1249## icons
1250
1251set filemask {
1252#define mask_width 14
1253#define mask_height 15
1254static unsigned char mask_bits[] = {
1255   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1256   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1257   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1258}
1259
1260image create bitmap file_plain -background white -foreground black -data {
1261#define plain_width 14
1262#define plain_height 15
1263static unsigned char plain_bits[] = {
1264   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1265   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1266   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1267} -maskdata $filemask
1268
1269image create bitmap file_mod -background white -foreground blue -data {
1270#define mod_width 14
1271#define mod_height 15
1272static unsigned char mod_bits[] = {
1273   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1274   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1275   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1276} -maskdata $filemask
1277
1278image create bitmap file_fulltick -background white -foreground "#007000" -data {
1279#define file_fulltick_width 14
1280#define file_fulltick_height 15
1281static unsigned char file_fulltick_bits[] = {
1282   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1283   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1284   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1285} -maskdata $filemask
1286
1287image create bitmap file_parttick -background white -foreground "#005050" -data {
1288#define parttick_width 14
1289#define parttick_height 15
1290static unsigned char parttick_bits[] = {
1291   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1292   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1293   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1294} -maskdata $filemask
1295
1296image create bitmap file_question -background white -foreground black -data {
1297#define file_question_width 14
1298#define file_question_height 15
1299static unsigned char file_question_bits[] = {
1300   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1301   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1302   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1303} -maskdata $filemask
1304
1305image create bitmap file_removed -background white -foreground red -data {
1306#define file_removed_width 14
1307#define file_removed_height 15
1308static unsigned char file_removed_bits[] = {
1309   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1310   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1311   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1312} -maskdata $filemask
1313
1314image create bitmap file_merge -background white -foreground blue -data {
1315#define file_merge_width 14
1316#define file_merge_height 15
1317static unsigned char file_merge_bits[] = {
1318   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1319   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1320   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1321} -maskdata $filemask
1322
1323set ui_index .vpane.files.index.list
1324set ui_other .vpane.files.other.list
1325set max_status_desc 0
1326foreach i {
1327                {__ i plain    "Unmodified"}
1328                {_M i mod      "Modified"}
1329                {M_ i fulltick "Checked in"}
1330                {MM i parttick "Partially included"}
1331
1332                {_O o plain    "Untracked"}
1333                {A_ o fulltick "Added"}
1334                {AM o parttick "Partially added"}
1335                {AD o question "Added (but now gone)"}
1336
1337                {_D i question "Missing"}
1338                {D_ i removed  "Removed"}
1339                {DD i removed  "Removed"}
1340                {DO i removed  "Removed (still exists)"}
1341
1342                {UM i merge    "Merge conflicts"}
1343                {U_ i merge    "Merge conflicts"}
1344        } {
1345        if {$max_status_desc < [string length [lindex $i 3]]} {
1346                set max_status_desc [string length [lindex $i 3]]
1347        }
1348        if {[lindex $i 1] == {i}} {
1349                set all_cols([lindex $i 0]) $ui_index
1350        } else {
1351                set all_cols([lindex $i 0]) $ui_other
1352        }
1353        set all_icons([lindex $i 0]) file_[lindex $i 2]
1354        set all_descs([lindex $i 0]) [lindex $i 3]
1355}
1356unset filemask i
1357
1358######################################################################
1359##
1360## util
1361
1362proc is_MacOSX {} {
1363        global tcl_platform tk_library
1364        if {$tcl_platform(platform) == {unix}
1365                && $tcl_platform(os) == {Darwin}
1366                && [string match /Library/Frameworks/* $tk_library]} {
1367                return 1
1368        }
1369        return 0
1370}
1371
1372proc bind_button3 {w cmd} {
1373        bind $w <Any-Button-3> $cmd
1374        if {[is_MacOSX]} {
1375                bind $w <Control-Button-1> $cmd
1376        }
1377}
1378
1379proc incr_font_size {font {amt 1}} {
1380        set sz [font configure $font -size]
1381        incr sz $amt
1382        font configure $font -size $sz
1383        font configure ${font}bold -size $sz
1384}
1385
1386proc hook_failed_popup {hook msg} {
1387        global gitdir appname
1388
1389        set w .hookfail
1390        toplevel $w
1391
1392        frame $w.m
1393        label $w.m.l1 -text "$hook hook failed:" \
1394                -anchor w \
1395                -justify left \
1396                -font font_uibold
1397        text $w.m.t \
1398                -background white -borderwidth 1 \
1399                -relief sunken \
1400                -width 80 -height 10 \
1401                -font font_diff \
1402                -yscrollcommand [list $w.m.sby set]
1403        label $w.m.l2 \
1404                -text {You must correct the above errors before committing.} \
1405                -anchor w \
1406                -justify left \
1407                -font font_uibold
1408        scrollbar $w.m.sby -command [list $w.m.t yview]
1409        pack $w.m.l1 -side top -fill x
1410        pack $w.m.l2 -side bottom -fill x
1411        pack $w.m.sby -side right -fill y
1412        pack $w.m.t -side left -fill both -expand 1
1413        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1414
1415        $w.m.t insert 1.0 $msg
1416        $w.m.t conf -state disabled
1417
1418        button $w.ok -text OK \
1419                -width 15 \
1420                -font font_ui \
1421                -command "destroy $w"
1422        pack $w.ok -side bottom
1423
1424        bind $w <Visibility> "grab $w; focus $w"
1425        bind $w <Key-Return> "destroy $w"
1426        wm title $w "$appname ([lindex [file split \
1427                [file normalize [file dirname $gitdir]]] \
1428                end]): error"
1429        tkwait window $w
1430}
1431
1432set next_console_id 0
1433
1434proc new_console {short_title long_title} {
1435        global next_console_id console_data
1436        set w .console[incr next_console_id]
1437        set console_data($w) [list $short_title $long_title]
1438        return [console_init $w]
1439}
1440
1441proc console_init {w} {
1442        global console_cr console_data
1443        global gitdir appname M1B
1444
1445        set console_cr($w) 1.0
1446        toplevel $w
1447        frame $w.m
1448        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1449                -anchor w \
1450                -justify left \
1451                -font font_uibold
1452        text $w.m.t \
1453                -background white -borderwidth 1 \
1454                -relief sunken \
1455                -width 80 -height 10 \
1456                -font font_diff \
1457                -state disabled \
1458                -yscrollcommand [list $w.m.sby set]
1459        label $w.m.s -anchor w \
1460                -justify left \
1461                -font font_uibold
1462        scrollbar $w.m.sby -command [list $w.m.t yview]
1463        pack $w.m.l1 -side top -fill x
1464        pack $w.m.s -side bottom -fill x
1465        pack $w.m.sby -side right -fill y
1466        pack $w.m.t -side left -fill both -expand 1
1467        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1468
1469        menu $w.ctxm -tearoff 0
1470        $w.ctxm add command -label "Copy" \
1471                -font font_ui \
1472                -command "tk_textCopy $w.m.t"
1473        $w.ctxm add command -label "Select All" \
1474                -font font_ui \
1475                -command "$w.m.t tag add sel 0.0 end"
1476        $w.ctxm add command -label "Copy All" \
1477                -font font_ui \
1478                -command "
1479                        $w.m.t tag add sel 0.0 end
1480                        tk_textCopy $w.m.t
1481                        $w.m.t tag remove sel 0.0 end
1482                "
1483
1484        button $w.ok -text {Running...} \
1485                -width 15 \
1486                -font font_ui \
1487                -state disabled \
1488                -command "destroy $w"
1489        pack $w.ok -side bottom
1490
1491        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1492        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1493        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1494        bind $w <Visibility> "focus $w"
1495        wm title $w "$appname ([lindex [file split \
1496                [file normalize [file dirname $gitdir]]] \
1497                end]): [lindex $console_data($w) 0]"
1498        return $w
1499}
1500
1501proc console_exec {w cmd {after {}}} {
1502        global tcl_platform
1503
1504        # -- Windows tosses the enviroment when we exec our child.
1505        #    But most users need that so we have to relogin. :-(
1506        #
1507        if {$tcl_platform(platform) == {windows}} {
1508                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1509        }
1510
1511        # -- Tcl won't let us redirect both stdout and stderr to
1512        #    the same pipe.  So pass it through cat...
1513        #
1514        set cmd [concat | $cmd |& cat]
1515
1516        set fd_f [open $cmd r]
1517        fconfigure $fd_f -blocking 0 -translation binary
1518        fileevent $fd_f readable [list console_read $w $fd_f $after]
1519}
1520
1521proc console_read {w fd after} {
1522        global console_cr console_data
1523
1524        set buf [read $fd]
1525        if {$buf != {}} {
1526                if {![winfo exists $w]} {console_init $w}
1527                $w.m.t conf -state normal
1528                set c 0
1529                set n [string length $buf]
1530                while {$c < $n} {
1531                        set cr [string first "\r" $buf $c]
1532                        set lf [string first "\n" $buf $c]
1533                        if {$cr < 0} {set cr [expr $n + 1]}
1534                        if {$lf < 0} {set lf [expr $n + 1]}
1535
1536                        if {$lf < $cr} {
1537                                $w.m.t insert end [string range $buf $c $lf]
1538                                set console_cr($w) [$w.m.t index {end -1c}]
1539                                set c $lf
1540                                incr c
1541                        } else {
1542                                $w.m.t delete $console_cr($w) end
1543                                $w.m.t insert end "\n"
1544                                $w.m.t insert end [string range $buf $c $cr]
1545                                set c $cr
1546                                incr c
1547                        }
1548                }
1549                $w.m.t conf -state disabled
1550                $w.m.t see end
1551        }
1552
1553        fconfigure $fd -blocking 1
1554        if {[eof $fd]} {
1555                if {[catch {close $fd}]} {
1556                        if {![winfo exists $w]} {console_init $w}
1557                        $w.m.s conf -background red -text {Error: Command Failed}
1558                        $w.ok conf -text Close
1559                        $w.ok conf -state normal
1560                        set ok 0
1561                } elseif {[winfo exists $w]} {
1562                        $w.m.s conf -background green -text {Success}
1563                        $w.ok conf -text Close
1564                        $w.ok conf -state normal
1565                        set ok 1
1566                }
1567                array unset console_cr $w
1568                array unset console_data $w
1569                if {$after != {}} {
1570                        uplevel #0 $after $ok
1571                }
1572                return
1573        }
1574        fconfigure $fd -blocking 0
1575}
1576
1577######################################################################
1578##
1579## ui commands
1580
1581set starting_gitk_msg {Please wait... Starting gitk...}
1582
1583proc do_gitk {} {
1584        global tcl_platform ui_status_value starting_gitk_msg
1585
1586        set ui_status_value $starting_gitk_msg
1587        after 10000 {
1588                if {$ui_status_value == $starting_gitk_msg} {
1589                        set ui_status_value {Ready.}
1590                }
1591        }
1592
1593        if {$tcl_platform(platform) == {windows}} {
1594                exec sh -c gitk &
1595        } else {
1596                exec gitk &
1597        }
1598}
1599
1600proc do_repack {} {
1601        set w [new_console "repack" "Repacking the object database"]
1602        set cmd [list git repack]
1603        lappend cmd -a
1604        lappend cmd -d
1605        console_exec $w $cmd
1606}
1607
1608set is_quitting 0
1609
1610proc do_quit {} {
1611        global gitdir ui_comm is_quitting repo_config
1612
1613        if {$is_quitting} return
1614        set is_quitting 1
1615
1616        # -- Stash our current commit buffer.
1617        #
1618        set save [file join $gitdir GITGUI_MSG]
1619        set msg [string trim [$ui_comm get 0.0 end]]
1620        if {[$ui_comm edit modified] && $msg != {}} {
1621                catch {
1622                        set fd [open $save w]
1623                        puts $fd [string trim [$ui_comm get 0.0 end]]
1624                        close $fd
1625                }
1626        } elseif {$msg == {} && [file exists $save]} {
1627                file delete $save
1628        }
1629
1630        # -- Stash our current window geometry into this repository.
1631        #
1632        set cfg_geometry [list]
1633        lappend cfg_geometry [wm geometry .]
1634        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1635        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1636        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1637                set rc_geometry {}
1638        }
1639        if {$cfg_geometry != $rc_geometry} {
1640                catch {exec git repo-config gui.geometry $cfg_geometry}
1641        }
1642
1643        destroy .
1644}
1645
1646proc do_rescan {} {
1647        update_status
1648}
1649
1650proc do_include_all {} {
1651        global file_states
1652
1653        if {![lock_index begin-update]} return
1654
1655        set pathList [list]
1656        foreach path [array names file_states] {
1657                set s $file_states($path)
1658                set m [lindex $s 0]
1659                switch -- $m {
1660                AM -
1661                MM -
1662                _M -
1663                _D {lappend pathList $path}
1664                }
1665        }
1666        if {$pathList == {}} {
1667                unlock_index
1668        } else {
1669                update_index $pathList
1670        }
1671}
1672
1673set GIT_COMMITTER_IDENT {}
1674
1675proc do_signoff {} {
1676        global ui_comm GIT_COMMITTER_IDENT
1677
1678        if {$GIT_COMMITTER_IDENT == {}} {
1679                if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1680                        error_popup "Unable to obtain your identity:\n\n$err"
1681                        return
1682                }
1683                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1684                        $me me GIT_COMMITTER_IDENT]} {
1685                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1686                        return
1687                }
1688        }
1689
1690        set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1691        set last [$ui_comm get {end -1c linestart} {end -1c}]
1692        if {$last != $sob} {
1693                $ui_comm edit separator
1694                if {$last != {}
1695                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1696                        $ui_comm insert end "\n"
1697                }
1698                $ui_comm insert end "\n$sob"
1699                $ui_comm edit separator
1700                $ui_comm see end
1701        }
1702}
1703
1704proc do_amend_last {} {
1705        load_last_commit
1706}
1707
1708proc do_commit {} {
1709        commit_tree
1710}
1711
1712proc do_options {} {
1713        global appname gitdir font_descs
1714        global repo_config global_config
1715        global repo_config_new global_config_new
1716
1717        load_config 1
1718        array unset repo_config_new
1719        array unset global_config_new
1720        foreach name [array names repo_config] {
1721                set repo_config_new($name) $repo_config($name)
1722        }
1723        foreach name [array names global_config] {
1724                set global_config_new($name) $global_config($name)
1725        }
1726        set reponame [lindex [file split \
1727                [file normalize [file dirname $gitdir]]] \
1728                end]
1729
1730        set w .options_editor
1731        toplevel $w
1732        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1733
1734        label $w.header -text "$appname Options" \
1735                -font font_uibold
1736        pack $w.header -side top -fill x
1737
1738        frame $w.buttons
1739        button $w.buttons.restore -text {Restore Defaults} \
1740                -font font_ui \
1741                -command do_restore_defaults
1742        pack $w.buttons.restore -side left
1743        button $w.buttons.save -text Save \
1744                -font font_ui \
1745                -command [list do_save_config $w]
1746        pack $w.buttons.save -side right
1747        button $w.buttons.cancel -text {Cancel} \
1748                -font font_ui \
1749                -command [list destroy $w]
1750        pack $w.buttons.cancel -side right
1751        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1752
1753        labelframe $w.repo -text "$reponame Repository" \
1754                -font font_ui \
1755                -relief raised -borderwidth 2
1756        labelframe $w.global -text {Global (All Repositories)} \
1757                -font font_ui \
1758                -relief raised -borderwidth 2
1759        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1760        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1761
1762        foreach option {
1763                {trustmtime {Trust File Modification Timestamps}}
1764                } {
1765                set name [lindex $option 0]
1766                set text [lindex $option 1]
1767                foreach f {repo global} {
1768                        checkbutton $w.$f.$name -text $text \
1769                                -variable ${f}_config_new(gui.$name) \
1770                                -onvalue true \
1771                                -offvalue false \
1772                                -font font_ui
1773                        pack $w.$f.$name -side top -anchor w
1774                }
1775        }
1776
1777        set all_fonts [lsort [font families]]
1778        foreach option $font_descs {
1779                set name [lindex $option 0]
1780                set font [lindex $option 1]
1781                set text [lindex $option 2]
1782
1783                set global_config_new(gui.$font^^family) \
1784                        [font configure $font -family]
1785                set global_config_new(gui.$font^^size) \
1786                        [font configure $font -size]
1787
1788                frame $w.global.$name
1789                label $w.global.$name.l -text "$text:" -font font_ui
1790                pack $w.global.$name.l -side left -anchor w -fill x
1791                eval tk_optionMenu $w.global.$name.family \
1792                        global_config_new(gui.$font^^family) \
1793                        $all_fonts
1794                spinbox $w.global.$name.size \
1795                        -textvariable global_config_new(gui.$font^^size) \
1796                        -from 2 -to 80 -increment 1 \
1797                        -width 3 \
1798                        -font font_ui
1799                pack $w.global.$name.size -side right -anchor e
1800                pack $w.global.$name.family -side right -anchor e
1801                pack $w.global.$name -side top -anchor w -fill x
1802        }
1803
1804        bind $w <Visibility> "grab $w; focus $w"
1805        bind $w <Key-Escape> "destroy $w"
1806        wm title $w "$appname ($reponame): Options"
1807        tkwait window $w
1808}
1809
1810proc do_restore_defaults {} {
1811        global font_descs default_config repo_config
1812        global repo_config_new global_config_new
1813
1814        foreach name [array names default_config] {
1815                set repo_config_new($name) $default_config($name)
1816                set global_config_new($name) $default_config($name)
1817        }
1818
1819        foreach option $font_descs {
1820                set name [lindex $option 0]
1821                set repo_config(gui.$name) $default_config(gui.$name)
1822        }
1823        apply_config
1824
1825        foreach option $font_descs {
1826                set name [lindex $option 0]
1827                set font [lindex $option 1]
1828                set global_config_new(gui.$font^^family) \
1829                        [font configure $font -family]
1830                set global_config_new(gui.$font^^size) \
1831                        [font configure $font -size]
1832        }
1833}
1834
1835proc do_save_config {w} {
1836        if {[catch {save_config} err]} {
1837                error_popup "Failed to completely save options:\n\n$err"
1838        }
1839        destroy $w
1840}
1841
1842# shift == 1: left click
1843#          3: right click  
1844proc click {w x y shift wx wy} {
1845        global ui_index ui_other file_lists
1846
1847        set pos [split [$w index @$x,$y] .]
1848        set lno [lindex $pos 0]
1849        set col [lindex $pos 1]
1850        set path [lindex $file_lists($w) [expr $lno - 1]]
1851        if {$path == {}} return
1852
1853        if {$col > 0 && $shift == 1} {
1854                show_diff $path $w $lno
1855        }
1856}
1857
1858proc unclick {w x y} {
1859        global file_lists
1860
1861        set pos [split [$w index @$x,$y] .]
1862        set lno [lindex $pos 0]
1863        set col [lindex $pos 1]
1864        set path [lindex $file_lists($w) [expr $lno - 1]]
1865        if {$path == {}} return
1866
1867        if {$col == 0} {
1868                update_index [list $path]
1869        }
1870}
1871
1872######################################################################
1873##
1874## config defaults
1875
1876set cursor_ptr arrow
1877font create font_diff -family Courier -size 10
1878font create font_ui
1879catch {
1880        label .dummy
1881        eval font configure font_ui [font actual [.dummy cget -font]]
1882        destroy .dummy
1883}
1884
1885font create font_uibold
1886font create font_diffbold
1887
1888set M1B M1
1889set M1T M1
1890if {$tcl_platform(platform) == {windows}} {
1891        set M1B Control
1892        set M1T Ctrl
1893} elseif {[is_MacOSX]} {
1894        set M1B M1
1895        set M1T Cmd
1896}
1897
1898proc apply_config {} {
1899        global repo_config font_descs
1900
1901        foreach option $font_descs {
1902                set name [lindex $option 0]
1903                set font [lindex $option 1]
1904                if {[catch {
1905                        foreach {cn cv} $repo_config(gui.$name) {
1906                                font configure $font $cn $cv
1907                        }
1908                        } err]} {
1909                        error_popup "Invalid font specified in gui.$name:\n\n$err"
1910                }
1911                foreach {cn cv} [font configure $font] {
1912                        font configure ${font}bold $cn $cv
1913                }
1914                font configure ${font}bold -weight bold
1915        }
1916}
1917
1918set default_config(gui.trustmtime) false
1919set default_config(gui.fontui) [font configure font_ui]
1920set default_config(gui.fontdiff) [font configure font_diff]
1921set font_descs {
1922        {fontui   font_ui   {Main Font}}
1923        {fontdiff font_diff {Diff/Console Font}}
1924}
1925load_config 0
1926apply_config
1927
1928######################################################################
1929##
1930## ui construction
1931
1932# -- Menu Bar
1933menu .mbar -tearoff 0
1934.mbar add cascade -label Project -menu .mbar.project
1935.mbar add cascade -label Edit -menu .mbar.edit
1936.mbar add cascade -label Commit -menu .mbar.commit
1937if {!$single_commit} {
1938        .mbar add cascade -label Fetch -menu .mbar.fetch
1939        .mbar add cascade -label Pull -menu .mbar.pull
1940        .mbar add cascade -label Push -menu .mbar.push
1941}
1942. configure -menu .mbar
1943
1944# -- Project Menu
1945menu .mbar.project
1946.mbar.project add command -label Visualize \
1947        -command do_gitk \
1948        -font font_ui
1949if {!$single_commit} {
1950        .mbar.project add command -label {Repack Database} \
1951                -command do_repack \
1952                -font font_ui
1953}
1954.mbar.project add command -label Quit \
1955        -command do_quit \
1956        -accelerator $M1T-Q \
1957        -font font_ui
1958
1959# -- Edit Menu
1960#
1961menu .mbar.edit
1962.mbar.edit add command -label Undo \
1963        -command {catch {[focus] edit undo}} \
1964        -accelerator $M1T-Z \
1965        -font font_ui
1966.mbar.edit add command -label Redo \
1967        -command {catch {[focus] edit redo}} \
1968        -accelerator $M1T-Y \
1969        -font font_ui
1970.mbar.edit add separator
1971.mbar.edit add command -label Cut \
1972        -command {catch {tk_textCut [focus]}} \
1973        -accelerator $M1T-X \
1974        -font font_ui
1975.mbar.edit add command -label Copy \
1976        -command {catch {tk_textCopy [focus]}} \
1977        -accelerator $M1T-C \
1978        -font font_ui
1979.mbar.edit add command -label Paste \
1980        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1981        -accelerator $M1T-V \
1982        -font font_ui
1983.mbar.edit add command -label Delete \
1984        -command {catch {[focus] delete sel.first sel.last}} \
1985        -accelerator Del \
1986        -font font_ui
1987.mbar.edit add separator
1988.mbar.edit add command -label {Select All} \
1989        -command {catch {[focus] tag add sel 0.0 end}} \
1990        -accelerator $M1T-A \
1991        -font font_ui
1992.mbar.edit add separator
1993.mbar.edit add command -label {Options...} \
1994        -command do_options \
1995        -font font_ui
1996
1997# -- Commit Menu
1998menu .mbar.commit
1999.mbar.commit add command -label Rescan \
2000        -command do_rescan \
2001        -accelerator F5 \
2002        -font font_ui
2003lappend disable_on_lock \
2004        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2005.mbar.commit add command -label {Amend Last Commit} \
2006        -command do_amend_last \
2007        -font font_ui
2008lappend disable_on_lock \
2009        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2010.mbar.commit add command -label {Include All Files} \
2011        -command do_include_all \
2012        -accelerator $M1T-I \
2013        -font font_ui
2014lappend disable_on_lock \
2015        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2016.mbar.commit add command -label {Sign Off} \
2017        -command do_signoff \
2018        -accelerator $M1T-S \
2019        -font font_ui
2020.mbar.commit add command -label Commit \
2021        -command do_commit \
2022        -accelerator $M1T-Return \
2023        -font font_ui
2024lappend disable_on_lock \
2025        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2026
2027if {!$single_commit} {
2028        # -- Fetch Menu
2029        menu .mbar.fetch
2030
2031        # -- Pull Menu
2032        menu .mbar.pull
2033
2034        # -- Push Menu
2035        menu .mbar.push
2036}
2037
2038# -- Main Window Layout
2039panedwindow .vpane -orient vertical
2040panedwindow .vpane.files -orient horizontal
2041.vpane add .vpane.files -sticky nsew -height 100 -width 400
2042pack .vpane -anchor n -side top -fill both -expand 1
2043
2044# -- Index File List
2045frame .vpane.files.index -height 100 -width 400
2046label .vpane.files.index.title -text {Modified Files} \
2047        -background green \
2048        -font font_ui
2049text $ui_index -background white -borderwidth 0 \
2050        -width 40 -height 10 \
2051        -font font_ui \
2052        -cursor $cursor_ptr \
2053        -yscrollcommand {.vpane.files.index.sb set} \
2054        -state disabled
2055scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2056pack .vpane.files.index.title -side top -fill x
2057pack .vpane.files.index.sb -side right -fill y
2058pack $ui_index -side left -fill both -expand 1
2059.vpane.files add .vpane.files.index -sticky nsew
2060
2061# -- Other (Add) File List
2062frame .vpane.files.other -height 100 -width 100
2063label .vpane.files.other.title -text {Untracked Files} \
2064        -background red \
2065        -font font_ui
2066text $ui_other -background white -borderwidth 0 \
2067        -width 40 -height 10 \
2068        -font font_ui \
2069        -cursor $cursor_ptr \
2070        -yscrollcommand {.vpane.files.other.sb set} \
2071        -state disabled
2072scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2073pack .vpane.files.other.title -side top -fill x
2074pack .vpane.files.other.sb -side right -fill y
2075pack $ui_other -side left -fill both -expand 1
2076.vpane.files add .vpane.files.other -sticky nsew
2077
2078$ui_index tag conf in_diff -font font_uibold
2079$ui_other tag conf in_diff -font font_uibold
2080
2081# -- Diff and Commit Area
2082frame .vpane.lower -height 300 -width 400
2083frame .vpane.lower.commarea
2084frame .vpane.lower.diff -relief sunken -borderwidth 1
2085pack .vpane.lower.commarea -side top -fill x
2086pack .vpane.lower.diff -side bottom -fill both -expand 1
2087.vpane add .vpane.lower -stick nsew
2088
2089# -- Commit Area Buttons
2090frame .vpane.lower.commarea.buttons
2091label .vpane.lower.commarea.buttons.l -text {} \
2092        -anchor w \
2093        -justify left \
2094        -font font_ui
2095pack .vpane.lower.commarea.buttons.l -side top -fill x
2096pack .vpane.lower.commarea.buttons -side left -fill y
2097
2098button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2099        -command do_rescan \
2100        -font font_ui
2101pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2102lappend disable_on_lock \
2103        {.vpane.lower.commarea.buttons.rescan conf -state}
2104
2105button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2106        -command do_amend_last \
2107        -font font_ui
2108pack .vpane.lower.commarea.buttons.amend -side top -fill x
2109lappend disable_on_lock \
2110        {.vpane.lower.commarea.buttons.amend conf -state}
2111
2112button .vpane.lower.commarea.buttons.incall -text {Include All} \
2113        -command do_include_all \
2114        -font font_ui
2115pack .vpane.lower.commarea.buttons.incall -side top -fill x
2116lappend disable_on_lock \
2117        {.vpane.lower.commarea.buttons.incall conf -state}
2118
2119button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2120        -command do_signoff \
2121        -font font_ui
2122pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2123
2124button .vpane.lower.commarea.buttons.commit -text {Commit} \
2125        -command do_commit \
2126        -font font_ui
2127pack .vpane.lower.commarea.buttons.commit -side top -fill x
2128lappend disable_on_lock \
2129        {.vpane.lower.commarea.buttons.commit conf -state}
2130
2131# -- Commit Message Buffer
2132frame .vpane.lower.commarea.buffer
2133set ui_comm .vpane.lower.commarea.buffer.t
2134set ui_coml .vpane.lower.commarea.buffer.l
2135label $ui_coml -text {Commit Message:} \
2136        -anchor w \
2137        -justify left \
2138        -font font_ui
2139trace add variable commit_type write {uplevel #0 {
2140        switch -glob $commit_type \
2141        initial {$ui_coml conf -text {Initial Commit Message:}} \
2142        amend   {$ui_coml conf -text {Amended Commit Message:}} \
2143        merge   {$ui_coml conf -text {Merge Commit Message:}} \
2144        *       {$ui_coml conf -text {Commit Message:}}
2145}}
2146text $ui_comm -background white -borderwidth 1 \
2147        -undo true \
2148        -maxundo 20 \
2149        -autoseparators true \
2150        -relief sunken \
2151        -width 75 -height 9 -wrap none \
2152        -font font_diff \
2153        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2154scrollbar .vpane.lower.commarea.buffer.sby \
2155        -command [list $ui_comm yview]
2156pack $ui_coml -side top -fill x
2157pack .vpane.lower.commarea.buffer.sby -side right -fill y
2158pack $ui_comm -side left -fill y
2159pack .vpane.lower.commarea.buffer -side left -fill y
2160
2161# -- Commit Message Buffer Context Menu
2162#
2163menu $ui_comm.ctxm -tearoff 0
2164$ui_comm.ctxm add command -label "Cut" \
2165        -font font_ui \
2166        -command "tk_textCut $ui_comm"
2167$ui_comm.ctxm add command -label "Copy" \
2168        -font font_ui \
2169        -command "tk_textCopy $ui_comm"
2170$ui_comm.ctxm add command -label "Paste" \
2171        -font font_ui \
2172        -command "tk_textPaste $ui_comm"
2173$ui_comm.ctxm add command -label "Delete" \
2174        -font font_ui \
2175        -command "$ui_comm delete sel.first sel.last"
2176$ui_comm.ctxm add separator
2177$ui_comm.ctxm add command -label "Select All" \
2178        -font font_ui \
2179        -command "$ui_comm tag add sel 0.0 end"
2180$ui_comm.ctxm add command -label "Copy All" \
2181        -font font_ui \
2182        -command "
2183                $ui_comm tag add sel 0.0 end
2184                tk_textCopy $ui_comm
2185                $ui_comm tag remove sel 0.0 end
2186        "
2187$ui_comm.ctxm add separator
2188$ui_comm.ctxm add command -label "Sign Off" \
2189        -font font_ui \
2190        -command do_signoff
2191bind_button3 $ui_comm "tk_popup $ui_comm.ctxm %X %Y"
2192
2193# -- Diff Header
2194set ui_fname_value {}
2195set ui_fstatus_value {}
2196frame .vpane.lower.diff.header -background orange
2197label .vpane.lower.diff.header.l1 -text {File:} \
2198        -background orange \
2199        -font font_ui
2200label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
2201        -background orange \
2202        -anchor w \
2203        -justify left \
2204        -font font_ui
2205label .vpane.lower.diff.header.l3 -text {Status:} \
2206        -background orange \
2207        -font font_ui
2208label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
2209        -background orange \
2210        -width $max_status_desc \
2211        -anchor w \
2212        -justify left \
2213        -font font_ui
2214pack .vpane.lower.diff.header.l1 -side left
2215pack .vpane.lower.diff.header.l2 -side left -fill x
2216pack .vpane.lower.diff.header.l4 -side right
2217pack .vpane.lower.diff.header.l3 -side right
2218
2219# -- Diff Body
2220frame .vpane.lower.diff.body
2221set ui_diff .vpane.lower.diff.body.t
2222text $ui_diff -background white -borderwidth 0 \
2223        -width 80 -height 15 -wrap none \
2224        -font font_diff \
2225        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2226        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2227        -state disabled
2228scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2229        -command [list $ui_diff xview]
2230scrollbar .vpane.lower.diff.body.sby -orient vertical \
2231        -command [list $ui_diff yview]
2232pack .vpane.lower.diff.body.sbx -side bottom -fill x
2233pack .vpane.lower.diff.body.sby -side right -fill y
2234pack $ui_diff -side left -fill both -expand 1
2235pack .vpane.lower.diff.header -side top -fill x
2236pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2237
2238$ui_diff tag conf dm -foreground red
2239$ui_diff tag conf dp -foreground blue
2240$ui_diff tag conf di -foreground {#00a000}
2241$ui_diff tag conf dni -foreground {#a000a0}
2242$ui_diff tag conf da -font font_diffbold
2243$ui_diff tag conf bold -font font_diffbold
2244
2245# -- Diff Body Context Menu
2246#
2247menu $ui_diff.ctxm -tearoff 0
2248$ui_diff.ctxm add command -label "Copy" \
2249        -font font_ui \
2250        -command "tk_textCopy $ui_diff"
2251$ui_diff.ctxm add command -label "Select All" \
2252        -font font_ui \
2253        -command "$ui_diff tag add sel 0.0 end"
2254$ui_diff.ctxm add command -label "Copy All" \
2255        -font font_ui \
2256        -command "
2257                $ui_diff tag add sel 0.0 end
2258                tk_textCopy $ui_diff
2259                $ui_diff tag remove sel 0.0 end
2260        "
2261$ui_diff.ctxm add separator
2262$ui_diff.ctxm add command -label "Decrease Font Size" \
2263        -font font_ui \
2264        -command {incr_font_size font_diff -1}
2265$ui_diff.ctxm add command -label "Increase Font Size" \
2266        -font font_ui \
2267        -command {incr_font_size font_diff 1}
2268$ui_diff.ctxm add command -label {Options...} \
2269        -font font_ui \
2270        -command do_options
2271bind_button3 $ui_diff "tk_popup $ui_diff.ctxm %X %Y"
2272
2273# -- Status Bar
2274set ui_status_value {Initializing...}
2275label .status -textvariable ui_status_value \
2276        -anchor w \
2277        -justify left \
2278        -borderwidth 1 \
2279        -relief sunken \
2280        -font font_ui
2281pack .status -anchor w -side bottom -fill x
2282
2283# -- Load geometry
2284catch {
2285set gm $repo_config(gui.geometry)
2286wm geometry . [lindex $gm 0]
2287.vpane sash place 0 \
2288        [lindex [.vpane sash coord 0] 0] \
2289        [lindex $gm 1]
2290.vpane.files sash place 0 \
2291        [lindex $gm 2] \
2292        [lindex [.vpane.files sash coord 0] 1]
2293unset gm
2294}
2295
2296# -- Key Bindings
2297bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2298bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2299bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2300bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2301bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2302bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2303bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2304bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2305bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2306bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2307bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2308
2309bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2310bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2311bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2312bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2313bind $ui_diff <$M1B-Key-v> {break}
2314bind $ui_diff <$M1B-Key-V> {break}
2315bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2316bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2317bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2318bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2319bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2320bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2321
2322bind .   <Destroy> do_quit
2323bind all <Key-F5> do_rescan
2324bind all <$M1B-Key-r> do_rescan
2325bind all <$M1B-Key-R> do_rescan
2326bind .   <$M1B-Key-s> do_signoff
2327bind .   <$M1B-Key-S> do_signoff
2328bind .   <$M1B-Key-i> do_include_all
2329bind .   <$M1B-Key-I> do_include_all
2330bind .   <$M1B-Key-Return> do_commit
2331bind all <$M1B-Key-q> do_quit
2332bind all <$M1B-Key-Q> do_quit
2333bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2334bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2335foreach i [list $ui_index $ui_other] {
2336        bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
2337        bind $i <ButtonRelease-1> {unclick %W %x %y; break}
2338        bind_button3 $i {click %W %x %y 3 %X %Y; break}
2339}
2340unset i
2341
2342set file_lists($ui_index) [list]
2343set file_lists($ui_other) [list]
2344
2345wm title . "$appname ([file normalize [file dirname $gitdir]])"
2346focus -force $ui_comm
2347if {!$single_commit} {
2348        load_all_remotes
2349        populate_remote_menu .mbar.fetch From fetch_from
2350        populate_remote_menu .mbar.push To push_to
2351        populate_pull_menu .mbar.pull
2352}
2353after 1 update_status