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