Andrew's git / gitweb.git / git-gui
?
git-guion commit git-gui: Improve pull error dialogs. (4c2035d)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5set copyright {
   6Copyright © 2006 Shawn Pearce, Paul Mackerras.
   7
   8All rights reserved.
   9
  10This program is free software; it may be used, copied, modified
  11and distributed under the terms of the GNU General Public Licence,
  12either version 2, or (at your option) any later version.}
  13
  14set appname [lindex [file split $argv0] end]
  15set gitdir {}
  16
  17######################################################################
  18##
  19## config
  20
  21proc is_many_config {name} {
  22        switch -glob -- $name {
  23        remote.*.fetch -
  24        remote.*.push
  25                {return 1}
  26        *
  27                {return 0}
  28        }
  29}
  30
  31proc load_config {include_global} {
  32        global repo_config global_config default_config
  33
  34        array unset global_config
  35        if {$include_global} {
  36                catch {
  37                        set fd_rc [open "| git repo-config --global --list" r]
  38                        while {[gets $fd_rc line] >= 0} {
  39                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  40                                        if {[is_many_config $name]} {
  41                                                lappend global_config($name) $value
  42                                        } else {
  43                                                set global_config($name) $value
  44                                        }
  45                                }
  46                        }
  47                        close $fd_rc
  48                }
  49        }
  50
  51        array unset repo_config
  52        catch {
  53                set fd_rc [open "| git repo-config --list" r]
  54                while {[gets $fd_rc line] >= 0} {
  55                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  56                                if {[is_many_config $name]} {
  57                                        lappend repo_config($name) $value
  58                                } else {
  59                                        set repo_config($name) $value
  60                                }
  61                        }
  62                }
  63                close $fd_rc
  64        }
  65
  66        foreach name [array names default_config] {
  67                if {[catch {set v $global_config($name)}]} {
  68                        set global_config($name) $default_config($name)
  69                }
  70                if {[catch {set v $repo_config($name)}]} {
  71                        set repo_config($name) $default_config($name)
  72                }
  73        }
  74}
  75
  76proc save_config {} {
  77        global default_config font_descs
  78        global repo_config global_config
  79        global repo_config_new global_config_new
  80
  81        foreach option $font_descs {
  82                set name [lindex $option 0]
  83                set font [lindex $option 1]
  84                font configure $font \
  85                        -family $global_config_new(gui.$font^^family) \
  86                        -size $global_config_new(gui.$font^^size)
  87                font configure ${font}bold \
  88                        -family $global_config_new(gui.$font^^family) \
  89                        -size $global_config_new(gui.$font^^size)
  90                set global_config_new(gui.$name) [font configure $font]
  91                unset global_config_new(gui.$font^^family)
  92                unset global_config_new(gui.$font^^size)
  93        }
  94
  95        foreach name [array names default_config] {
  96                set value $global_config_new($name)
  97                if {$value ne $global_config($name)} {
  98                        if {$value eq $default_config($name)} {
  99                                catch {exec git repo-config --global --unset $name}
 100                        } else {
 101                                regsub -all "\[{}\]" $value {"} value
 102                                exec git repo-config --global $name $value
 103                        }
 104                        set global_config($name) $value
 105                        if {$value eq $repo_config($name)} {
 106                                catch {exec git repo-config --unset $name}
 107                                set repo_config($name) $value
 108                        }
 109                }
 110        }
 111
 112        foreach name [array names default_config] {
 113                set value $repo_config_new($name)
 114                if {$value ne $repo_config($name)} {
 115                        if {$value eq $global_config($name)} {
 116                                catch {exec git repo-config --unset $name}
 117                        } else {
 118                                regsub -all "\[{}\]" $value {"} value
 119                                exec git repo-config $name $value
 120                        }
 121                        set repo_config($name) $value
 122                }
 123        }
 124}
 125
 126proc error_popup {msg} {
 127        global gitdir appname
 128
 129        set title $appname
 130        if {$gitdir ne {}} {
 131                append title { (}
 132                append title [lindex \
 133                        [file split [file normalize [file dirname $gitdir]]] \
 134                        end]
 135                append title {)}
 136        }
 137        set cmd [list tk_messageBox \
 138                -icon error \
 139                -type ok \
 140                -title "$title: error" \
 141                -message $msg]
 142        if {[winfo ismapped .]} {
 143                lappend cmd -parent .
 144        }
 145        eval $cmd
 146}
 147
 148proc warn_popup {msg} {
 149        global gitdir appname
 150
 151        set title $appname
 152        if {$gitdir ne {}} {
 153                append title { (}
 154                append title [lindex \
 155                        [file split [file normalize [file dirname $gitdir]]] \
 156                        end]
 157                append title {)}
 158        }
 159        set cmd [list tk_messageBox \
 160                -icon warning \
 161                -type ok \
 162                -title "$title: warning" \
 163                -message $msg]
 164        if {[winfo ismapped .]} {
 165                lappend cmd -parent .
 166        }
 167        eval $cmd
 168}
 169
 170proc info_popup {msg} {
 171        global gitdir appname
 172
 173        set title $appname
 174        if {$gitdir ne {}} {
 175                append title { (}
 176                append title [lindex \
 177                        [file split [file normalize [file dirname $gitdir]]] \
 178                        end]
 179                append title {)}
 180        }
 181        tk_messageBox \
 182                -parent . \
 183                -icon info \
 184                -type ok \
 185                -title $title \
 186                -message $msg
 187}
 188
 189######################################################################
 190##
 191## repository setup
 192
 193if {   [catch {set gitdir $env(GIT_DIR)}]
 194        && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
 195        catch {wm withdraw .}
 196        error_popup "Cannot find the git directory:\n\n$err"
 197        exit 1
 198}
 199if {![file isdirectory $gitdir]} {
 200        catch {wm withdraw .}
 201        error_popup "Git directory not found:\n\n$gitdir"
 202        exit 1
 203}
 204if {[lindex [file split $gitdir] end] ne {.git}} {
 205        catch {wm withdraw .}
 206        error_popup "Cannot use funny .git directory:\n\n$gitdir"
 207        exit 1
 208}
 209if {[catch {cd [file dirname $gitdir]} err]} {
 210        catch {wm withdraw .}
 211        error_popup "No working directory [file dirname $gitdir]:\n\n$err"
 212        exit 1
 213}
 214
 215set single_commit 0
 216if {$appname eq {git-citool}} {
 217        set single_commit 1
 218}
 219
 220######################################################################
 221##
 222## task management
 223
 224set rescan_active 0
 225set diff_active 0
 226set last_clicked {}
 227
 228set disable_on_lock [list]
 229set index_lock_type none
 230
 231proc lock_index {type} {
 232        global index_lock_type disable_on_lock
 233
 234        if {$index_lock_type eq {none}} {
 235                set index_lock_type $type
 236                foreach w $disable_on_lock {
 237                        uplevel #0 $w disabled
 238                }
 239                return 1
 240        } elseif {$index_lock_type eq "begin-$type"} {
 241                set index_lock_type $type
 242                return 1
 243        }
 244        return 0
 245}
 246
 247proc unlock_index {} {
 248        global index_lock_type disable_on_lock
 249
 250        set index_lock_type none
 251        foreach w $disable_on_lock {
 252                uplevel #0 $w normal
 253        }
 254}
 255
 256######################################################################
 257##
 258## status
 259
 260proc repository_state {ctvar hdvar mhvar} {
 261        global gitdir
 262        upvar $ctvar ct $hdvar hd $mhvar mh
 263
 264        set mh [list]
 265
 266        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 267                set hd {}
 268                set ct initial
 269                return
 270        }
 271
 272        set merge_head [file join $gitdir MERGE_HEAD]
 273        if {[file exists $merge_head]} {
 274                set ct merge
 275                set fd_mh [open $merge_head r]
 276                while {[gets $fd_mh line] >= 0} {
 277                        lappend mh $line
 278                }
 279                close $fd_mh
 280                return
 281        }
 282
 283        set ct normal
 284}
 285
 286proc PARENT {} {
 287        global PARENT empty_tree
 288
 289        set p [lindex $PARENT 0]
 290        if {$p ne {}} {
 291                return $p
 292        }
 293        if {$empty_tree eq {}} {
 294                set empty_tree [exec git mktree << {}]
 295        }
 296        return $empty_tree
 297}
 298
 299proc rescan {after} {
 300        global HEAD PARENT MERGE_HEAD commit_type
 301        global ui_index ui_other ui_status_value ui_comm
 302        global rescan_active file_states
 303        global repo_config
 304
 305        if {$rescan_active > 0 || ![lock_index read]} return
 306
 307        repository_state newType newHEAD newMERGE_HEAD
 308        if {[string match amend* $commit_type]
 309                && $newType eq {normal}
 310                && $newHEAD eq $HEAD} {
 311        } else {
 312                set HEAD $newHEAD
 313                set PARENT $newHEAD
 314                set MERGE_HEAD $newMERGE_HEAD
 315                set commit_type $newType
 316        }
 317
 318        array unset file_states
 319
 320        if {![$ui_comm edit modified]
 321                || [string trim [$ui_comm get 0.0 end]] eq {}} {
 322                if {[load_message GITGUI_MSG]} {
 323                } elseif {[load_message MERGE_MSG]} {
 324                } elseif {[load_message SQUASH_MSG]} {
 325                }
 326                $ui_comm edit reset
 327                $ui_comm edit modified false
 328        }
 329
 330        if {$repo_config(gui.trustmtime) eq {true}} {
 331                rescan_stage2 {} $after
 332        } else {
 333                set rescan_active 1
 334                set ui_status_value {Refreshing file status...}
 335                set cmd [list git update-index]
 336                lappend cmd -q
 337                lappend cmd --unmerged
 338                lappend cmd --ignore-missing
 339                lappend cmd --refresh
 340                set fd_rf [open "| $cmd" r]
 341                fconfigure $fd_rf -blocking 0 -translation binary
 342                fileevent $fd_rf readable \
 343                        [list rescan_stage2 $fd_rf $after]
 344        }
 345}
 346
 347proc rescan_stage2 {fd after} {
 348        global gitdir ui_status_value
 349        global rescan_active buf_rdi buf_rdf buf_rlo
 350
 351        if {$fd ne {}} {
 352                read $fd
 353                if {![eof $fd]} return
 354                close $fd
 355        }
 356
 357        set ls_others [list | git ls-files --others -z \
 358                --exclude-per-directory=.gitignore]
 359        set info_exclude [file join $gitdir info exclude]
 360        if {[file readable $info_exclude]} {
 361                lappend ls_others "--exclude-from=$info_exclude"
 362        }
 363
 364        set buf_rdi {}
 365        set buf_rdf {}
 366        set buf_rlo {}
 367
 368        set rescan_active 3
 369        set ui_status_value {Scanning for modified files ...}
 370        set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 371        set fd_df [open "| git diff-files -z" r]
 372        set fd_lo [open $ls_others r]
 373
 374        fconfigure $fd_di -blocking 0 -translation binary
 375        fconfigure $fd_df -blocking 0 -translation binary
 376        fconfigure $fd_lo -blocking 0 -translation binary
 377        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 378        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 379        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 380}
 381
 382proc load_message {file} {
 383        global gitdir ui_comm
 384
 385        set f [file join $gitdir $file]
 386        if {[file isfile $f]} {
 387                if {[catch {set fd [open $f r]}]} {
 388                        return 0
 389                }
 390                set content [string trim [read $fd]]
 391                close $fd
 392                $ui_comm delete 0.0 end
 393                $ui_comm insert end $content
 394                return 1
 395        }
 396        return 0
 397}
 398
 399proc read_diff_index {fd after} {
 400        global buf_rdi
 401
 402        append buf_rdi [read $fd]
 403        set c 0
 404        set n [string length $buf_rdi]
 405        while {$c < $n} {
 406                set z1 [string first "\0" $buf_rdi $c]
 407                if {$z1 == -1} break
 408                incr z1
 409                set z2 [string first "\0" $buf_rdi $z1]
 410                if {$z2 == -1} break
 411
 412                incr c
 413                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 414                merge_state \
 415                        [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
 416                        [lindex $i 4]? \
 417                        [list [lindex $i 0] [lindex $i 2]] \
 418                        [list]
 419                set c $z2
 420                incr c
 421        }
 422        if {$c < $n} {
 423                set buf_rdi [string range $buf_rdi $c end]
 424        } else {
 425                set buf_rdi {}
 426        }
 427
 428        rescan_done $fd buf_rdi $after
 429}
 430
 431proc read_diff_files {fd after} {
 432        global buf_rdf
 433
 434        append buf_rdf [read $fd]
 435        set c 0
 436        set n [string length $buf_rdf]
 437        while {$c < $n} {
 438                set z1 [string first "\0" $buf_rdf $c]
 439                if {$z1 == -1} break
 440                incr z1
 441                set z2 [string first "\0" $buf_rdf $z1]
 442                if {$z2 == -1} break
 443
 444                incr c
 445                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 446                merge_state \
 447                        [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
 448                        ?[lindex $i 4] \
 449                        [list] \
 450                        [list [lindex $i 0] [lindex $i 2]]
 451                set c $z2
 452                incr c
 453        }
 454        if {$c < $n} {
 455                set buf_rdf [string range $buf_rdf $c end]
 456        } else {
 457                set buf_rdf {}
 458        }
 459
 460        rescan_done $fd buf_rdf $after
 461}
 462
 463proc read_ls_others {fd after} {
 464        global buf_rlo
 465
 466        append buf_rlo [read $fd]
 467        set pck [split $buf_rlo "\0"]
 468        set buf_rlo [lindex $pck end]
 469        foreach p [lrange $pck 0 end-1] {
 470                merge_state $p ?O
 471        }
 472        rescan_done $fd buf_rlo $after
 473}
 474
 475proc rescan_done {fd buf after} {
 476        global rescan_active
 477        global file_states repo_config
 478        upvar $buf to_clear
 479
 480        if {![eof $fd]} return
 481        set to_clear {}
 482        close $fd
 483        if {[incr rescan_active -1] > 0} return
 484
 485        prune_selection
 486        unlock_index
 487        display_all_files
 488
 489        if {$repo_config(gui.partialinclude) ne {true}} {
 490                set pathList [list]
 491                foreach path [array names file_states] {
 492                        switch -- [lindex $file_states($path) 0] {
 493                        AM -
 494                        MM {lappend pathList $path}
 495                        }
 496                }
 497                if {$pathList ne {}} {
 498                        update_index \
 499                                "Updating included files" \
 500                                $pathList \
 501                                [concat {reshow_diff;} $after]
 502                        return
 503                }
 504        }
 505
 506        reshow_diff
 507        uplevel #0 $after
 508}
 509
 510proc prune_selection {} {
 511        global file_states selected_paths
 512
 513        foreach path [array names selected_paths] {
 514                if {[catch {set still_here $file_states($path)}]} {
 515                        unset selected_paths($path)
 516                }
 517        }
 518}
 519
 520######################################################################
 521##
 522## diff
 523
 524proc clear_diff {} {
 525        global ui_diff current_diff ui_index ui_other
 526
 527        $ui_diff conf -state normal
 528        $ui_diff delete 0.0 end
 529        $ui_diff conf -state disabled
 530
 531        set current_diff {}
 532
 533        $ui_index tag remove in_diff 0.0 end
 534        $ui_other tag remove in_diff 0.0 end
 535}
 536
 537proc reshow_diff {} {
 538        global current_diff ui_status_value file_states
 539
 540        if {$current_diff eq {}
 541                || [catch {set s $file_states($current_diff)}]} {
 542                clear_diff
 543        } else {
 544                show_diff $current_diff
 545        }
 546}
 547
 548proc handle_empty_diff {} {
 549        global current_diff file_states file_lists
 550
 551        set path $current_diff
 552        set s $file_states($path)
 553        if {[lindex $s 0] ne {_M}} return
 554
 555        info_popup "No differences detected.
 556
 557[short_path $path] has no changes.
 558
 559The modification date of this file was updated
 560by another application and you currently have
 561the Trust File Modification Timestamps option
 562enabled, so Git did not automatically detect
 563that there are no content differences in this
 564file.
 565
 566This file will now be removed from the modified
 567files list, to prevent possible confusion.
 568"
 569        if {[catch {exec git update-index -- $path} err]} {
 570                error_popup "Failed to refresh index:\n\n$err"
 571        }
 572
 573        clear_diff
 574        set old_w [mapcol [lindex $file_states($path) 0] $path]
 575        set lno [lsearch -sorted $file_lists($old_w) $path]
 576        if {$lno >= 0} {
 577                set file_lists($old_w) \
 578                        [lreplace $file_lists($old_w) $lno $lno]
 579                incr lno
 580                $old_w conf -state normal
 581                $old_w delete $lno.0 [expr {$lno + 1}].0
 582                $old_w conf -state disabled
 583        }
 584}
 585
 586proc show_diff {path {w {}} {lno {}}} {
 587        global file_states file_lists
 588        global is_3way_diff diff_active repo_config
 589        global ui_diff current_diff ui_status_value
 590
 591        if {$diff_active || ![lock_index read]} return
 592
 593        clear_diff
 594        if {$w eq {} || $lno == {}} {
 595                foreach w [array names file_lists] {
 596                        set lno [lsearch -sorted $file_lists($w) $path]
 597                        if {$lno >= 0} {
 598                                incr lno
 599                                break
 600                        }
 601                }
 602        }
 603        if {$w ne {} && $lno >= 1} {
 604                $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 605        }
 606
 607        set s $file_states($path)
 608        set m [lindex $s 0]
 609        set is_3way_diff 0
 610        set diff_active 1
 611        set current_diff $path
 612        set ui_status_value "Loading diff of [escape_path $path]..."
 613
 614        set cmd [list | git diff-index]
 615        lappend cmd --no-color
 616        if {$repo_config(gui.diffcontext) > 0} {
 617                lappend cmd "-U$repo_config(gui.diffcontext)"
 618        }
 619        lappend cmd -p
 620
 621        switch $m {
 622        MM {
 623                lappend cmd -c
 624        }
 625        _O {
 626                if {[catch {
 627                                set fd [open $path r]
 628                                set content [read $fd]
 629                                close $fd
 630                        } err ]} {
 631                        set diff_active 0
 632                        unlock_index
 633                        set ui_status_value "Unable to display [escape_path $path]"
 634                        error_popup "Error loading file:\n\n$err"
 635                        return
 636                }
 637                $ui_diff conf -state normal
 638                $ui_diff insert end $content
 639                $ui_diff conf -state disabled
 640                set diff_active 0
 641                unlock_index
 642                set ui_status_value {Ready.}
 643                return
 644        }
 645        }
 646
 647        lappend cmd [PARENT]
 648        lappend cmd --
 649        lappend cmd $path
 650
 651        if {[catch {set fd [open $cmd r]} err]} {
 652                set diff_active 0
 653                unlock_index
 654                set ui_status_value "Unable to display [escape_path $path]"
 655                error_popup "Error loading diff:\n\n$err"
 656                return
 657        }
 658
 659        fconfigure $fd -blocking 0 -translation auto
 660        fileevent $fd readable [list read_diff $fd]
 661}
 662
 663proc read_diff {fd} {
 664        global ui_diff ui_status_value is_3way_diff diff_active
 665        global repo_config
 666
 667        $ui_diff conf -state normal
 668        while {[gets $fd line] >= 0} {
 669                # -- Cleanup uninteresting diff header lines.
 670                #
 671                if {[string match {diff --git *}      $line]} continue
 672                if {[string match {diff --combined *} $line]} continue
 673                if {[string match {--- *}             $line]} continue
 674                if {[string match {+++ *}             $line]} continue
 675                if {$line eq {deleted file mode 120000}} {
 676                        set line "deleted symlink"
 677                }
 678
 679                # -- Automatically detect if this is a 3 way diff.
 680                #
 681                if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 682
 683                # -- Reformat a 3 way diff, 'cause its too weird.
 684                #
 685                if {$is_3way_diff} {
 686                        set op [string range $line 0 1]
 687                        switch -- $op {
 688                        {@@} {set tags d_@}
 689                        {++} {set tags d_+ ; set op { +}}
 690                        {--} {set tags d_- ; set op { -}}
 691                        { +} {set tags d_++; set op {++}}
 692                        { -} {set tags d_--; set op {--}}
 693                        {+ } {set tags d_-+; set op {-+}}
 694                        {- } {set tags d_+-; set op {+-}}
 695                        default {set tags {}}
 696                        }
 697                        set line [string replace $line 0 1 $op]
 698                } else {
 699                        switch -- [string index $line 0] {
 700                        @ {set tags d_@}
 701                        + {set tags d_+}
 702                        - {set tags d_-}
 703                        default {set tags {}}
 704                        }
 705                }
 706                $ui_diff insert end $line $tags
 707                $ui_diff insert end "\n" $tags
 708        }
 709        $ui_diff conf -state disabled
 710
 711        if {[eof $fd]} {
 712                close $fd
 713                set diff_active 0
 714                unlock_index
 715                set ui_status_value {Ready.}
 716
 717                if {$repo_config(gui.trustmtime) eq {true}
 718                        && [$ui_diff index end] eq {2.0}} {
 719                        handle_empty_diff
 720                }
 721        }
 722}
 723
 724######################################################################
 725##
 726## commit
 727
 728proc load_last_commit {} {
 729        global HEAD PARENT MERGE_HEAD commit_type ui_comm
 730
 731        if {[llength $PARENT] == 0} {
 732                error_popup {There is nothing to amend.
 733
 734You are about to create the initial commit.
 735There is no commit before this to amend.
 736}
 737                return
 738        }
 739
 740        repository_state curType curHEAD curMERGE_HEAD
 741        if {$curType eq {merge}} {
 742                error_popup {Cannot amend while merging.
 743
 744You are currently in the middle of a merge that
 745has not been fully completed.  You cannot amend
 746the prior commit unless you first abort the
 747current merge activity.
 748}
 749                return
 750        }
 751
 752        set msg {}
 753        set parents [list]
 754        if {[catch {
 755                        set fd [open "| git cat-file commit $curHEAD" r]
 756                        while {[gets $fd line] > 0} {
 757                                if {[string match {parent *} $line]} {
 758                                        lappend parents [string range $line 7 end]
 759                                }
 760                        }
 761                        set msg [string trim [read $fd]]
 762                        close $fd
 763                } err]} {
 764                error_popup "Error loading commit data for amend:\n\n$err"
 765                return
 766        }
 767
 768        set HEAD $curHEAD
 769        set PARENT $parents
 770        set MERGE_HEAD [list]
 771        switch -- [llength $parents] {
 772        0       {set commit_type amend-initial}
 773        1       {set commit_type amend}
 774        default {set commit_type amend-merge}
 775        }
 776
 777        $ui_comm delete 0.0 end
 778        $ui_comm insert end $msg
 779        $ui_comm edit reset
 780        $ui_comm edit modified false
 781        rescan {set ui_status_value {Ready.}}
 782}
 783
 784proc create_new_commit {} {
 785        global commit_type ui_comm
 786
 787        set commit_type normal
 788        $ui_comm delete 0.0 end
 789        $ui_comm edit reset
 790        $ui_comm edit modified false
 791        rescan {set ui_status_value {Ready.}}
 792}
 793
 794set GIT_COMMITTER_IDENT {}
 795
 796proc committer_ident {} {
 797        global GIT_COMMITTER_IDENT
 798
 799        if {$GIT_COMMITTER_IDENT eq {}} {
 800                if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
 801                        error_popup "Unable to obtain your identity:\n\n$err"
 802                        return {}
 803                }
 804                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 805                        $me me GIT_COMMITTER_IDENT]} {
 806                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
 807                        return {}
 808                }
 809        }
 810
 811        return $GIT_COMMITTER_IDENT
 812}
 813
 814proc commit_tree {} {
 815        global HEAD commit_type file_states ui_comm repo_config
 816
 817        if {![lock_index update]} return
 818        if {[committer_ident] eq {}} return
 819
 820        # -- Our in memory state should match the repository.
 821        #
 822        repository_state curType curHEAD curMERGE_HEAD
 823        if {[string match amend* $commit_type]
 824                && $curType eq {normal}
 825                && $curHEAD eq $HEAD} {
 826        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
 827                info_popup {Last scanned state does not match repository state.
 828
 829Another Git program has modified this repository
 830since the last scan.  A rescan must be performed
 831before another commit can be created.
 832
 833The rescan will be automatically started now.
 834}
 835                unlock_index
 836                rescan {set ui_status_value {Ready.}}
 837                return
 838        }
 839
 840        # -- At least one file should differ in the index.
 841        #
 842        set files_ready 0
 843        foreach path [array names file_states] {
 844                switch -glob -- [lindex $file_states($path) 0] {
 845                _? {continue}
 846                A? -
 847                D? -
 848                M? {set files_ready 1; break}
 849                U? {
 850                        error_popup "Unmerged files cannot be committed.
 851
 852File [short_path $path] has merge conflicts.
 853You must resolve them and include the file before committing.
 854"
 855                        unlock_index
 856                        return
 857                }
 858                default {
 859                        error_popup "Unknown file state [lindex $s 0] detected.
 860
 861File [short_path $path] cannot be committed by this program.
 862"
 863                }
 864                }
 865        }
 866        if {!$files_ready} {
 867                error_popup {No included files to commit.
 868
 869You must include at least 1 file before you can commit.
 870}
 871                unlock_index
 872                return
 873        }
 874
 875        # -- A message is required.
 876        #
 877        set msg [string trim [$ui_comm get 1.0 end]]
 878        if {$msg eq {}} {
 879                error_popup {Please supply a commit message.
 880
 881A good commit message has the following format:
 882
 883- First line: Describe in one sentance what you did.
 884- Second line: Blank
 885- Remaining lines: Describe why this change is good.
 886}
 887                unlock_index
 888                return
 889        }
 890
 891        # -- Update included files if partialincludes are off.
 892        #
 893        if {$repo_config(gui.partialinclude) ne {true}} {
 894                set pathList [list]
 895                foreach path [array names file_states] {
 896                        switch -glob -- [lindex $file_states($path) 0] {
 897                        A? -
 898                        M? {lappend pathList $path}
 899                        }
 900                }
 901                if {$pathList ne {}} {
 902                        unlock_index
 903                        update_index \
 904                                "Updating included files" \
 905                                $pathList \
 906                                [concat {lock_index update;} \
 907                                        [list commit_prehook $curHEAD $msg]]
 908                        return
 909                }
 910        }
 911
 912        commit_prehook $curHEAD $msg
 913}
 914
 915proc commit_prehook {curHEAD msg} {
 916        global gitdir ui_status_value pch_error
 917
 918        set pchook [file join $gitdir hooks pre-commit]
 919
 920        # On Cygwin [file executable] might lie so we need to ask
 921        # the shell if the hook is executable.  Yes that's annoying.
 922        #
 923        if {[is_Windows] && [file isfile $pchook]} {
 924                set pchook [list sh -c [concat \
 925                        "if test -x \"$pchook\";" \
 926                        "then exec \"$pchook\" 2>&1;" \
 927                        "fi"]]
 928        } elseif {[file executable $pchook]} {
 929                set pchook [list $pchook |& cat]
 930        } else {
 931                commit_writetree $curHEAD $msg
 932                return
 933        }
 934
 935        set ui_status_value {Calling pre-commit hook...}
 936        set pch_error {}
 937        set fd_ph [open "| $pchook" r]
 938        fconfigure $fd_ph -blocking 0 -translation binary
 939        fileevent $fd_ph readable \
 940                [list commit_prehook_wait $fd_ph $curHEAD $msg]
 941}
 942
 943proc commit_prehook_wait {fd_ph curHEAD msg} {
 944        global pch_error ui_status_value
 945
 946        append pch_error [read $fd_ph]
 947        fconfigure $fd_ph -blocking 1
 948        if {[eof $fd_ph]} {
 949                if {[catch {close $fd_ph}]} {
 950                        set ui_status_value {Commit declined by pre-commit hook.}
 951                        hook_failed_popup pre-commit $pch_error
 952                        unlock_index
 953                } else {
 954                        commit_writetree $curHEAD $msg
 955                }
 956                set pch_error {}
 957                return
 958        }
 959        fconfigure $fd_ph -blocking 0
 960}
 961
 962proc commit_writetree {curHEAD msg} {
 963        global ui_status_value
 964
 965        set ui_status_value {Committing changes...}
 966        set fd_wt [open "| git write-tree" r]
 967        fileevent $fd_wt readable \
 968                [list commit_committree $fd_wt $curHEAD $msg]
 969}
 970
 971proc commit_committree {fd_wt curHEAD msg} {
 972        global HEAD PARENT MERGE_HEAD commit_type
 973        global single_commit gitdir
 974        global ui_status_value ui_comm selected_commit_type
 975        global file_states selected_paths rescan_active
 976
 977        gets $fd_wt tree_id
 978        if {$tree_id eq {} || [catch {close $fd_wt} err]} {
 979                error_popup "write-tree failed:\n\n$err"
 980                set ui_status_value {Commit failed.}
 981                unlock_index
 982                return
 983        }
 984
 985        # -- Create the commit.
 986        #
 987        set cmd [list git commit-tree $tree_id]
 988        set parents [concat $PARENT $MERGE_HEAD]
 989        if {[llength $parents] > 0} {
 990                foreach p $parents {
 991                        lappend cmd -p $p
 992                }
 993        } else {
 994                # git commit-tree writes to stderr during initial commit.
 995                lappend cmd 2>/dev/null
 996        }
 997        lappend cmd << $msg
 998        if {[catch {set cmt_id [eval exec $cmd]} err]} {
 999                error_popup "commit-tree failed:\n\n$err"
1000                set ui_status_value {Commit failed.}
1001                unlock_index
1002                return
1003        }
1004
1005        # -- Update the HEAD ref.
1006        #
1007        set reflogm commit
1008        if {$commit_type ne {normal}} {
1009                append reflogm " ($commit_type)"
1010        }
1011        set i [string first "\n" $msg]
1012        if {$i >= 0} {
1013                append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1014        } else {
1015                append reflogm {: } $msg
1016        }
1017        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1018        if {[catch {eval exec $cmd} err]} {
1019                error_popup "update-ref failed:\n\n$err"
1020                set ui_status_value {Commit failed.}
1021                unlock_index
1022                return
1023        }
1024
1025        # -- Cleanup after ourselves.
1026        #
1027        catch {file delete [file join $gitdir MERGE_HEAD]}
1028        catch {file delete [file join $gitdir MERGE_MSG]}
1029        catch {file delete [file join $gitdir SQUASH_MSG]}
1030        catch {file delete [file join $gitdir GITGUI_MSG]}
1031
1032        # -- Let rerere do its thing.
1033        #
1034        if {[file isdirectory [file join $gitdir rr-cache]]} {
1035                catch {exec git rerere}
1036        }
1037
1038        # -- Run the post-commit hook.
1039        #
1040        set pchook [file join $gitdir hooks post-commit]
1041        if {[is_Windows] && [file isfile $pchook]} {
1042                set pchook [list sh -c [concat \
1043                        "if test -x \"$pchook\";" \
1044                        "then exec \"$pchook\";" \
1045                        "fi"]]
1046        } elseif {![file executable $pchook]} {
1047                set pchook {}
1048        }
1049        if {$pchook ne {}} {
1050                catch {exec $pchook &}
1051        }
1052
1053        $ui_comm delete 0.0 end
1054        $ui_comm edit reset
1055        $ui_comm edit modified false
1056
1057        if {$single_commit} do_quit
1058
1059        # -- Update in memory status
1060        #
1061        set selected_commit_type new
1062        set commit_type normal
1063        set HEAD $cmt_id
1064        set PARENT $cmt_id
1065        set MERGE_HEAD [list]
1066
1067        foreach path [array names file_states] {
1068                set s $file_states($path)
1069                set m [lindex $s 0]
1070                switch -glob -- $m {
1071                _O -
1072                _M -
1073                _D {continue}
1074                __ -
1075                A_ -
1076                M_ -
1077                DD {
1078                        unset file_states($path)
1079                        catch {unset selected_paths($path)}
1080                }
1081                DO {
1082                        set file_states($path) [list _O [lindex $s 1] {} {}]
1083                }
1084                AM -
1085                AD -
1086                MM -
1087                DM {
1088                        set file_states($path) [list \
1089                                _[string index $m 1] \
1090                                [lindex $s 1] \
1091                                [lindex $s 3] \
1092                                {}]
1093                }
1094                }
1095        }
1096
1097        display_all_files
1098        unlock_index
1099        reshow_diff
1100        set ui_status_value \
1101                "Changes committed as [string range $cmt_id 0 7]."
1102}
1103
1104######################################################################
1105##
1106## fetch pull push
1107
1108proc fetch_from {remote} {
1109        set w [new_console "fetch $remote" \
1110                "Fetching new changes from $remote"]
1111        set cmd [list git fetch]
1112        lappend cmd $remote
1113        console_exec $w $cmd
1114}
1115
1116proc pull_remote {remote branch} {
1117        global HEAD commit_type file_states repo_config
1118
1119        if {![lock_index update]} return
1120
1121        # -- Our in memory state should match the repository.
1122        #
1123        repository_state curType curHEAD curMERGE_HEAD
1124        if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1125                info_popup {Last scanned state does not match repository state.
1126
1127Another Git program has modified this repository
1128since the last scan.  A rescan must be performed
1129before a pull operation can be started.
1130
1131The rescan will be automatically started now.
1132}
1133                unlock_index
1134                rescan {set ui_status_value {Ready.}}
1135                return
1136        }
1137
1138        # -- No differences should exist before a pull.
1139        #
1140        if {[array size file_states] != 0} {
1141                error_popup {Uncommitted but modified files are present.
1142
1143You should not perform a pull with unmodified
1144files in your working directory as Git will be
1145unable to recover from an incorrect merge.
1146
1147You should commit or revert all changes before
1148starting a pull operation.
1149}
1150                unlock_index
1151                return
1152        }
1153
1154        set w [new_console "pull $remote $branch" \
1155                "Pulling new changes from branch $branch in $remote"]
1156        set cmd [list git pull]
1157        if {$repo_config(gui.pullsummary) eq {false}} {
1158                lappend cmd --no-summary
1159        }
1160        lappend cmd $remote
1161        lappend cmd $branch
1162        console_exec $w $cmd [list post_pull_remote $remote $branch]
1163}
1164
1165proc post_pull_remote {remote branch success} {
1166        global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1167        global ui_status_value
1168
1169        unlock_index
1170        if {$success} {
1171                repository_state commit_type HEAD MERGE_HEAD
1172                set PARENT $HEAD
1173                set selected_commit_type new
1174                set ui_status_value "Pulling $branch from $remote complete."
1175        } else {
1176                rescan [list set ui_status_value \
1177                        "Conflicts detected while pulling $branch from $remote."]
1178        }
1179}
1180
1181proc push_to {remote} {
1182        set w [new_console "push $remote" \
1183                "Pushing changes to $remote"]
1184        set cmd [list git push]
1185        lappend cmd $remote
1186        console_exec $w $cmd
1187}
1188
1189######################################################################
1190##
1191## ui helpers
1192
1193proc mapcol {state path} {
1194        global all_cols ui_other
1195
1196        if {[catch {set r $all_cols($state)}]} {
1197                puts "error: no column for state={$state} $path"
1198                return $ui_other
1199        }
1200        return $r
1201}
1202
1203proc mapicon {state path} {
1204        global all_icons
1205
1206        if {[catch {set r $all_icons($state)}]} {
1207                puts "error: no icon for state={$state} $path"
1208                return file_plain
1209        }
1210        return $r
1211}
1212
1213proc mapdesc {state path} {
1214        global all_descs
1215
1216        if {[catch {set r $all_descs($state)}]} {
1217                puts "error: no desc for state={$state} $path"
1218                return $state
1219        }
1220        return $r
1221}
1222
1223proc escape_path {path} {
1224        regsub -all "\n" $path "\\n" path
1225        return $path
1226}
1227
1228proc short_path {path} {
1229        return [escape_path [lindex [file split $path] end]]
1230}
1231
1232set next_icon_id 0
1233set null_sha1 [string repeat 0 40]
1234
1235proc merge_state {path new_state {head_info {}} {index_info {}}} {
1236        global file_states next_icon_id null_sha1
1237
1238        set s0 [string index $new_state 0]
1239        set s1 [string index $new_state 1]
1240
1241        if {[catch {set info $file_states($path)}]} {
1242                set state __
1243                set icon n[incr next_icon_id]
1244        } else {
1245                set state [lindex $info 0]
1246                set icon [lindex $info 1]
1247                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1248                if {$index_info eq {}} {set index_info [lindex $info 3]}
1249        }
1250
1251        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1252        elseif {$s0 eq {_}} {set s0 _}
1253
1254        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1255        elseif {$s1 eq {_}} {set s1 _}
1256
1257        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1258                set head_info [list 0 $null_sha1]
1259        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1260                && $head_info eq {}} {
1261                set head_info $index_info
1262        }
1263
1264        set file_states($path) [list $s0$s1 $icon \
1265                $head_info $index_info \
1266                ]
1267        return $state
1268}
1269
1270proc display_file {path state} {
1271        global file_states file_lists selected_paths
1272
1273        set old_m [merge_state $path $state]
1274        set s $file_states($path)
1275        set new_m [lindex $s 0]
1276        set new_w [mapcol $new_m $path] 
1277        set old_w [mapcol $old_m $path]
1278        set new_icon [mapicon $new_m $path]
1279
1280        if {$new_w ne $old_w} {
1281                set lno [lsearch -sorted $file_lists($old_w) $path]
1282                if {$lno >= 0} {
1283                        incr lno
1284                        $old_w conf -state normal
1285                        $old_w delete $lno.0 [expr {$lno + 1}].0
1286                        $old_w conf -state disabled
1287                }
1288
1289                lappend file_lists($new_w) $path
1290                set file_lists($new_w) [lsort $file_lists($new_w)]
1291                set lno [lsearch -sorted $file_lists($new_w) $path]
1292                incr lno
1293                $new_w conf -state normal
1294                $new_w image create $lno.0 \
1295                        -align center -padx 5 -pady 1 \
1296                        -name [lindex $s 1] \
1297                        -image $new_icon
1298                $new_w insert $lno.1 "[escape_path $path]\n"
1299                if {[catch {set in_sel $selected_paths($path)}]} {
1300                        set in_sel 0
1301                }
1302                if {$in_sel} {
1303                        $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1304                }
1305                $new_w conf -state disabled
1306        } elseif {$new_icon ne [mapicon $old_m $path]} {
1307                $new_w conf -state normal
1308                $new_w image conf [lindex $s 1] -image $new_icon
1309                $new_w conf -state disabled
1310        }
1311}
1312
1313proc display_all_files {} {
1314        global ui_index ui_other
1315        global file_states file_lists
1316        global last_clicked selected_paths
1317
1318        $ui_index conf -state normal
1319        $ui_other conf -state normal
1320
1321        $ui_index delete 0.0 end
1322        $ui_other delete 0.0 end
1323        set last_clicked {}
1324
1325        set file_lists($ui_index) [list]
1326        set file_lists($ui_other) [list]
1327
1328        foreach path [lsort [array names file_states]] {
1329                set s $file_states($path)
1330                set m [lindex $s 0]
1331                set w [mapcol $m $path]
1332                lappend file_lists($w) $path
1333                set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1334                $w image create end \
1335                        -align center -padx 5 -pady 1 \
1336                        -name [lindex $s 1] \
1337                        -image [mapicon $m $path]
1338                $w insert end "[escape_path $path]\n"
1339                if {[catch {set in_sel $selected_paths($path)}]} {
1340                        set in_sel 0
1341                }
1342                if {$in_sel} {
1343                        $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1344                }
1345        }
1346
1347        $ui_index conf -state disabled
1348        $ui_other conf -state disabled
1349}
1350
1351proc update_indexinfo {msg pathList after} {
1352        global update_index_cp ui_status_value
1353
1354        if {![lock_index update]} return
1355
1356        set update_index_cp 0
1357        set pathList [lsort $pathList]
1358        set totalCnt [llength $pathList]
1359        set batch [expr {int($totalCnt * .01) + 1}]
1360        if {$batch > 25} {set batch 25}
1361
1362        set ui_status_value [format \
1363                "$msg... %i/%i files (%.2f%%)" \
1364                $update_index_cp \
1365                $totalCnt \
1366                0.0]
1367        set fd [open "| git update-index -z --index-info" w]
1368        fconfigure $fd \
1369                -blocking 0 \
1370                -buffering full \
1371                -buffersize 512 \
1372                -translation binary
1373        fileevent $fd writable [list \
1374                write_update_indexinfo \
1375                $fd \
1376                $pathList \
1377                $totalCnt \
1378                $batch \
1379                $msg \
1380                $after \
1381                ]
1382}
1383
1384proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1385        global update_index_cp ui_status_value
1386        global file_states current_diff
1387
1388        if {$update_index_cp >= $totalCnt} {
1389                close $fd
1390                unlock_index
1391                uplevel #0 $after
1392                return
1393        }
1394
1395        for {set i $batch} \
1396                {$update_index_cp < $totalCnt && $i > 0} \
1397                {incr i -1} {
1398                set path [lindex $pathList $update_index_cp]
1399                incr update_index_cp
1400
1401                set s $file_states($path)
1402                switch -glob -- [lindex $s 0] {
1403                A? {set new _O}
1404                M? {set new _M}
1405                D? {set new _?}
1406                ?? {continue}
1407                }
1408                set info [lindex $s 2]
1409                if {$info eq {}} continue
1410
1411                puts -nonewline $fd $info
1412                puts -nonewline $fd "\t"
1413                puts -nonewline $fd $path
1414                puts -nonewline $fd "\0"
1415                display_file $path $new
1416        }
1417
1418        set ui_status_value [format \
1419                "$msg... %i/%i files (%.2f%%)" \
1420                $update_index_cp \
1421                $totalCnt \
1422                [expr {100.0 * $update_index_cp / $totalCnt}]]
1423}
1424
1425proc update_index {msg pathList after} {
1426        global update_index_cp ui_status_value
1427
1428        if {![lock_index update]} return
1429
1430        set update_index_cp 0
1431        set pathList [lsort $pathList]
1432        set totalCnt [llength $pathList]
1433        set batch [expr {int($totalCnt * .01) + 1}]
1434        if {$batch > 25} {set batch 25}
1435
1436        set ui_status_value [format \
1437                "$msg... %i/%i files (%.2f%%)" \
1438                $update_index_cp \
1439                $totalCnt \
1440                0.0]
1441        set fd [open "| git update-index --add --remove -z --stdin" w]
1442        fconfigure $fd \
1443                -blocking 0 \
1444                -buffering full \
1445                -buffersize 512 \
1446                -translation binary
1447        fileevent $fd writable [list \
1448                write_update_index \
1449                $fd \
1450                $pathList \
1451                $totalCnt \
1452                $batch \
1453                $msg \
1454                $after \
1455                ]
1456}
1457
1458proc write_update_index {fd pathList totalCnt batch msg after} {
1459        global update_index_cp ui_status_value
1460        global file_states current_diff
1461
1462        if {$update_index_cp >= $totalCnt} {
1463                close $fd
1464                unlock_index
1465                uplevel #0 $after
1466                return
1467        }
1468
1469        for {set i $batch} \
1470                {$update_index_cp < $totalCnt && $i > 0} \
1471                {incr i -1} {
1472                set path [lindex $pathList $update_index_cp]
1473                incr update_index_cp
1474
1475                switch -glob -- [lindex $file_states($path) 0] {
1476                AD -
1477                MD -
1478                _D {set new DD}
1479
1480                _M -
1481                MM -
1482                M_ {set new M_}
1483
1484                _O -
1485                AM -
1486                A_ {set new A_}
1487
1488                ?? {continue}
1489                }
1490
1491                puts -nonewline $fd $path
1492                puts -nonewline $fd "\0"
1493                display_file $path $new
1494        }
1495
1496        set ui_status_value [format \
1497                "$msg... %i/%i files (%.2f%%)" \
1498                $update_index_cp \
1499                $totalCnt \
1500                [expr {100.0 * $update_index_cp / $totalCnt}]]
1501}
1502
1503######################################################################
1504##
1505## remote management
1506
1507proc load_all_remotes {} {
1508        global gitdir all_remotes repo_config
1509
1510        set all_remotes [list]
1511        set rm_dir [file join $gitdir remotes]
1512        if {[file isdirectory $rm_dir]} {
1513                set all_remotes [concat $all_remotes [glob \
1514                        -types f \
1515                        -tails \
1516                        -nocomplain \
1517                        -directory $rm_dir *]]
1518        }
1519
1520        foreach line [array names repo_config remote.*.url] {
1521                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1522                        lappend all_remotes $name
1523                }
1524        }
1525
1526        set all_remotes [lsort -unique $all_remotes]
1527}
1528
1529proc populate_fetch_menu {m} {
1530        global gitdir all_remotes repo_config
1531
1532        foreach r $all_remotes {
1533                set enable 0
1534                if {![catch {set a $repo_config(remote.$r.url)}]} {
1535                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1536                                set enable 1
1537                        }
1538                } else {
1539                        catch {
1540                                set fd [open [file join $gitdir remotes $r] r]
1541                                while {[gets $fd n] >= 0} {
1542                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1543                                                set enable 1
1544                                                break
1545                                        }
1546                                }
1547                                close $fd
1548                        }
1549                }
1550
1551                if {$enable} {
1552                        $m add command \
1553                                -label "Fetch from $r..." \
1554                                -command [list fetch_from $r] \
1555                                -font font_ui
1556                }
1557        }
1558}
1559
1560proc populate_push_menu {m} {
1561        global gitdir all_remotes repo_config
1562
1563        foreach r $all_remotes {
1564                set enable 0
1565                if {![catch {set a $repo_config(remote.$r.url)}]} {
1566                        if {![catch {set a $repo_config(remote.$r.push)}]} {
1567                                set enable 1
1568                        }
1569                } else {
1570                        catch {
1571                                set fd [open [file join $gitdir remotes $r] r]
1572                                while {[gets $fd n] >= 0} {
1573                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1574                                                set enable 1
1575                                                break
1576                                        }
1577                                }
1578                                close $fd
1579                        }
1580                }
1581
1582                if {$enable} {
1583                        $m add command \
1584                                -label "Push to $r..." \
1585                                -command [list push_to $r] \
1586                                -font font_ui
1587                }
1588        }
1589}
1590
1591proc populate_pull_menu {m} {
1592        global gitdir repo_config all_remotes disable_on_lock
1593
1594        foreach remote $all_remotes {
1595                set rb {}
1596                if {[array get repo_config remote.$remote.url] ne {}} {
1597                        if {[array get repo_config remote.$remote.fetch] ne {}} {
1598                                regexp {^([^:]+):} \
1599                                        [lindex $repo_config(remote.$remote.fetch) 0] \
1600                                        line rb
1601                        }
1602                } else {
1603                        catch {
1604                                set fd [open [file join $gitdir remotes $remote] r]
1605                                while {[gets $fd line] >= 0} {
1606                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1607                                                break
1608                                        }
1609                                }
1610                                close $fd
1611                        }
1612                }
1613
1614                set rb_short $rb
1615                regsub ^refs/heads/ $rb {} rb_short
1616                if {$rb_short ne {}} {
1617                        $m add command \
1618                                -label "Branch $rb_short from $remote..." \
1619                                -command [list pull_remote $remote $rb] \
1620                                -font font_ui
1621                        lappend disable_on_lock \
1622                                [list $m entryconf [$m index last] -state]
1623                }
1624        }
1625}
1626
1627######################################################################
1628##
1629## icons
1630
1631set filemask {
1632#define mask_width 14
1633#define mask_height 15
1634static unsigned char mask_bits[] = {
1635   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1636   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1637   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1638}
1639
1640image create bitmap file_plain -background white -foreground black -data {
1641#define plain_width 14
1642#define plain_height 15
1643static unsigned char plain_bits[] = {
1644   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1645   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1646   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1647} -maskdata $filemask
1648
1649image create bitmap file_mod -background white -foreground blue -data {
1650#define mod_width 14
1651#define mod_height 15
1652static unsigned char mod_bits[] = {
1653   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1654   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1655   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1656} -maskdata $filemask
1657
1658image create bitmap file_fulltick -background white -foreground "#007000" -data {
1659#define file_fulltick_width 14
1660#define file_fulltick_height 15
1661static unsigned char file_fulltick_bits[] = {
1662   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1663   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1664   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1665} -maskdata $filemask
1666
1667image create bitmap file_parttick -background white -foreground "#005050" -data {
1668#define parttick_width 14
1669#define parttick_height 15
1670static unsigned char parttick_bits[] = {
1671   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1672   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1673   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1674} -maskdata $filemask
1675
1676image create bitmap file_question -background white -foreground black -data {
1677#define file_question_width 14
1678#define file_question_height 15
1679static unsigned char file_question_bits[] = {
1680   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1681   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1682   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1683} -maskdata $filemask
1684
1685image create bitmap file_removed -background white -foreground red -data {
1686#define file_removed_width 14
1687#define file_removed_height 15
1688static unsigned char file_removed_bits[] = {
1689   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1690   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1691   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1692} -maskdata $filemask
1693
1694image create bitmap file_merge -background white -foreground blue -data {
1695#define file_merge_width 14
1696#define file_merge_height 15
1697static unsigned char file_merge_bits[] = {
1698   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1699   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1700   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1701} -maskdata $filemask
1702
1703set ui_index .vpane.files.index.list
1704set ui_other .vpane.files.other.list
1705set max_status_desc 0
1706foreach i {
1707                {__ i plain    "Unmodified"}
1708                {_M i mod      "Modified"}
1709                {M_ i fulltick "Included in commit"}
1710                {MM i parttick "Partially included"}
1711
1712                {_O o plain    "Untracked"}
1713                {A_ o fulltick "Added by commit"}
1714                {AM o parttick "Partially added"}
1715                {AD o question "Added (but now gone)"}
1716
1717                {_D i question "Missing"}
1718                {DD i removed  "Removed by commit"}
1719                {DO i removed  "Removed (still exists)"}
1720                {DM i removed  "Removed (but modified)"}
1721
1722                {UD i merge    "Merge conflicts"}
1723                {UM i merge    "Merge conflicts"}
1724                {U_ i merge    "Merge conflicts"}
1725        } {
1726        if {$max_status_desc < [string length [lindex $i 3]]} {
1727                set max_status_desc [string length [lindex $i 3]]
1728        }
1729        if {[lindex $i 1] eq {i}} {
1730                set all_cols([lindex $i 0]) $ui_index
1731        } else {
1732                set all_cols([lindex $i 0]) $ui_other
1733        }
1734        set all_icons([lindex $i 0]) file_[lindex $i 2]
1735        set all_descs([lindex $i 0]) [lindex $i 3]
1736}
1737unset filemask i
1738
1739######################################################################
1740##
1741## util
1742
1743proc is_MacOSX {} {
1744        global tcl_platform tk_library
1745        if {[tk windowingsystem] eq {aqua}} {
1746                return 1
1747        }
1748        return 0
1749}
1750
1751proc is_Windows {} {
1752        global tcl_platform
1753        if {$tcl_platform(platform) eq {windows}} {
1754                return 1
1755        }
1756        return 0
1757}
1758
1759proc bind_button3 {w cmd} {
1760        bind $w <Any-Button-3> $cmd
1761        if {[is_MacOSX]} {
1762                bind $w <Control-Button-1> $cmd
1763        }
1764}
1765
1766proc incr_font_size {font {amt 1}} {
1767        set sz [font configure $font -size]
1768        incr sz $amt
1769        font configure $font -size $sz
1770        font configure ${font}bold -size $sz
1771}
1772
1773proc hook_failed_popup {hook msg} {
1774        global gitdir appname
1775
1776        set w .hookfail
1777        toplevel $w
1778
1779        frame $w.m
1780        label $w.m.l1 -text "$hook hook failed:" \
1781                -anchor w \
1782                -justify left \
1783                -font font_uibold
1784        text $w.m.t \
1785                -background white -borderwidth 1 \
1786                -relief sunken \
1787                -width 80 -height 10 \
1788                -font font_diff \
1789                -yscrollcommand [list $w.m.sby set]
1790        label $w.m.l2 \
1791                -text {You must correct the above errors before committing.} \
1792                -anchor w \
1793                -justify left \
1794                -font font_uibold
1795        scrollbar $w.m.sby -command [list $w.m.t yview]
1796        pack $w.m.l1 -side top -fill x
1797        pack $w.m.l2 -side bottom -fill x
1798        pack $w.m.sby -side right -fill y
1799        pack $w.m.t -side left -fill both -expand 1
1800        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1801
1802        $w.m.t insert 1.0 $msg
1803        $w.m.t conf -state disabled
1804
1805        button $w.ok -text OK \
1806                -width 15 \
1807                -font font_ui \
1808                -command "destroy $w"
1809        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1810
1811        bind $w <Visibility> "grab $w; focus $w"
1812        bind $w <Key-Return> "destroy $w"
1813        wm title $w "$appname ([lindex [file split \
1814                [file normalize [file dirname $gitdir]]] \
1815                end]): error"
1816        tkwait window $w
1817}
1818
1819set next_console_id 0
1820
1821proc new_console {short_title long_title} {
1822        global next_console_id console_data
1823        set w .console[incr next_console_id]
1824        set console_data($w) [list $short_title $long_title]
1825        return [console_init $w]
1826}
1827
1828proc console_init {w} {
1829        global console_cr console_data
1830        global gitdir appname M1B
1831
1832        set console_cr($w) 1.0
1833        toplevel $w
1834        frame $w.m
1835        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1836                -anchor w \
1837                -justify left \
1838                -font font_uibold
1839        text $w.m.t \
1840                -background white -borderwidth 1 \
1841                -relief sunken \
1842                -width 80 -height 10 \
1843                -font font_diff \
1844                -state disabled \
1845                -yscrollcommand [list $w.m.sby set]
1846        label $w.m.s -text {Working... please wait...} \
1847                -anchor w \
1848                -justify left \
1849                -font font_uibold
1850        scrollbar $w.m.sby -command [list $w.m.t yview]
1851        pack $w.m.l1 -side top -fill x
1852        pack $w.m.s -side bottom -fill x
1853        pack $w.m.sby -side right -fill y
1854        pack $w.m.t -side left -fill both -expand 1
1855        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1856
1857        menu $w.ctxm -tearoff 0
1858        $w.ctxm add command -label "Copy" \
1859                -font font_ui \
1860                -command "tk_textCopy $w.m.t"
1861        $w.ctxm add command -label "Select All" \
1862                -font font_ui \
1863                -command "$w.m.t tag add sel 0.0 end"
1864        $w.ctxm add command -label "Copy All" \
1865                -font font_ui \
1866                -command "
1867                        $w.m.t tag add sel 0.0 end
1868                        tk_textCopy $w.m.t
1869                        $w.m.t tag remove sel 0.0 end
1870                "
1871
1872        button $w.ok -text {Close} \
1873                -font font_ui \
1874                -state disabled \
1875                -command "destroy $w"
1876        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1877
1878        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1879        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1880        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1881        bind $w <Visibility> "focus $w"
1882        wm title $w "$appname ([lindex [file split \
1883                [file normalize [file dirname $gitdir]]] \
1884                end]): [lindex $console_data($w) 0]"
1885        return $w
1886}
1887
1888proc console_exec {w cmd {after {}}} {
1889        # -- Windows tosses the enviroment when we exec our child.
1890        #    But most users need that so we have to relogin. :-(
1891        #
1892        if {[is_Windows]} {
1893                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1894        }
1895
1896        # -- Tcl won't let us redirect both stdout and stderr to
1897        #    the same pipe.  So pass it through cat...
1898        #
1899        set cmd [concat | $cmd |& cat]
1900
1901        set fd_f [open $cmd r]
1902        fconfigure $fd_f -blocking 0 -translation binary
1903        fileevent $fd_f readable [list console_read $w $fd_f $after]
1904}
1905
1906proc console_read {w fd after} {
1907        global console_cr console_data
1908
1909        set buf [read $fd]
1910        if {$buf ne {}} {
1911                if {![winfo exists $w]} {console_init $w}
1912                $w.m.t conf -state normal
1913                set c 0
1914                set n [string length $buf]
1915                while {$c < $n} {
1916                        set cr [string first "\r" $buf $c]
1917                        set lf [string first "\n" $buf $c]
1918                        if {$cr < 0} {set cr [expr {$n + 1}]}
1919                        if {$lf < 0} {set lf [expr {$n + 1}]}
1920
1921                        if {$lf < $cr} {
1922                                $w.m.t insert end [string range $buf $c $lf]
1923                                set console_cr($w) [$w.m.t index {end -1c}]
1924                                set c $lf
1925                                incr c
1926                        } else {
1927                                $w.m.t delete $console_cr($w) end
1928                                $w.m.t insert end "\n"
1929                                $w.m.t insert end [string range $buf $c $cr]
1930                                set c $cr
1931                                incr c
1932                        }
1933                }
1934                $w.m.t conf -state disabled
1935                $w.m.t see end
1936        }
1937
1938        fconfigure $fd -blocking 1
1939        if {[eof $fd]} {
1940                if {[catch {close $fd}]} {
1941                        if {![winfo exists $w]} {console_init $w}
1942                        $w.m.s conf -background red -text {Error: Command Failed}
1943                        $w.ok conf -state normal
1944                        set ok 0
1945                } elseif {[winfo exists $w]} {
1946                        $w.m.s conf -background green -text {Success}
1947                        $w.ok conf -state normal
1948                        set ok 1
1949                }
1950                array unset console_cr $w
1951                array unset console_data $w
1952                if {$after ne {}} {
1953                        uplevel #0 $after $ok
1954                }
1955                return
1956        }
1957        fconfigure $fd -blocking 0
1958}
1959
1960######################################################################
1961##
1962## ui commands
1963
1964set starting_gitk_msg {Please wait... Starting gitk...}
1965
1966proc do_gitk {revs} {
1967        global ui_status_value starting_gitk_msg
1968
1969        set cmd gitk
1970        if {$revs ne {}} {
1971                append cmd { }
1972                append cmd $revs
1973        }
1974        if {[is_Windows]} {
1975                set cmd "sh -c \"exec $cmd\""
1976        }
1977        append cmd { &}
1978
1979        if {[catch {eval exec $cmd} err]} {
1980                error_popup "Failed to start gitk:\n\n$err"
1981        } else {
1982                set ui_status_value $starting_gitk_msg
1983                after 10000 {
1984                        if {$ui_status_value eq $starting_gitk_msg} {
1985                                set ui_status_value {Ready.}
1986                        }
1987                }
1988        }
1989}
1990
1991proc do_repack {} {
1992        set w [new_console {repack} \
1993                {Repacking the object database}]
1994        set cmd [list git repack]
1995        lappend cmd -a
1996        lappend cmd -d
1997        console_exec $w $cmd
1998}
1999
2000proc do_fsck_objects {} {
2001        set w [new_console {fsck-objects} \
2002                {Verifying the object database with fsck-objects}]
2003        set cmd [list git fsck-objects]
2004        lappend cmd --full
2005        lappend cmd --cache
2006        lappend cmd --strict
2007        console_exec $w $cmd
2008}
2009
2010set is_quitting 0
2011
2012proc do_quit {} {
2013        global gitdir ui_comm is_quitting repo_config commit_type
2014
2015        if {$is_quitting} return
2016        set is_quitting 1
2017
2018        # -- Stash our current commit buffer.
2019        #
2020        set save [file join $gitdir GITGUI_MSG]
2021        set msg [string trim [$ui_comm get 0.0 end]]
2022        if {![string match amend* $commit_type]
2023                && [$ui_comm edit modified]
2024                && $msg ne {}} {
2025                catch {
2026                        set fd [open $save w]
2027                        puts $fd [string trim [$ui_comm get 0.0 end]]
2028                        close $fd
2029                }
2030        } else {
2031                catch {file delete $save}
2032        }
2033
2034        # -- Stash our current window geometry into this repository.
2035        #
2036        set cfg_geometry [list]
2037        lappend cfg_geometry [wm geometry .]
2038        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2039        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2040        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2041                set rc_geometry {}
2042        }
2043        if {$cfg_geometry ne $rc_geometry} {
2044                catch {exec git repo-config gui.geometry $cfg_geometry}
2045        }
2046
2047        destroy .
2048}
2049
2050proc do_rescan {} {
2051        rescan {set ui_status_value {Ready.}}
2052}
2053
2054proc remove_helper {txt paths} {
2055        global file_states current_diff
2056
2057        if {![lock_index begin-update]} return
2058
2059        set pathList [list]
2060        set after {}
2061        foreach path $paths {
2062                switch -glob -- [lindex $file_states($path) 0] {
2063                A? -
2064                M? -
2065                D? {
2066                        lappend pathList $path
2067                        if {$path eq $current_diff} {
2068                                set after {reshow_diff;}
2069                        }
2070                }
2071                }
2072        }
2073        if {$pathList eq {}} {
2074                unlock_index
2075        } else {
2076                update_indexinfo \
2077                        $txt \
2078                        $pathList \
2079                        [concat $after {set ui_status_value {Ready.}}]
2080        }
2081}
2082
2083proc do_remove_selection {} {
2084        global current_diff selected_paths
2085
2086        if {[array size selected_paths] > 0} {
2087                remove_helper \
2088                        {Removing selected files from commit} \
2089                        [array names selected_paths]
2090        } elseif {$current_diff ne {}} {
2091                remove_helper \
2092                        "Removing [short_path $current_diff] from commit" \
2093                        [list $current_diff]
2094        }
2095}
2096
2097proc include_helper {txt paths} {
2098        global file_states current_diff
2099
2100        if {![lock_index begin-update]} return
2101
2102        set pathList [list]
2103        set after {}
2104        foreach path $paths {
2105                switch -glob -- [lindex $file_states($path) 0] {
2106                AM -
2107                AD -
2108                MM -
2109                U? -
2110                _M -
2111                _D -
2112                _O {
2113                        lappend pathList $path
2114                        if {$path eq $current_diff} {
2115                                set after {reshow_diff;}
2116                        }
2117                }
2118                }
2119        }
2120        if {$pathList eq {}} {
2121                unlock_index
2122        } else {
2123                update_index \
2124                        $txt \
2125                        $pathList \
2126                        [concat $after {set ui_status_value {Ready to commit.}}]
2127        }
2128}
2129
2130proc do_include_selection {} {
2131        global current_diff selected_paths
2132
2133        if {[array size selected_paths] > 0} {
2134                include_helper \
2135                        {Including selected files} \
2136                        [array names selected_paths]
2137        } elseif {$current_diff ne {}} {
2138                include_helper \
2139                        "Including [short_path $current_diff]" \
2140                        [list $current_diff]
2141        }
2142}
2143
2144proc do_include_all {} {
2145        global file_states
2146
2147        set paths [list]
2148        foreach path [array names file_states] {
2149                switch -- [lindex $file_states($path) 0] {
2150                AM -
2151                AD -
2152                MM -
2153                _M -
2154                _D {lappend paths $path}
2155                }
2156        }
2157        include_helper \
2158                {Including all modified files} \
2159                $paths
2160}
2161
2162proc do_signoff {} {
2163        global ui_comm
2164
2165        set me [committer_ident]
2166        if {$me eq {}} return
2167
2168        set sob "Signed-off-by: $me"
2169        set last [$ui_comm get {end -1c linestart} {end -1c}]
2170        if {$last ne $sob} {
2171                $ui_comm edit separator
2172                if {$last ne {}
2173                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2174                        $ui_comm insert end "\n"
2175                }
2176                $ui_comm insert end "\n$sob"
2177                $ui_comm edit separator
2178                $ui_comm see end
2179        }
2180}
2181
2182proc do_select_commit_type {} {
2183        global commit_type selected_commit_type
2184
2185        if {$selected_commit_type eq {new}
2186                && [string match amend* $commit_type]} {
2187                create_new_commit
2188        } elseif {$selected_commit_type eq {amend}
2189                && ![string match amend* $commit_type]} {
2190                load_last_commit
2191
2192                # The amend request was rejected...
2193                #
2194                if {![string match amend* $commit_type]} {
2195                        set selected_commit_type new
2196                }
2197        }
2198}
2199
2200proc do_commit {} {
2201        commit_tree
2202}
2203
2204proc do_about {} {
2205        global appname copyright
2206        global tcl_patchLevel tk_patchLevel
2207
2208        set w .about_dialog
2209        toplevel $w
2210        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2211
2212        label $w.header -text "About $appname" \
2213                -font font_uibold
2214        pack $w.header -side top -fill x
2215
2216        frame $w.buttons
2217        button $w.buttons.close -text {Close} \
2218                -font font_ui \
2219                -command [list destroy $w]
2220        pack $w.buttons.close -side right
2221        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2222
2223        label $w.desc \
2224                -text "$appname - a commit creation tool for Git.
2225$copyright" \
2226                -padx 5 -pady 5 \
2227                -justify left \
2228                -anchor w \
2229                -borderwidth 1 \
2230                -relief solid \
2231                -font font_ui
2232        pack $w.desc -side top -fill x -padx 5 -pady 5
2233
2234        set v [exec git --version]
2235        append v "\n\n"
2236        if {$tcl_patchLevel eq $tk_patchLevel} {
2237                append v "Tcl/Tk version $tcl_patchLevel"
2238        } else {
2239                append v "Tcl version $tcl_patchLevel"
2240                append v ", Tk version $tk_patchLevel"
2241        }
2242
2243        label $w.vers \
2244                -text $v \
2245                -padx 5 -pady 5 \
2246                -justify left \
2247                -anchor w \
2248                -borderwidth 1 \
2249                -relief solid \
2250                -font font_ui
2251        pack $w.vers -side top -fill x -padx 5 -pady 5
2252
2253        bind $w <Visibility> "grab $w; focus $w"
2254        bind $w <Key-Escape> "destroy $w"
2255        wm title $w "About $appname"
2256        tkwait window $w
2257}
2258
2259proc do_options {} {
2260        global appname gitdir font_descs
2261        global repo_config global_config
2262        global repo_config_new global_config_new
2263
2264        array unset repo_config_new
2265        array unset global_config_new
2266        foreach name [array names repo_config] {
2267                set repo_config_new($name) $repo_config($name)
2268        }
2269        load_config 1
2270        foreach name [array names repo_config] {
2271                switch -- $name {
2272                gui.diffcontext {continue}
2273                }
2274                set repo_config_new($name) $repo_config($name)
2275        }
2276        foreach name [array names global_config] {
2277                set global_config_new($name) $global_config($name)
2278        }
2279        set reponame [lindex [file split \
2280                [file normalize [file dirname $gitdir]]] \
2281                end]
2282
2283        set w .options_editor
2284        toplevel $w
2285        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2286
2287        label $w.header -text "$appname Options" \
2288                -font font_uibold
2289        pack $w.header -side top -fill x
2290
2291        frame $w.buttons
2292        button $w.buttons.restore -text {Restore Defaults} \
2293                -font font_ui \
2294                -command do_restore_defaults
2295        pack $w.buttons.restore -side left
2296        button $w.buttons.save -text Save \
2297                -font font_ui \
2298                -command [list do_save_config $w]
2299        pack $w.buttons.save -side right
2300        button $w.buttons.cancel -text {Cancel} \
2301                -font font_ui \
2302                -command [list destroy $w]
2303        pack $w.buttons.cancel -side right
2304        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2305
2306        labelframe $w.repo -text "$reponame Repository" \
2307                -font font_ui \
2308                -relief raised -borderwidth 2
2309        labelframe $w.global -text {Global (All Repositories)} \
2310                -font font_ui \
2311                -relief raised -borderwidth 2
2312        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2313        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2314
2315        foreach option {
2316                {b partialinclude {Allow Partially Included Files}}
2317                {b pullsummary {Show Pull Summary}}
2318                {b trustmtime  {Trust File Modification Timestamps}}
2319                {i diffcontext {Number of Diff Context Lines}}
2320                } {
2321                set type [lindex $option 0]
2322                set name [lindex $option 1]
2323                set text [lindex $option 2]
2324                foreach f {repo global} {
2325                        switch $type {
2326                        b {
2327                                checkbutton $w.$f.$name -text $text \
2328                                        -variable ${f}_config_new(gui.$name) \
2329                                        -onvalue true \
2330                                        -offvalue false \
2331                                        -font font_ui
2332                                pack $w.$f.$name -side top -anchor w
2333                        }
2334                        i {
2335                                frame $w.$f.$name
2336                                label $w.$f.$name.l -text "$text:" -font font_ui
2337                                pack $w.$f.$name.l -side left -anchor w -fill x
2338                                spinbox $w.$f.$name.v \
2339                                        -textvariable ${f}_config_new(gui.$name) \
2340                                        -from 1 -to 99 -increment 1 \
2341                                        -width 3 \
2342                                        -font font_ui
2343                                pack $w.$f.$name.v -side right -anchor e
2344                                pack $w.$f.$name -side top -anchor w -fill x
2345                        }
2346                        }
2347                }
2348        }
2349
2350        set all_fonts [lsort [font families]]
2351        foreach option $font_descs {
2352                set name [lindex $option 0]
2353                set font [lindex $option 1]
2354                set text [lindex $option 2]
2355
2356                set global_config_new(gui.$font^^family) \
2357                        [font configure $font -family]
2358                set global_config_new(gui.$font^^size) \
2359                        [font configure $font -size]
2360
2361                frame $w.global.$name
2362                label $w.global.$name.l -text "$text:" -font font_ui
2363                pack $w.global.$name.l -side left -anchor w -fill x
2364                eval tk_optionMenu $w.global.$name.family \
2365                        global_config_new(gui.$font^^family) \
2366                        $all_fonts
2367                spinbox $w.global.$name.size \
2368                        -textvariable global_config_new(gui.$font^^size) \
2369                        -from 2 -to 80 -increment 1 \
2370                        -width 3 \
2371                        -font font_ui
2372                pack $w.global.$name.size -side right -anchor e
2373                pack $w.global.$name.family -side right -anchor e
2374                pack $w.global.$name -side top -anchor w -fill x
2375        }
2376
2377        bind $w <Visibility> "grab $w; focus $w"
2378        bind $w <Key-Escape> "destroy $w"
2379        wm title $w "$appname ($reponame): Options"
2380        tkwait window $w
2381}
2382
2383proc do_restore_defaults {} {
2384        global font_descs default_config repo_config
2385        global repo_config_new global_config_new
2386
2387        foreach name [array names default_config] {
2388                set repo_config_new($name) $default_config($name)
2389                set global_config_new($name) $default_config($name)
2390        }
2391
2392        foreach option $font_descs {
2393                set name [lindex $option 0]
2394                set repo_config(gui.$name) $default_config(gui.$name)
2395        }
2396        apply_config
2397
2398        foreach option $font_descs {
2399                set name [lindex $option 0]
2400                set font [lindex $option 1]
2401                set global_config_new(gui.$font^^family) \
2402                        [font configure $font -family]
2403                set global_config_new(gui.$font^^size) \
2404                        [font configure $font -size]
2405        }
2406}
2407
2408proc do_save_config {w} {
2409        if {[catch {save_config} err]} {
2410                error_popup "Failed to completely save options:\n\n$err"
2411        }
2412        reshow_diff
2413        destroy $w
2414}
2415
2416proc do_windows_shortcut {} {
2417        global gitdir appname argv0
2418
2419        set reponame [lindex [file split \
2420                [file normalize [file dirname $gitdir]]] \
2421                end]
2422
2423        if {[catch {
2424                set desktop [exec cygpath \
2425                        --windows \
2426                        --absolute \
2427                        --long-name \
2428                        --desktop]
2429                }]} {
2430                        set desktop .
2431        }
2432        set fn [tk_getSaveFile \
2433                -parent . \
2434                -title "$appname ($reponame): Create Desktop Icon" \
2435                -initialdir $desktop \
2436                -initialfile "Git $reponame.bat"]
2437        if {$fn != {}} {
2438                if {[catch {
2439                                set fd [open $fn w]
2440                                set sh [exec cygpath \
2441                                        --windows \
2442                                        --absolute \
2443                                        --long-name \
2444                                        /bin/sh]
2445                                set me [exec cygpath \
2446                                        --unix \
2447                                        --absolute \
2448                                        $argv0]
2449                                set gd [exec cygpath \
2450                                        --unix \
2451                                        --absolute \
2452                                        $gitdir]
2453                                regsub -all ' $me "'\\''" me
2454                                regsub -all ' $gd "'\\''" gd
2455                                puts -nonewline $fd "\"$sh\" --login -c \""
2456                                puts -nonewline $fd "GIT_DIR='$gd'"
2457                                puts -nonewline $fd " '$me'"
2458                                puts $fd "&\""
2459                                close $fd
2460                        } err]} {
2461                        error_popup "Cannot write script:\n\n$err"
2462                }
2463        }
2464}
2465
2466proc do_macosx_app {} {
2467        global gitdir appname argv0 env
2468
2469        set reponame [lindex [file split \
2470                [file normalize [file dirname $gitdir]]] \
2471                end]
2472
2473        set fn [tk_getSaveFile \
2474                -parent . \
2475                -title "$appname ($reponame): Create Desktop Icon" \
2476                -initialdir [file join $env(HOME) Desktop] \
2477                -initialfile "Git $reponame.app"]
2478        if {$fn != {}} {
2479                if {[catch {
2480                                set Contents [file join $fn Contents]
2481                                set MacOS [file join $Contents MacOS]
2482                                set exe [file join $MacOS git-gui]
2483
2484                                file mkdir $MacOS
2485
2486                                set fd [open [file join $Contents Info.plist] w]
2487                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2488<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2489<plist version="1.0">
2490<dict>
2491        <key>CFBundleDevelopmentRegion</key>
2492        <string>English</string>
2493        <key>CFBundleExecutable</key>
2494        <string>git-gui</string>
2495        <key>CFBundleIdentifier</key>
2496        <string>org.spearce.git-gui</string>
2497        <key>CFBundleInfoDictionaryVersion</key>
2498        <string>6.0</string>
2499        <key>CFBundlePackageType</key>
2500        <string>APPL</string>
2501        <key>CFBundleSignature</key>
2502        <string>????</string>
2503        <key>CFBundleVersion</key>
2504        <string>1.0</string>
2505        <key>NSPrincipalClass</key>
2506        <string>NSApplication</string>
2507</dict>
2508</plist>}
2509                                close $fd
2510
2511                                set fd [open $exe w]
2512                                set gd [file normalize $gitdir]
2513                                set ep [file normalize [exec git --exec-path]]
2514                                regsub -all ' $gd "'\\''" gd
2515                                regsub -all ' $ep "'\\''" ep
2516                                puts $fd "#!/bin/sh"
2517                                foreach name [array names env] {
2518                                        if {[string match GIT_* $name]} {
2519                                                regsub -all ' $env($name) "'\\''" v
2520                                                puts $fd "export $name='$v'"
2521                                        }
2522                                }
2523                                puts $fd "export PATH='$ep':\$PATH"
2524                                puts $fd "export GIT_DIR='$gd'"
2525                                puts $fd "exec [file normalize $argv0]"
2526                                close $fd
2527
2528                                file attributes $exe -permissions u+x,g+x,o+x
2529                        } err]} {
2530                        error_popup "Cannot write icon:\n\n$err"
2531                }
2532        }
2533}
2534
2535proc toggle_or_diff {w x y} {
2536        global file_states file_lists current_diff ui_index ui_other
2537        global last_clicked selected_paths
2538
2539        set pos [split [$w index @$x,$y] .]
2540        set lno [lindex $pos 0]
2541        set col [lindex $pos 1]
2542        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2543        if {$path eq {}} {
2544                set last_clicked {}
2545                return
2546        }
2547
2548        set last_clicked [list $w $lno]
2549        array unset selected_paths
2550        $ui_index tag remove in_sel 0.0 end
2551        $ui_other tag remove in_sel 0.0 end
2552
2553        if {$col == 0} {
2554                if {$current_diff eq $path} {
2555                        set after {reshow_diff;}
2556                } else {
2557                        set after {}
2558                }
2559                switch -glob -- [lindex $file_states($path) 0] {
2560                A_ -
2561                M_ -
2562                DD -
2563                DO -
2564                DM {
2565                        update_indexinfo \
2566                                "Removing [short_path $path] from commit" \
2567                                [list $path] \
2568                                [concat $after {set ui_status_value {Ready.}}]
2569                }
2570                ?? {
2571                        update_index \
2572                                "Including [short_path $path]" \
2573                                [list $path] \
2574                                [concat $after {set ui_status_value {Ready.}}]
2575                }
2576                }
2577        } else {
2578                show_diff $path $w $lno
2579        }
2580}
2581
2582proc add_one_to_selection {w x y} {
2583        global file_lists
2584        global last_clicked selected_paths
2585
2586        set pos [split [$w index @$x,$y] .]
2587        set lno [lindex $pos 0]
2588        set col [lindex $pos 1]
2589        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2590        if {$path eq {}} {
2591                set last_clicked {}
2592                return
2593        }
2594
2595        set last_clicked [list $w $lno]
2596        if {[catch {set in_sel $selected_paths($path)}]} {
2597                set in_sel 0
2598        }
2599        if {$in_sel} {
2600                unset selected_paths($path)
2601                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2602        } else {
2603                set selected_paths($path) 1
2604                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2605        }
2606}
2607
2608proc add_range_to_selection {w x y} {
2609        global file_lists
2610        global last_clicked selected_paths
2611
2612        if {[lindex $last_clicked 0] ne $w} {
2613                toggle_or_diff $w $x $y
2614                return
2615        }
2616
2617        set pos [split [$w index @$x,$y] .]
2618        set lno [lindex $pos 0]
2619        set lc [lindex $last_clicked 1]
2620        if {$lc < $lno} {
2621                set begin $lc
2622                set end $lno
2623        } else {
2624                set begin $lno
2625                set end $lc
2626        }
2627
2628        foreach path [lrange $file_lists($w) \
2629                [expr {$begin - 1}] \
2630                [expr {$end - 1}]] {
2631                set selected_paths($path) 1
2632        }
2633        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2634}
2635
2636######################################################################
2637##
2638## config defaults
2639
2640set cursor_ptr arrow
2641font create font_diff -family Courier -size 10
2642font create font_ui
2643catch {
2644        label .dummy
2645        eval font configure font_ui [font actual [.dummy cget -font]]
2646        destroy .dummy
2647}
2648
2649font create font_uibold
2650font create font_diffbold
2651
2652if {[is_Windows]} {
2653        set M1B Control
2654        set M1T Ctrl
2655} elseif {[is_MacOSX]} {
2656        set M1B M1
2657        set M1T Cmd
2658} else {
2659        set M1B M1
2660        set M1T M1
2661}
2662
2663proc apply_config {} {
2664        global repo_config font_descs
2665
2666        foreach option $font_descs {
2667                set name [lindex $option 0]
2668                set font [lindex $option 1]
2669                if {[catch {
2670                        foreach {cn cv} $repo_config(gui.$name) {
2671                                font configure $font $cn $cv
2672                        }
2673                        } err]} {
2674                        error_popup "Invalid font specified in gui.$name:\n\n$err"
2675                }
2676                foreach {cn cv} [font configure $font] {
2677                        font configure ${font}bold $cn $cv
2678                }
2679                font configure ${font}bold -weight bold
2680        }
2681}
2682
2683set default_config(gui.trustmtime) false
2684set default_config(gui.pullsummary) true
2685set default_config(gui.partialinclude) false
2686set default_config(gui.diffcontext) 5
2687set default_config(gui.fontui) [font configure font_ui]
2688set default_config(gui.fontdiff) [font configure font_diff]
2689set font_descs {
2690        {fontui   font_ui   {Main Font}}
2691        {fontdiff font_diff {Diff/Console Font}}
2692}
2693load_config 0
2694apply_config
2695
2696######################################################################
2697##
2698## ui construction
2699
2700# -- Menu Bar
2701#
2702menu .mbar -tearoff 0
2703.mbar add cascade -label Repository -menu .mbar.repository
2704.mbar add cascade -label Edit -menu .mbar.edit
2705.mbar add cascade -label Commit -menu .mbar.commit
2706if {!$single_commit} {
2707        .mbar add cascade -label Fetch -menu .mbar.fetch
2708        .mbar add cascade -label Pull -menu .mbar.pull
2709        .mbar add cascade -label Push -menu .mbar.push
2710}
2711. configure -menu .mbar
2712
2713# -- Repository Menu
2714#
2715menu .mbar.repository
2716.mbar.repository add command \
2717        -label {Visualize Current Branch} \
2718        -command {do_gitk {}} \
2719        -font font_ui
2720if {![is_MacOSX]} {
2721        .mbar.repository add command \
2722                -label {Visualize All Branches} \
2723                -command {do_gitk {--all}} \
2724                -font font_ui
2725}
2726.mbar.repository add separator
2727
2728if {!$single_commit} {
2729        .mbar.repository add command -label {Repack Database} \
2730                -command do_repack \
2731                -font font_ui
2732
2733        .mbar.repository add command -label {Verify Database} \
2734                -command do_fsck_objects \
2735                -font font_ui
2736
2737        .mbar.repository add separator
2738
2739        if {[is_Windows]} {
2740                .mbar.repository add command \
2741                        -label {Create Desktop Icon} \
2742                        -command do_windows_shortcut \
2743                        -font font_ui
2744        } elseif {[is_MacOSX]} {
2745                .mbar.repository add command \
2746                        -label {Create Desktop Icon} \
2747                        -command do_macosx_app \
2748                        -font font_ui
2749        }
2750}
2751.mbar.repository add command -label Quit \
2752        -command do_quit \
2753        -accelerator $M1T-Q \
2754        -font font_ui
2755
2756# -- Edit Menu
2757#
2758menu .mbar.edit
2759.mbar.edit add command -label Undo \
2760        -command {catch {[focus] edit undo}} \
2761        -accelerator $M1T-Z \
2762        -font font_ui
2763.mbar.edit add command -label Redo \
2764        -command {catch {[focus] edit redo}} \
2765        -accelerator $M1T-Y \
2766        -font font_ui
2767.mbar.edit add separator
2768.mbar.edit add command -label Cut \
2769        -command {catch {tk_textCut [focus]}} \
2770        -accelerator $M1T-X \
2771        -font font_ui
2772.mbar.edit add command -label Copy \
2773        -command {catch {tk_textCopy [focus]}} \
2774        -accelerator $M1T-C \
2775        -font font_ui
2776.mbar.edit add command -label Paste \
2777        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2778        -accelerator $M1T-V \
2779        -font font_ui
2780.mbar.edit add command -label Delete \
2781        -command {catch {[focus] delete sel.first sel.last}} \
2782        -accelerator Del \
2783        -font font_ui
2784.mbar.edit add separator
2785.mbar.edit add command -label {Select All} \
2786        -command {catch {[focus] tag add sel 0.0 end}} \
2787        -accelerator $M1T-A \
2788        -font font_ui
2789
2790# -- Commit Menu
2791#
2792menu .mbar.commit
2793
2794.mbar.commit add radiobutton \
2795        -label {New Commit} \
2796        -command do_select_commit_type \
2797        -variable selected_commit_type \
2798        -value new \
2799        -font font_ui
2800lappend disable_on_lock \
2801        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2802
2803.mbar.commit add radiobutton \
2804        -label {Amend Last Commit} \
2805        -command do_select_commit_type \
2806        -variable selected_commit_type \
2807        -value amend \
2808        -font font_ui
2809lappend disable_on_lock \
2810        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2811
2812.mbar.commit add separator
2813
2814.mbar.commit add command -label Rescan \
2815        -command do_rescan \
2816        -accelerator F5 \
2817        -font font_ui
2818lappend disable_on_lock \
2819        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2820
2821.mbar.commit add command -label {Remove From Commit} \
2822        -command do_remove_selection \
2823        -font font_ui
2824lappend disable_on_lock \
2825        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2826
2827.mbar.commit add command -label {Include In Commit} \
2828        -command do_include_selection \
2829        -font font_ui
2830lappend disable_on_lock \
2831        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2832
2833.mbar.commit add command -label {Include All In Commit} \
2834        -command do_include_all \
2835        -accelerator $M1T-I \
2836        -font font_ui
2837lappend disable_on_lock \
2838        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2839
2840.mbar.commit add separator
2841
2842.mbar.commit add command -label {Sign Off} \
2843        -command do_signoff \
2844        -accelerator $M1T-S \
2845        -font font_ui
2846
2847.mbar.commit add command -label Commit \
2848        -command do_commit \
2849        -accelerator $M1T-Return \
2850        -font font_ui
2851lappend disable_on_lock \
2852        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2853
2854# -- Transport menus
2855#
2856if {!$single_commit} {
2857        menu .mbar.fetch
2858        menu .mbar.pull
2859        menu .mbar.push
2860}
2861
2862if {[is_MacOSX]} {
2863        # -- Apple Menu (Mac OS X only)
2864        #
2865        .mbar add cascade -label Apple -menu .mbar.apple
2866        menu .mbar.apple
2867
2868        .mbar.apple add command -label "About $appname" \
2869                -command do_about \
2870                -font font_ui
2871        .mbar.apple add command -label "$appname Options..." \
2872                -command do_options \
2873                -font font_ui
2874} else {
2875        # -- Edit Menu
2876        #
2877        .mbar.edit add separator
2878        .mbar.edit add command -label {Options...} \
2879                -command do_options \
2880                -font font_ui
2881
2882        # -- Help Menu
2883        #
2884        .mbar add cascade -label Help -menu .mbar.help
2885        menu .mbar.help
2886
2887        .mbar.help add command -label "About $appname" \
2888                -command do_about \
2889                -font font_ui
2890}
2891
2892
2893# -- Main Window Layout
2894#
2895panedwindow .vpane -orient vertical
2896panedwindow .vpane.files -orient horizontal
2897.vpane add .vpane.files -sticky nsew -height 100 -width 400
2898pack .vpane -anchor n -side top -fill both -expand 1
2899
2900# -- Index File List
2901#
2902frame .vpane.files.index -height 100 -width 400
2903label .vpane.files.index.title -text {Modified Files} \
2904        -background green \
2905        -font font_ui
2906text $ui_index -background white -borderwidth 0 \
2907        -width 40 -height 10 \
2908        -font font_ui \
2909        -cursor $cursor_ptr \
2910        -yscrollcommand {.vpane.files.index.sb set} \
2911        -state disabled
2912scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2913pack .vpane.files.index.title -side top -fill x
2914pack .vpane.files.index.sb -side right -fill y
2915pack $ui_index -side left -fill both -expand 1
2916.vpane.files add .vpane.files.index -sticky nsew
2917
2918# -- Other (Add) File List
2919#
2920frame .vpane.files.other -height 100 -width 100
2921label .vpane.files.other.title -text {Untracked Files} \
2922        -background red \
2923        -font font_ui
2924text $ui_other -background white -borderwidth 0 \
2925        -width 40 -height 10 \
2926        -font font_ui \
2927        -cursor $cursor_ptr \
2928        -yscrollcommand {.vpane.files.other.sb set} \
2929        -state disabled
2930scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2931pack .vpane.files.other.title -side top -fill x
2932pack .vpane.files.other.sb -side right -fill y
2933pack $ui_other -side left -fill both -expand 1
2934.vpane.files add .vpane.files.other -sticky nsew
2935
2936foreach i [list $ui_index $ui_other] {
2937        $i tag conf in_diff -font font_uibold
2938        $i tag conf in_sel \
2939                -background [$i cget -foreground] \
2940                -foreground [$i cget -background]
2941}
2942unset i
2943
2944# -- Diff and Commit Area
2945#
2946frame .vpane.lower -height 300 -width 400
2947frame .vpane.lower.commarea
2948frame .vpane.lower.diff -relief sunken -borderwidth 1
2949pack .vpane.lower.commarea -side top -fill x
2950pack .vpane.lower.diff -side bottom -fill both -expand 1
2951.vpane add .vpane.lower -stick nsew
2952
2953# -- Commit Area Buttons
2954#
2955frame .vpane.lower.commarea.buttons
2956label .vpane.lower.commarea.buttons.l -text {} \
2957        -anchor w \
2958        -justify left \
2959        -font font_ui
2960pack .vpane.lower.commarea.buttons.l -side top -fill x
2961pack .vpane.lower.commarea.buttons -side left -fill y
2962
2963button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2964        -command do_rescan \
2965        -font font_ui
2966pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2967lappend disable_on_lock \
2968        {.vpane.lower.commarea.buttons.rescan conf -state}
2969
2970button .vpane.lower.commarea.buttons.incall -text {Include All} \
2971        -command do_include_all \
2972        -font font_ui
2973pack .vpane.lower.commarea.buttons.incall -side top -fill x
2974lappend disable_on_lock \
2975        {.vpane.lower.commarea.buttons.incall conf -state}
2976
2977button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2978        -command do_signoff \
2979        -font font_ui
2980pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2981
2982button .vpane.lower.commarea.buttons.commit -text {Commit} \
2983        -command do_commit \
2984        -font font_ui
2985pack .vpane.lower.commarea.buttons.commit -side top -fill x
2986lappend disable_on_lock \
2987        {.vpane.lower.commarea.buttons.commit conf -state}
2988
2989# -- Commit Message Buffer
2990#
2991frame .vpane.lower.commarea.buffer
2992frame .vpane.lower.commarea.buffer.header
2993set ui_comm .vpane.lower.commarea.buffer.t
2994set ui_coml .vpane.lower.commarea.buffer.header.l
2995radiobutton .vpane.lower.commarea.buffer.header.new \
2996        -text {New Commit} \
2997        -command do_select_commit_type \
2998        -variable selected_commit_type \
2999        -value new \
3000        -font font_ui
3001lappend disable_on_lock \
3002        [list .vpane.lower.commarea.buffer.header.new conf -state]
3003radiobutton .vpane.lower.commarea.buffer.header.amend \
3004        -text {Amend Last Commit} \
3005        -command do_select_commit_type \
3006        -variable selected_commit_type \
3007        -value amend \
3008        -font font_ui
3009lappend disable_on_lock \
3010        [list .vpane.lower.commarea.buffer.header.amend conf -state]
3011label $ui_coml \
3012        -anchor w \
3013        -justify left \
3014        -font font_ui
3015proc trace_commit_type {varname args} {
3016        global ui_coml commit_type
3017        switch -glob -- $commit_type {
3018        initial       {set txt {Initial Commit Message:}}
3019        amend         {set txt {Amended Commit Message:}}
3020        amend-initial {set txt {Amended Initial Commit Message:}}
3021        amend-merge   {set txt {Amended Merge Commit Message:}}
3022        merge         {set txt {Merge Commit Message:}}
3023        *             {set txt {Commit Message:}}
3024        }
3025        $ui_coml conf -text $txt
3026}
3027trace add variable commit_type write trace_commit_type
3028pack $ui_coml -side left -fill x
3029pack .vpane.lower.commarea.buffer.header.amend -side right
3030pack .vpane.lower.commarea.buffer.header.new -side right
3031
3032text $ui_comm -background white -borderwidth 1 \
3033        -undo true \
3034        -maxundo 20 \
3035        -autoseparators true \
3036        -relief sunken \
3037        -width 75 -height 9 -wrap none \
3038        -font font_diff \
3039        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3040scrollbar .vpane.lower.commarea.buffer.sby \
3041        -command [list $ui_comm yview]
3042pack .vpane.lower.commarea.buffer.header -side top -fill x
3043pack .vpane.lower.commarea.buffer.sby -side right -fill y
3044pack $ui_comm -side left -fill y
3045pack .vpane.lower.commarea.buffer -side left -fill y
3046
3047# -- Commit Message Buffer Context Menu
3048#
3049set ctxm .vpane.lower.commarea.buffer.ctxm
3050menu $ctxm -tearoff 0
3051$ctxm add command \
3052        -label {Cut} \
3053        -font font_ui \
3054        -command {tk_textCut $ui_comm}
3055$ctxm add command \
3056        -label {Copy} \
3057        -font font_ui \
3058        -command {tk_textCopy $ui_comm}
3059$ctxm add command \
3060        -label {Paste} \
3061        -font font_ui \
3062        -command {tk_textPaste $ui_comm}
3063$ctxm add command \
3064        -label {Delete} \
3065        -font font_ui \
3066        -command {$ui_comm delete sel.first sel.last}
3067$ctxm add separator
3068$ctxm add command \
3069        -label {Select All} \
3070        -font font_ui \
3071        -command {$ui_comm tag add sel 0.0 end}
3072$ctxm add command \
3073        -label {Copy All} \
3074        -font font_ui \
3075        -command {
3076                $ui_comm tag add sel 0.0 end
3077                tk_textCopy $ui_comm
3078                $ui_comm tag remove sel 0.0 end
3079        }
3080$ctxm add separator
3081$ctxm add command \
3082        -label {Sign Off} \
3083        -font font_ui \
3084        -command do_signoff
3085bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3086
3087# -- Diff Header
3088#
3089set current_diff {}
3090set diff_actions [list]
3091proc trace_current_diff {varname args} {
3092        global current_diff diff_actions file_states
3093        if {$current_diff eq {}} {
3094                set s {}
3095                set f {}
3096                set p {}
3097                set o disabled
3098        } else {
3099                set p $current_diff
3100                set s [mapdesc [lindex $file_states($p) 0] $p]
3101                set f {File:}
3102                set p [escape_path $p]
3103                set o normal
3104        }
3105
3106        .vpane.lower.diff.header.status configure -text $s
3107        .vpane.lower.diff.header.file configure -text $f
3108        .vpane.lower.diff.header.path configure -text $p
3109        foreach w $diff_actions {
3110                uplevel #0 $w $o
3111        }
3112}
3113trace add variable current_diff write trace_current_diff
3114
3115frame .vpane.lower.diff.header -background orange
3116label .vpane.lower.diff.header.status \
3117        -background orange \
3118        -width $max_status_desc \
3119        -anchor w \
3120        -justify left \
3121        -font font_ui
3122label .vpane.lower.diff.header.file \
3123        -background orange \
3124        -anchor w \
3125        -justify left \
3126        -font font_ui
3127label .vpane.lower.diff.header.path \
3128        -background orange \
3129        -anchor w \
3130        -justify left \
3131        -font font_ui
3132pack .vpane.lower.diff.header.status -side left
3133pack .vpane.lower.diff.header.file -side left
3134pack .vpane.lower.diff.header.path -fill x
3135set ctxm .vpane.lower.diff.header.ctxm
3136menu $ctxm -tearoff 0
3137$ctxm add command \
3138        -label {Copy} \
3139        -font font_ui \
3140        -command {
3141                clipboard clear
3142                clipboard append \
3143                        -format STRING \
3144                        -type STRING \
3145                        -- $current_diff
3146        }
3147lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3148bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3149
3150# -- Diff Body
3151#
3152frame .vpane.lower.diff.body
3153set ui_diff .vpane.lower.diff.body.t
3154text $ui_diff -background white -borderwidth 0 \
3155        -width 80 -height 15 -wrap none \
3156        -font font_diff \
3157        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3158        -yscrollcommand {.vpane.lower.diff.body.sby set} \
3159        -state disabled
3160scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3161        -command [list $ui_diff xview]
3162scrollbar .vpane.lower.diff.body.sby -orient vertical \
3163        -command [list $ui_diff yview]
3164pack .vpane.lower.diff.body.sbx -side bottom -fill x
3165pack .vpane.lower.diff.body.sby -side right -fill y
3166pack $ui_diff -side left -fill both -expand 1
3167pack .vpane.lower.diff.header -side top -fill x
3168pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3169
3170$ui_diff tag conf d_@ -font font_diffbold
3171$ui_diff tag conf d_+  -foreground blue
3172$ui_diff tag conf d_-  -foreground red
3173$ui_diff tag conf d_++ -foreground {#00a000}
3174$ui_diff tag conf d_-- -foreground {#a000a0}
3175$ui_diff tag conf d_+- \
3176        -foreground red \
3177        -background {light goldenrod yellow}
3178$ui_diff tag conf d_-+ \
3179        -foreground blue \
3180        -background azure2
3181
3182# -- Diff Body Context Menu
3183#
3184set ctxm .vpane.lower.diff.body.ctxm
3185menu $ctxm -tearoff 0
3186$ctxm add command \
3187        -label {Copy} \
3188        -font font_ui \
3189        -command {tk_textCopy $ui_diff}
3190lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3191$ctxm add command \
3192        -label {Select All} \
3193        -font font_ui \
3194        -command {$ui_diff tag add sel 0.0 end}
3195lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3196$ctxm add command \
3197        -label {Copy All} \
3198        -font font_ui \
3199        -command {
3200                $ui_diff tag add sel 0.0 end
3201                tk_textCopy $ui_diff
3202                $ui_diff tag remove sel 0.0 end
3203        }
3204lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3205$ctxm add separator
3206$ctxm add command \
3207        -label {Decrease Font Size} \
3208        -font font_ui \
3209        -command {incr_font_size font_diff -1}
3210lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3211$ctxm add command \
3212        -label {Increase Font Size} \
3213        -font font_ui \
3214        -command {incr_font_size font_diff 1}
3215lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3216$ctxm add separator
3217$ctxm add command \
3218        -label {Show Less Context} \
3219        -font font_ui \
3220        -command {if {$repo_config(gui.diffcontext) >= 2} {
3221                incr repo_config(gui.diffcontext) -1
3222                reshow_diff
3223        }}
3224lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3225$ctxm add command \
3226        -label {Show More Context} \
3227        -font font_ui \
3228        -command {
3229                incr repo_config(gui.diffcontext)
3230                reshow_diff
3231        }
3232lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3233$ctxm add separator
3234$ctxm add command -label {Options...} \
3235        -font font_ui \
3236        -command do_options
3237bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3238
3239# -- Status Bar
3240#
3241set ui_status_value {Initializing...}
3242label .status -textvariable ui_status_value \
3243        -anchor w \
3244        -justify left \
3245        -borderwidth 1 \
3246        -relief sunken \
3247        -font font_ui
3248pack .status -anchor w -side bottom -fill x
3249
3250# -- Load geometry
3251#
3252catch {
3253set gm $repo_config(gui.geometry)
3254wm geometry . [lindex $gm 0]
3255.vpane sash place 0 \
3256        [lindex [.vpane sash coord 0] 0] \
3257        [lindex $gm 1]
3258.vpane.files sash place 0 \
3259        [lindex $gm 2] \
3260        [lindex [.vpane.files sash coord 0] 1]
3261unset gm
3262}
3263
3264# -- Key Bindings
3265#
3266bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3267bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3268bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3269bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3270bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3271bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3272bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3273bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3274bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3275bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3276bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3277
3278bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3279bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3280bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3281bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3282bind $ui_diff <$M1B-Key-v> {break}
3283bind $ui_diff <$M1B-Key-V> {break}
3284bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3285bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3286bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3287bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3288bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3289bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3290
3291bind .   <Destroy> do_quit
3292bind all <Key-F5> do_rescan
3293bind all <$M1B-Key-r> do_rescan
3294bind all <$M1B-Key-R> do_rescan
3295bind .   <$M1B-Key-s> do_signoff
3296bind .   <$M1B-Key-S> do_signoff
3297bind .   <$M1B-Key-i> do_include_all
3298bind .   <$M1B-Key-I> do_include_all
3299bind .   <$M1B-Key-Return> do_commit
3300bind all <$M1B-Key-q> do_quit
3301bind all <$M1B-Key-Q> do_quit
3302bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3303bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3304foreach i [list $ui_index $ui_other] {
3305        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3306        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3307        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3308}
3309unset i
3310
3311set file_lists($ui_index) [list]
3312set file_lists($ui_other) [list]
3313
3314set HEAD {}
3315set PARENT {}
3316set MERGE_HEAD [list]
3317set commit_type {}
3318set empty_tree {}
3319set current_diff {}
3320set selected_commit_type new
3321
3322wm title . "$appname ([file normalize [file dirname $gitdir]])"
3323focus -force $ui_comm
3324
3325# -- Warn the user about environmental problems.
3326#    Cygwin's Tcl does *not* pass its env array
3327#    onto any processes it spawns.  This means
3328#    that the git processes get none of our
3329#    environment.  That may not work...
3330#
3331if {[is_Windows]} {
3332        set ignored_env 0
3333        set suggest_user {}
3334        set msg "Possible environment issues exist.
3335
3336The following environment variables are probably
3337going to be ignored by any Git subprocess run
3338by $appname:
3339
3340"
3341        foreach name [array names env] {
3342                switch -regexp -- $name {
3343                {^GIT_INDEX_FILE$} -
3344                {^GIT_OBJECT_DIRECTORY$} -
3345                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3346                {^GIT_DIFF_OPTS$} -
3347                {^GIT_EXTERNAL_DIFF$} -
3348                {^GIT_PAGER$} -
3349                {^GIT_TRACE$} -
3350                {^GIT_CONFIG$} -
3351                {^GIT_CONFIG_LOCAL$} -
3352                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3353                        append msg " - $name\n"
3354                        incr ignored_env
3355                }
3356                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3357                        append msg " - $name\n"
3358                        incr ignored_env
3359                        set suggest_user $name
3360                }
3361                }
3362        }
3363        if {$ignored_env > 0} {
3364                append msg "
3365This is due to a known issue with the
3366Tcl binary distributed by Cygwin."
3367
3368                if {$suggest_user ne {}} {
3369                        append msg "
3370
3371A good replacement for $suggest_user
3372is placing values for the user.name and
3373user.email settings into your personal
3374~/.gitconfig file.
3375"
3376                }
3377                warn_popup $msg
3378        }
3379        unset ignored_env msg suggest_user name
3380}
3381
3382if {!$single_commit} {
3383        load_all_remotes
3384        populate_fetch_menu .mbar.fetch
3385        populate_pull_menu .mbar.pull
3386        populate_push_menu .mbar.push
3387}
3388lock_index begin-read
3389after 1 do_rescan