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