34a1daa44d55146c2ac43e4c7a070cd6ce184b98
   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_m eq {__}} {
1281                set lno [lsearch -sorted $file_lists($old_w) $path]
1282                if {$lno >= 0} {
1283                        set file_lists($old_w) \
1284                                [lreplace $file_lists($old_w) $lno $lno]
1285                        incr lno
1286                        $old_w conf -state normal
1287                        $old_w delete $lno.0 [expr {$lno + 1}].0
1288                        $old_w conf -state disabled
1289                }
1290                unset file_states($path)
1291                catch {unset selected_paths($path)}
1292                return
1293        }
1294
1295        if {$new_w ne $old_w} {
1296                set lno [lsearch -sorted $file_lists($old_w) $path]
1297                if {$lno >= 0} {
1298                        set file_lists($old_w) \
1299                                [lreplace $file_lists($old_w) $lno $lno]
1300                        incr lno
1301                        $old_w conf -state normal
1302                        $old_w delete $lno.0 [expr {$lno + 1}].0
1303                        $old_w conf -state disabled
1304                }
1305
1306                lappend file_lists($new_w) $path
1307                set file_lists($new_w) [lsort $file_lists($new_w)]
1308                set lno [lsearch -sorted $file_lists($new_w) $path]
1309                incr lno
1310                $new_w conf -state normal
1311                $new_w image create $lno.0 \
1312                        -align center -padx 5 -pady 1 \
1313                        -name [lindex $s 1] \
1314                        -image $new_icon
1315                $new_w insert $lno.1 "[escape_path $path]\n"
1316                if {[catch {set in_sel $selected_paths($path)}]} {
1317                        set in_sel 0
1318                }
1319                if {$in_sel} {
1320                        $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1321                }
1322                $new_w conf -state disabled
1323        } elseif {$new_icon ne [mapicon $old_m $path]} {
1324                $new_w conf -state normal
1325                $new_w image conf [lindex $s 1] -image $new_icon
1326                $new_w conf -state disabled
1327        }
1328}
1329
1330proc display_all_files {} {
1331        global ui_index ui_other
1332        global file_states file_lists
1333        global last_clicked selected_paths
1334
1335        $ui_index conf -state normal
1336        $ui_other conf -state normal
1337
1338        $ui_index delete 0.0 end
1339        $ui_other delete 0.0 end
1340        set last_clicked {}
1341
1342        set file_lists($ui_index) [list]
1343        set file_lists($ui_other) [list]
1344
1345        foreach path [lsort [array names file_states]] {
1346                set s $file_states($path)
1347                set m [lindex $s 0]
1348                set w [mapcol $m $path]
1349                lappend file_lists($w) $path
1350                set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1351                $w image create end \
1352                        -align center -padx 5 -pady 1 \
1353                        -name [lindex $s 1] \
1354                        -image [mapicon $m $path]
1355                $w insert end "[escape_path $path]\n"
1356                if {[catch {set in_sel $selected_paths($path)}]} {
1357                        set in_sel 0
1358                }
1359                if {$in_sel} {
1360                        $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1361                }
1362        }
1363
1364        $ui_index conf -state disabled
1365        $ui_other conf -state disabled
1366}
1367
1368proc update_indexinfo {msg pathList after} {
1369        global update_index_cp ui_status_value
1370
1371        if {![lock_index update]} return
1372
1373        set update_index_cp 0
1374        set pathList [lsort $pathList]
1375        set totalCnt [llength $pathList]
1376        set batch [expr {int($totalCnt * .01) + 1}]
1377        if {$batch > 25} {set batch 25}
1378
1379        set ui_status_value [format \
1380                "$msg... %i/%i files (%.2f%%)" \
1381                $update_index_cp \
1382                $totalCnt \
1383                0.0]
1384        set fd [open "| git update-index -z --index-info" w]
1385        fconfigure $fd \
1386                -blocking 0 \
1387                -buffering full \
1388                -buffersize 512 \
1389                -translation binary
1390        fileevent $fd writable [list \
1391                write_update_indexinfo \
1392                $fd \
1393                $pathList \
1394                $totalCnt \
1395                $batch \
1396                $msg \
1397                $after \
1398                ]
1399}
1400
1401proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1402        global update_index_cp ui_status_value
1403        global file_states current_diff
1404
1405        if {$update_index_cp >= $totalCnt} {
1406                close $fd
1407                unlock_index
1408                uplevel #0 $after
1409                return
1410        }
1411
1412        for {set i $batch} \
1413                {$update_index_cp < $totalCnt && $i > 0} \
1414                {incr i -1} {
1415                set path [lindex $pathList $update_index_cp]
1416                incr update_index_cp
1417
1418                set s $file_states($path)
1419                switch -glob -- [lindex $s 0] {
1420                A? {set new _O}
1421                M? {set new _M}
1422                D? {set new _?}
1423                ?? {continue}
1424                }
1425                set info [lindex $s 2]
1426                if {$info eq {}} continue
1427
1428                puts -nonewline $fd $info
1429                puts -nonewline $fd "\t"
1430                puts -nonewline $fd $path
1431                puts -nonewline $fd "\0"
1432                display_file $path $new
1433        }
1434
1435        set ui_status_value [format \
1436                "$msg... %i/%i files (%.2f%%)" \
1437                $update_index_cp \
1438                $totalCnt \
1439                [expr {100.0 * $update_index_cp / $totalCnt}]]
1440}
1441
1442proc update_index {msg pathList after} {
1443        global update_index_cp ui_status_value
1444
1445        if {![lock_index update]} return
1446
1447        set update_index_cp 0
1448        set pathList [lsort $pathList]
1449        set totalCnt [llength $pathList]
1450        set batch [expr {int($totalCnt * .01) + 1}]
1451        if {$batch > 25} {set batch 25}
1452
1453        set ui_status_value [format \
1454                "$msg... %i/%i files (%.2f%%)" \
1455                $update_index_cp \
1456                $totalCnt \
1457                0.0]
1458        set fd [open "| git update-index --add --remove -z --stdin" w]
1459        fconfigure $fd \
1460                -blocking 0 \
1461                -buffering full \
1462                -buffersize 512 \
1463                -translation binary
1464        fileevent $fd writable [list \
1465                write_update_index \
1466                $fd \
1467                $pathList \
1468                $totalCnt \
1469                $batch \
1470                $msg \
1471                $after \
1472                ]
1473}
1474
1475proc write_update_index {fd pathList totalCnt batch msg after} {
1476        global update_index_cp ui_status_value
1477        global file_states current_diff
1478
1479        if {$update_index_cp >= $totalCnt} {
1480                close $fd
1481                unlock_index
1482                uplevel #0 $after
1483                return
1484        }
1485
1486        for {set i $batch} \
1487                {$update_index_cp < $totalCnt && $i > 0} \
1488                {incr i -1} {
1489                set path [lindex $pathList $update_index_cp]
1490                incr update_index_cp
1491
1492                switch -glob -- [lindex $file_states($path) 0] {
1493                AD -
1494                MD -
1495                _D {set new DD}
1496
1497                _M -
1498                MM -
1499                M_ {set new M_}
1500
1501                _O -
1502                AM -
1503                A_ {set new A_}
1504
1505                ?? {continue}
1506                }
1507
1508                puts -nonewline $fd $path
1509                puts -nonewline $fd "\0"
1510                display_file $path $new
1511        }
1512
1513        set ui_status_value [format \
1514                "$msg... %i/%i files (%.2f%%)" \
1515                $update_index_cp \
1516                $totalCnt \
1517                [expr {100.0 * $update_index_cp / $totalCnt}]]
1518}
1519
1520proc checkout_index {msg pathList after} {
1521        global update_index_cp ui_status_value
1522
1523        if {![lock_index update]} return
1524
1525        set update_index_cp 0
1526        set pathList [lsort $pathList]
1527        set totalCnt [llength $pathList]
1528        set batch [expr {int($totalCnt * .01) + 1}]
1529        if {$batch > 25} {set batch 25}
1530
1531        set ui_status_value [format \
1532                "$msg... %i/%i files (%.2f%%)" \
1533                $update_index_cp \
1534                $totalCnt \
1535                0.0]
1536        set cmd [list git checkout-index]
1537        lappend cmd --index
1538        lappend cmd --quiet
1539        lappend cmd --force
1540        lappend cmd -z
1541        lappend cmd --stdin
1542        set fd [open "| $cmd " w]
1543        fconfigure $fd \
1544                -blocking 0 \
1545                -buffering full \
1546                -buffersize 512 \
1547                -translation binary
1548        fileevent $fd writable [list \
1549                write_checkout_index \
1550                $fd \
1551                $pathList \
1552                $totalCnt \
1553                $batch \
1554                $msg \
1555                $after \
1556                ]
1557}
1558
1559proc write_checkout_index {fd pathList totalCnt batch msg after} {
1560        global update_index_cp ui_status_value
1561        global file_states current_diff
1562
1563        if {$update_index_cp >= $totalCnt} {
1564                close $fd
1565                unlock_index
1566                uplevel #0 $after
1567                return
1568        }
1569
1570        for {set i $batch} \
1571                {$update_index_cp < $totalCnt && $i > 0} \
1572                {incr i -1} {
1573                set path [lindex $pathList $update_index_cp]
1574                incr update_index_cp
1575
1576                switch -glob -- [lindex $file_states($path) 0] {
1577                AM -
1578                AD {set new A_}
1579                MM -
1580                MD {set new M_}
1581                _M -
1582                _D {set new __}
1583                ?? {continue}
1584                }
1585
1586                puts -nonewline $fd $path
1587                puts -nonewline $fd "\0"
1588                display_file $path $new
1589        }
1590
1591        set ui_status_value [format \
1592                "$msg... %i/%i files (%.2f%%)" \
1593                $update_index_cp \
1594                $totalCnt \
1595                [expr {100.0 * $update_index_cp / $totalCnt}]]
1596}
1597
1598######################################################################
1599##
1600## remote management
1601
1602proc load_all_remotes {} {
1603        global gitdir all_remotes repo_config
1604
1605        set all_remotes [list]
1606        set rm_dir [file join $gitdir remotes]
1607        if {[file isdirectory $rm_dir]} {
1608                set all_remotes [concat $all_remotes [glob \
1609                        -types f \
1610                        -tails \
1611                        -nocomplain \
1612                        -directory $rm_dir *]]
1613        }
1614
1615        foreach line [array names repo_config remote.*.url] {
1616                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1617                        lappend all_remotes $name
1618                }
1619        }
1620
1621        set all_remotes [lsort -unique $all_remotes]
1622}
1623
1624proc populate_fetch_menu {m} {
1625        global gitdir all_remotes repo_config
1626
1627        foreach r $all_remotes {
1628                set enable 0
1629                if {![catch {set a $repo_config(remote.$r.url)}]} {
1630                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1631                                set enable 1
1632                        }
1633                } else {
1634                        catch {
1635                                set fd [open [file join $gitdir remotes $r] r]
1636                                while {[gets $fd n] >= 0} {
1637                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1638                                                set enable 1
1639                                                break
1640                                        }
1641                                }
1642                                close $fd
1643                        }
1644                }
1645
1646                if {$enable} {
1647                        $m add command \
1648                                -label "Fetch from $r..." \
1649                                -command [list fetch_from $r] \
1650                                -font font_ui
1651                }
1652        }
1653}
1654
1655proc populate_push_menu {m} {
1656        global gitdir all_remotes repo_config
1657
1658        foreach r $all_remotes {
1659                set enable 0
1660                if {![catch {set a $repo_config(remote.$r.url)}]} {
1661                        if {![catch {set a $repo_config(remote.$r.push)}]} {
1662                                set enable 1
1663                        }
1664                } else {
1665                        catch {
1666                                set fd [open [file join $gitdir remotes $r] r]
1667                                while {[gets $fd n] >= 0} {
1668                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1669                                                set enable 1
1670                                                break
1671                                        }
1672                                }
1673                                close $fd
1674                        }
1675                }
1676
1677                if {$enable} {
1678                        $m add command \
1679                                -label "Push to $r..." \
1680                                -command [list push_to $r] \
1681                                -font font_ui
1682                }
1683        }
1684}
1685
1686proc populate_pull_menu {m} {
1687        global gitdir repo_config all_remotes disable_on_lock
1688
1689        foreach remote $all_remotes {
1690                set rb {}
1691                if {[array get repo_config remote.$remote.url] ne {}} {
1692                        if {[array get repo_config remote.$remote.fetch] ne {}} {
1693                                regexp {^([^:]+):} \
1694                                        [lindex $repo_config(remote.$remote.fetch) 0] \
1695                                        line rb
1696                        }
1697                } else {
1698                        catch {
1699                                set fd [open [file join $gitdir remotes $remote] r]
1700                                while {[gets $fd line] >= 0} {
1701                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1702                                                break
1703                                        }
1704                                }
1705                                close $fd
1706                        }
1707                }
1708
1709                set rb_short $rb
1710                regsub ^refs/heads/ $rb {} rb_short
1711                if {$rb_short ne {}} {
1712                        $m add command \
1713                                -label "Branch $rb_short from $remote..." \
1714                                -command [list pull_remote $remote $rb] \
1715                                -font font_ui
1716                        lappend disable_on_lock \
1717                                [list $m entryconf [$m index last] -state]
1718                }
1719        }
1720}
1721
1722######################################################################
1723##
1724## icons
1725
1726set filemask {
1727#define mask_width 14
1728#define mask_height 15
1729static unsigned char mask_bits[] = {
1730   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1731   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1732   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1733}
1734
1735image create bitmap file_plain -background white -foreground black -data {
1736#define plain_width 14
1737#define plain_height 15
1738static unsigned char plain_bits[] = {
1739   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1740   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1741   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1742} -maskdata $filemask
1743
1744image create bitmap file_mod -background white -foreground blue -data {
1745#define mod_width 14
1746#define mod_height 15
1747static unsigned char mod_bits[] = {
1748   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1749   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1750   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1751} -maskdata $filemask
1752
1753image create bitmap file_fulltick -background white -foreground "#007000" -data {
1754#define file_fulltick_width 14
1755#define file_fulltick_height 15
1756static unsigned char file_fulltick_bits[] = {
1757   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1758   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1759   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1760} -maskdata $filemask
1761
1762image create bitmap file_parttick -background white -foreground "#005050" -data {
1763#define parttick_width 14
1764#define parttick_height 15
1765static unsigned char parttick_bits[] = {
1766   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1767   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1768   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1769} -maskdata $filemask
1770
1771image create bitmap file_question -background white -foreground black -data {
1772#define file_question_width 14
1773#define file_question_height 15
1774static unsigned char file_question_bits[] = {
1775   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1776   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1777   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1778} -maskdata $filemask
1779
1780image create bitmap file_removed -background white -foreground red -data {
1781#define file_removed_width 14
1782#define file_removed_height 15
1783static unsigned char file_removed_bits[] = {
1784   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1785   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1786   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1787} -maskdata $filemask
1788
1789image create bitmap file_merge -background white -foreground blue -data {
1790#define file_merge_width 14
1791#define file_merge_height 15
1792static unsigned char file_merge_bits[] = {
1793   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1794   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1795   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1796} -maskdata $filemask
1797
1798set ui_index .vpane.files.index.list
1799set ui_other .vpane.files.other.list
1800set max_status_desc 0
1801foreach i {
1802                {__ i plain    "Unmodified"}
1803                {_M i mod      "Modified"}
1804                {M_ i fulltick "Included in commit"}
1805                {MM i parttick "Partially included"}
1806                {MD i question "Included (but gone)"}
1807
1808                {_O o plain    "Untracked"}
1809                {A_ o fulltick "Added by commit"}
1810                {AM o parttick "Partially added"}
1811                {AD o question "Added (but gone)"}
1812
1813                {_D i question "Missing"}
1814                {DD i removed  "Removed by commit"}
1815                {DO i removed  "Removed (still exists)"}
1816                {DM i removed  "Removed (but modified)"}
1817
1818                {UD i merge    "Merge conflicts"}
1819                {UM i merge    "Merge conflicts"}
1820                {U_ i merge    "Merge conflicts"}
1821        } {
1822        if {$max_status_desc < [string length [lindex $i 3]]} {
1823                set max_status_desc [string length [lindex $i 3]]
1824        }
1825        if {[lindex $i 1] eq {i}} {
1826                set all_cols([lindex $i 0]) $ui_index
1827        } else {
1828                set all_cols([lindex $i 0]) $ui_other
1829        }
1830        set all_icons([lindex $i 0]) file_[lindex $i 2]
1831        set all_descs([lindex $i 0]) [lindex $i 3]
1832}
1833unset filemask i
1834
1835######################################################################
1836##
1837## util
1838
1839proc is_MacOSX {} {
1840        global tcl_platform tk_library
1841        if {[tk windowingsystem] eq {aqua}} {
1842                return 1
1843        }
1844        return 0
1845}
1846
1847proc is_Windows {} {
1848        global tcl_platform
1849        if {$tcl_platform(platform) eq {windows}} {
1850                return 1
1851        }
1852        return 0
1853}
1854
1855proc bind_button3 {w cmd} {
1856        bind $w <Any-Button-3> $cmd
1857        if {[is_MacOSX]} {
1858                bind $w <Control-Button-1> $cmd
1859        }
1860}
1861
1862proc incr_font_size {font {amt 1}} {
1863        set sz [font configure $font -size]
1864        incr sz $amt
1865        font configure $font -size $sz
1866        font configure ${font}bold -size $sz
1867}
1868
1869proc hook_failed_popup {hook msg} {
1870        global gitdir appname
1871
1872        set w .hookfail
1873        toplevel $w
1874
1875        frame $w.m
1876        label $w.m.l1 -text "$hook hook failed:" \
1877                -anchor w \
1878                -justify left \
1879                -font font_uibold
1880        text $w.m.t \
1881                -background white -borderwidth 1 \
1882                -relief sunken \
1883                -width 80 -height 10 \
1884                -font font_diff \
1885                -yscrollcommand [list $w.m.sby set]
1886        label $w.m.l2 \
1887                -text {You must correct the above errors before committing.} \
1888                -anchor w \
1889                -justify left \
1890                -font font_uibold
1891        scrollbar $w.m.sby -command [list $w.m.t yview]
1892        pack $w.m.l1 -side top -fill x
1893        pack $w.m.l2 -side bottom -fill x
1894        pack $w.m.sby -side right -fill y
1895        pack $w.m.t -side left -fill both -expand 1
1896        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1897
1898        $w.m.t insert 1.0 $msg
1899        $w.m.t conf -state disabled
1900
1901        button $w.ok -text OK \
1902                -width 15 \
1903                -font font_ui \
1904                -command "destroy $w"
1905        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1906
1907        bind $w <Visibility> "grab $w; focus $w"
1908        bind $w <Key-Return> "destroy $w"
1909        wm title $w "$appname ([lindex [file split \
1910                [file normalize [file dirname $gitdir]]] \
1911                end]): error"
1912        tkwait window $w
1913}
1914
1915set next_console_id 0
1916
1917proc new_console {short_title long_title} {
1918        global next_console_id console_data
1919        set w .console[incr next_console_id]
1920        set console_data($w) [list $short_title $long_title]
1921        return [console_init $w]
1922}
1923
1924proc console_init {w} {
1925        global console_cr console_data
1926        global gitdir appname M1B
1927
1928        set console_cr($w) 1.0
1929        toplevel $w
1930        frame $w.m
1931        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1932                -anchor w \
1933                -justify left \
1934                -font font_uibold
1935        text $w.m.t \
1936                -background white -borderwidth 1 \
1937                -relief sunken \
1938                -width 80 -height 10 \
1939                -font font_diff \
1940                -state disabled \
1941                -yscrollcommand [list $w.m.sby set]
1942        label $w.m.s -text {Working... please wait...} \
1943                -anchor w \
1944                -justify left \
1945                -font font_uibold
1946        scrollbar $w.m.sby -command [list $w.m.t yview]
1947        pack $w.m.l1 -side top -fill x
1948        pack $w.m.s -side bottom -fill x
1949        pack $w.m.sby -side right -fill y
1950        pack $w.m.t -side left -fill both -expand 1
1951        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1952
1953        menu $w.ctxm -tearoff 0
1954        $w.ctxm add command -label "Copy" \
1955                -font font_ui \
1956                -command "tk_textCopy $w.m.t"
1957        $w.ctxm add command -label "Select All" \
1958                -font font_ui \
1959                -command "$w.m.t tag add sel 0.0 end"
1960        $w.ctxm add command -label "Copy All" \
1961                -font font_ui \
1962                -command "
1963                        $w.m.t tag add sel 0.0 end
1964                        tk_textCopy $w.m.t
1965                        $w.m.t tag remove sel 0.0 end
1966                "
1967
1968        button $w.ok -text {Close} \
1969                -font font_ui \
1970                -state disabled \
1971                -command "destroy $w"
1972        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1973
1974        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1975        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1976        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1977        bind $w <Visibility> "focus $w"
1978        wm title $w "$appname ([lindex [file split \
1979                [file normalize [file dirname $gitdir]]] \
1980                end]): [lindex $console_data($w) 0]"
1981        return $w
1982}
1983
1984proc console_exec {w cmd {after {}}} {
1985        # -- Windows tosses the enviroment when we exec our child.
1986        #    But most users need that so we have to relogin. :-(
1987        #
1988        if {[is_Windows]} {
1989                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1990        }
1991
1992        # -- Tcl won't let us redirect both stdout and stderr to
1993        #    the same pipe.  So pass it through cat...
1994        #
1995        set cmd [concat | $cmd |& cat]
1996
1997        set fd_f [open $cmd r]
1998        fconfigure $fd_f -blocking 0 -translation binary
1999        fileevent $fd_f readable [list console_read $w $fd_f $after]
2000}
2001
2002proc console_read {w fd after} {
2003        global console_cr console_data
2004
2005        set buf [read $fd]
2006        if {$buf ne {}} {
2007                if {![winfo exists $w]} {console_init $w}
2008                $w.m.t conf -state normal
2009                set c 0
2010                set n [string length $buf]
2011                while {$c < $n} {
2012                        set cr [string first "\r" $buf $c]
2013                        set lf [string first "\n" $buf $c]
2014                        if {$cr < 0} {set cr [expr {$n + 1}]}
2015                        if {$lf < 0} {set lf [expr {$n + 1}]}
2016
2017                        if {$lf < $cr} {
2018                                $w.m.t insert end [string range $buf $c $lf]
2019                                set console_cr($w) [$w.m.t index {end -1c}]
2020                                set c $lf
2021                                incr c
2022                        } else {
2023                                $w.m.t delete $console_cr($w) end
2024                                $w.m.t insert end "\n"
2025                                $w.m.t insert end [string range $buf $c $cr]
2026                                set c $cr
2027                                incr c
2028                        }
2029                }
2030                $w.m.t conf -state disabled
2031                $w.m.t see end
2032        }
2033
2034        fconfigure $fd -blocking 1
2035        if {[eof $fd]} {
2036                if {[catch {close $fd}]} {
2037                        if {![winfo exists $w]} {console_init $w}
2038                        $w.m.s conf -background red -text {Error: Command Failed}
2039                        $w.ok conf -state normal
2040                        set ok 0
2041                } elseif {[winfo exists $w]} {
2042                        $w.m.s conf -background green -text {Success}
2043                        $w.ok conf -state normal
2044                        set ok 1
2045                }
2046                array unset console_cr $w
2047                array unset console_data $w
2048                if {$after ne {}} {
2049                        uplevel #0 $after $ok
2050                }
2051                return
2052        }
2053        fconfigure $fd -blocking 0
2054}
2055
2056######################################################################
2057##
2058## ui commands
2059
2060set starting_gitk_msg {Please wait... Starting gitk...}
2061
2062proc do_gitk {revs} {
2063        global ui_status_value starting_gitk_msg
2064
2065        set cmd gitk
2066        if {$revs ne {}} {
2067                append cmd { }
2068                append cmd $revs
2069        }
2070        if {[is_Windows]} {
2071                set cmd "sh -c \"exec $cmd\""
2072        }
2073        append cmd { &}
2074
2075        if {[catch {eval exec $cmd} err]} {
2076                error_popup "Failed to start gitk:\n\n$err"
2077        } else {
2078                set ui_status_value $starting_gitk_msg
2079                after 10000 {
2080                        if {$ui_status_value eq $starting_gitk_msg} {
2081                                set ui_status_value {Ready.}
2082                        }
2083                }
2084        }
2085}
2086
2087proc do_repack {} {
2088        set w [new_console {repack} \
2089                {Repacking the object database}]
2090        set cmd [list git repack]
2091        lappend cmd -a
2092        lappend cmd -d
2093        console_exec $w $cmd
2094}
2095
2096proc do_fsck_objects {} {
2097        set w [new_console {fsck-objects} \
2098                {Verifying the object database with fsck-objects}]
2099        set cmd [list git fsck-objects]
2100        lappend cmd --full
2101        lappend cmd --cache
2102        lappend cmd --strict
2103        console_exec $w $cmd
2104}
2105
2106set is_quitting 0
2107
2108proc do_quit {} {
2109        global gitdir ui_comm is_quitting repo_config commit_type
2110
2111        if {$is_quitting} return
2112        set is_quitting 1
2113
2114        # -- Stash our current commit buffer.
2115        #
2116        set save [file join $gitdir GITGUI_MSG]
2117        set msg [string trim [$ui_comm get 0.0 end]]
2118        if {![string match amend* $commit_type]
2119                && [$ui_comm edit modified]
2120                && $msg ne {}} {
2121                catch {
2122                        set fd [open $save w]
2123                        puts $fd [string trim [$ui_comm get 0.0 end]]
2124                        close $fd
2125                }
2126        } else {
2127                catch {file delete $save}
2128        }
2129
2130        # -- Stash our current window geometry into this repository.
2131        #
2132        set cfg_geometry [list]
2133        lappend cfg_geometry [wm geometry .]
2134        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2135        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2136        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2137                set rc_geometry {}
2138        }
2139        if {$cfg_geometry ne $rc_geometry} {
2140                catch {exec git repo-config gui.geometry $cfg_geometry}
2141        }
2142
2143        destroy .
2144}
2145
2146proc do_rescan {} {
2147        rescan {set ui_status_value {Ready.}}
2148}
2149
2150proc remove_helper {txt paths} {
2151        global file_states current_diff
2152
2153        if {![lock_index begin-update]} return
2154
2155        set pathList [list]
2156        set after {}
2157        foreach path $paths {
2158                switch -glob -- [lindex $file_states($path) 0] {
2159                A? -
2160                M? -
2161                D? {
2162                        lappend pathList $path
2163                        if {$path eq $current_diff} {
2164                                set after {reshow_diff;}
2165                        }
2166                }
2167                }
2168        }
2169        if {$pathList eq {}} {
2170                unlock_index
2171        } else {
2172                update_indexinfo \
2173                        $txt \
2174                        $pathList \
2175                        [concat $after {set ui_status_value {Ready.}}]
2176        }
2177}
2178
2179proc do_remove_selection {} {
2180        global current_diff selected_paths
2181
2182        if {[array size selected_paths] > 0} {
2183                remove_helper \
2184                        {Removing selected files from commit} \
2185                        [array names selected_paths]
2186        } elseif {$current_diff ne {}} {
2187                remove_helper \
2188                        "Removing [short_path $current_diff] from commit" \
2189                        [list $current_diff]
2190        }
2191}
2192
2193proc include_helper {txt paths} {
2194        global file_states current_diff
2195
2196        if {![lock_index begin-update]} return
2197
2198        set pathList [list]
2199        set after {}
2200        foreach path $paths {
2201                switch -glob -- [lindex $file_states($path) 0] {
2202                AM -
2203                AD -
2204                MM -
2205                U? -
2206                _M -
2207                _D -
2208                _O {
2209                        lappend pathList $path
2210                        if {$path eq $current_diff} {
2211                                set after {reshow_diff;}
2212                        }
2213                }
2214                }
2215        }
2216        if {$pathList eq {}} {
2217                unlock_index
2218        } else {
2219                update_index \
2220                        $txt \
2221                        $pathList \
2222                        [concat $after {set ui_status_value {Ready to commit.}}]
2223        }
2224}
2225
2226proc do_include_selection {} {
2227        global current_diff selected_paths
2228
2229        if {[array size selected_paths] > 0} {
2230                include_helper \
2231                        {Including selected files} \
2232                        [array names selected_paths]
2233        } elseif {$current_diff ne {}} {
2234                include_helper \
2235                        "Including [short_path $current_diff]" \
2236                        [list $current_diff]
2237        }
2238}
2239
2240proc do_include_all {} {
2241        global file_states
2242
2243        set paths [list]
2244        foreach path [array names file_states] {
2245                switch -- [lindex $file_states($path) 0] {
2246                AM -
2247                AD -
2248                MM -
2249                _M -
2250                _D {lappend paths $path}
2251                }
2252        }
2253        include_helper \
2254                {Including all modified files} \
2255                $paths
2256}
2257
2258proc revert_helper {txt paths} {
2259        global file_states current_diff
2260
2261        if {![lock_index begin-update]} return
2262
2263        set pathList [list]
2264        set after {}
2265        foreach path $paths {
2266                switch -glob -- [lindex $file_states($path) 0] {
2267                AM -
2268                AD -
2269                MM -
2270                MD -
2271                _M -
2272                _D {
2273                        lappend pathList $path
2274                        if {$path eq $current_diff} {
2275                                set after {reshow_diff;}
2276                        }
2277                }
2278                }
2279        }
2280
2281        set n [llength $pathList]
2282        if {$n == 0} {
2283                unlock_index
2284                return
2285        } elseif {$n == 1} {
2286                set s "[short_path [lindex $pathList]]"
2287        } else {
2288                set s "these $n files"
2289        }
2290
2291        set reply [tk_dialog \
2292                .confirm_revert \
2293                "title" \
2294                "Revert unincluded changes in $s?
2295
2296Any unincluded changes will be permanently lost by the revert." \
2297                questhead \
2298                1 \
2299                {Do Nothing} \
2300                {Revert Changes} \
2301                ]
2302        if {$reply == 1} {
2303                checkout_index \
2304                        $txt \
2305                        $pathList \
2306                        [concat $after {set ui_status_value {Ready.}}]
2307        } else {
2308                unlock_index
2309        }
2310}
2311
2312proc do_revert_selection {} {
2313        global current_diff selected_paths
2314
2315        if {[array size selected_paths] > 0} {
2316                revert_helper \
2317                        {Reverting selected files} \
2318                        [array names selected_paths]
2319        } elseif {$current_diff ne {}} {
2320                revert_helper \
2321                        "Reverting [short_path $current_diff]" \
2322                        [list $current_diff]
2323        }
2324}
2325
2326proc do_signoff {} {
2327        global ui_comm
2328
2329        set me [committer_ident]
2330        if {$me eq {}} return
2331
2332        set sob "Signed-off-by: $me"
2333        set last [$ui_comm get {end -1c linestart} {end -1c}]
2334        if {$last ne $sob} {
2335                $ui_comm edit separator
2336                if {$last ne {}
2337                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2338                        $ui_comm insert end "\n"
2339                }
2340                $ui_comm insert end "\n$sob"
2341                $ui_comm edit separator
2342                $ui_comm see end
2343        }
2344}
2345
2346proc do_select_commit_type {} {
2347        global commit_type selected_commit_type
2348
2349        if {$selected_commit_type eq {new}
2350                && [string match amend* $commit_type]} {
2351                create_new_commit
2352        } elseif {$selected_commit_type eq {amend}
2353                && ![string match amend* $commit_type]} {
2354                load_last_commit
2355
2356                # The amend request was rejected...
2357                #
2358                if {![string match amend* $commit_type]} {
2359                        set selected_commit_type new
2360                }
2361        }
2362}
2363
2364proc do_commit {} {
2365        commit_tree
2366}
2367
2368proc do_about {} {
2369        global appname copyright
2370        global tcl_patchLevel tk_patchLevel
2371
2372        set w .about_dialog
2373        toplevel $w
2374        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2375
2376        label $w.header -text "About $appname" \
2377                -font font_uibold
2378        pack $w.header -side top -fill x
2379
2380        frame $w.buttons
2381        button $w.buttons.close -text {Close} \
2382                -font font_ui \
2383                -command [list destroy $w]
2384        pack $w.buttons.close -side right
2385        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2386
2387        label $w.desc \
2388                -text "$appname - a commit creation tool for Git.
2389$copyright" \
2390                -padx 5 -pady 5 \
2391                -justify left \
2392                -anchor w \
2393                -borderwidth 1 \
2394                -relief solid \
2395                -font font_ui
2396        pack $w.desc -side top -fill x -padx 5 -pady 5
2397
2398        set v [exec git --version]
2399        append v "\n\n"
2400        if {$tcl_patchLevel eq $tk_patchLevel} {
2401                append v "Tcl/Tk version $tcl_patchLevel"
2402        } else {
2403                append v "Tcl version $tcl_patchLevel"
2404                append v ", Tk version $tk_patchLevel"
2405        }
2406
2407        label $w.vers \
2408                -text $v \
2409                -padx 5 -pady 5 \
2410                -justify left \
2411                -anchor w \
2412                -borderwidth 1 \
2413                -relief solid \
2414                -font font_ui
2415        pack $w.vers -side top -fill x -padx 5 -pady 5
2416
2417        bind $w <Visibility> "grab $w; focus $w"
2418        bind $w <Key-Escape> "destroy $w"
2419        wm title $w "About $appname"
2420        tkwait window $w
2421}
2422
2423proc do_options {} {
2424        global appname gitdir font_descs
2425        global repo_config global_config
2426        global repo_config_new global_config_new
2427
2428        array unset repo_config_new
2429        array unset global_config_new
2430        foreach name [array names repo_config] {
2431                set repo_config_new($name) $repo_config($name)
2432        }
2433        load_config 1
2434        foreach name [array names repo_config] {
2435                switch -- $name {
2436                gui.diffcontext {continue}
2437                }
2438                set repo_config_new($name) $repo_config($name)
2439        }
2440        foreach name [array names global_config] {
2441                set global_config_new($name) $global_config($name)
2442        }
2443        set reponame [lindex [file split \
2444                [file normalize [file dirname $gitdir]]] \
2445                end]
2446
2447        set w .options_editor
2448        toplevel $w
2449        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2450
2451        label $w.header -text "$appname Options" \
2452                -font font_uibold
2453        pack $w.header -side top -fill x
2454
2455        frame $w.buttons
2456        button $w.buttons.restore -text {Restore Defaults} \
2457                -font font_ui \
2458                -command do_restore_defaults
2459        pack $w.buttons.restore -side left
2460        button $w.buttons.save -text Save \
2461                -font font_ui \
2462                -command [list do_save_config $w]
2463        pack $w.buttons.save -side right
2464        button $w.buttons.cancel -text {Cancel} \
2465                -font font_ui \
2466                -command [list destroy $w]
2467        pack $w.buttons.cancel -side right
2468        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2469
2470        labelframe $w.repo -text "$reponame Repository" \
2471                -font font_ui \
2472                -relief raised -borderwidth 2
2473        labelframe $w.global -text {Global (All Repositories)} \
2474                -font font_ui \
2475                -relief raised -borderwidth 2
2476        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2477        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2478
2479        foreach option {
2480                {b partialinclude {Allow Partially Included Files}}
2481                {b pullsummary {Show Pull Summary}}
2482                {b trustmtime  {Trust File Modification Timestamps}}
2483                {i diffcontext {Number of Diff Context Lines}}
2484                } {
2485                set type [lindex $option 0]
2486                set name [lindex $option 1]
2487                set text [lindex $option 2]
2488                foreach f {repo global} {
2489                        switch $type {
2490                        b {
2491                                checkbutton $w.$f.$name -text $text \
2492                                        -variable ${f}_config_new(gui.$name) \
2493                                        -onvalue true \
2494                                        -offvalue false \
2495                                        -font font_ui
2496                                pack $w.$f.$name -side top -anchor w
2497                        }
2498                        i {
2499                                frame $w.$f.$name
2500                                label $w.$f.$name.l -text "$text:" -font font_ui
2501                                pack $w.$f.$name.l -side left -anchor w -fill x
2502                                spinbox $w.$f.$name.v \
2503                                        -textvariable ${f}_config_new(gui.$name) \
2504                                        -from 1 -to 99 -increment 1 \
2505                                        -width 3 \
2506                                        -font font_ui
2507                                pack $w.$f.$name.v -side right -anchor e
2508                                pack $w.$f.$name -side top -anchor w -fill x
2509                        }
2510                        }
2511                }
2512        }
2513
2514        set all_fonts [lsort [font families]]
2515        foreach option $font_descs {
2516                set name [lindex $option 0]
2517                set font [lindex $option 1]
2518                set text [lindex $option 2]
2519
2520                set global_config_new(gui.$font^^family) \
2521                        [font configure $font -family]
2522                set global_config_new(gui.$font^^size) \
2523                        [font configure $font -size]
2524
2525                frame $w.global.$name
2526                label $w.global.$name.l -text "$text:" -font font_ui
2527                pack $w.global.$name.l -side left -anchor w -fill x
2528                eval tk_optionMenu $w.global.$name.family \
2529                        global_config_new(gui.$font^^family) \
2530                        $all_fonts
2531                spinbox $w.global.$name.size \
2532                        -textvariable global_config_new(gui.$font^^size) \
2533                        -from 2 -to 80 -increment 1 \
2534                        -width 3 \
2535                        -font font_ui
2536                pack $w.global.$name.size -side right -anchor e
2537                pack $w.global.$name.family -side right -anchor e
2538                pack $w.global.$name -side top -anchor w -fill x
2539        }
2540
2541        bind $w <Visibility> "grab $w; focus $w"
2542        bind $w <Key-Escape> "destroy $w"
2543        wm title $w "$appname ($reponame): Options"
2544        tkwait window $w
2545}
2546
2547proc do_restore_defaults {} {
2548        global font_descs default_config repo_config
2549        global repo_config_new global_config_new
2550
2551        foreach name [array names default_config] {
2552                set repo_config_new($name) $default_config($name)
2553                set global_config_new($name) $default_config($name)
2554        }
2555
2556        foreach option $font_descs {
2557                set name [lindex $option 0]
2558                set repo_config(gui.$name) $default_config(gui.$name)
2559        }
2560        apply_config
2561
2562        foreach option $font_descs {
2563                set name [lindex $option 0]
2564                set font [lindex $option 1]
2565                set global_config_new(gui.$font^^family) \
2566                        [font configure $font -family]
2567                set global_config_new(gui.$font^^size) \
2568                        [font configure $font -size]
2569        }
2570}
2571
2572proc do_save_config {w} {
2573        if {[catch {save_config} err]} {
2574                error_popup "Failed to completely save options:\n\n$err"
2575        }
2576        reshow_diff
2577        destroy $w
2578}
2579
2580proc do_windows_shortcut {} {
2581        global gitdir appname argv0
2582
2583        set reponame [lindex [file split \
2584                [file normalize [file dirname $gitdir]]] \
2585                end]
2586
2587        if {[catch {
2588                set desktop [exec cygpath \
2589                        --windows \
2590                        --absolute \
2591                        --long-name \
2592                        --desktop]
2593                }]} {
2594                        set desktop .
2595        }
2596        set fn [tk_getSaveFile \
2597                -parent . \
2598                -title "$appname ($reponame): Create Desktop Icon" \
2599                -initialdir $desktop \
2600                -initialfile "Git $reponame.bat"]
2601        if {$fn != {}} {
2602                if {[catch {
2603                                set fd [open $fn w]
2604                                set sh [exec cygpath \
2605                                        --windows \
2606                                        --absolute \
2607                                        --long-name \
2608                                        /bin/sh]
2609                                set me [exec cygpath \
2610                                        --unix \
2611                                        --absolute \
2612                                        $argv0]
2613                                set gd [exec cygpath \
2614                                        --unix \
2615                                        --absolute \
2616                                        $gitdir]
2617                                regsub -all ' $me "'\\''" me
2618                                regsub -all ' $gd "'\\''" gd
2619                                puts -nonewline $fd "\"$sh\" --login -c \""
2620                                puts -nonewline $fd "GIT_DIR='$gd'"
2621                                puts -nonewline $fd " '$me'"
2622                                puts $fd "&\""
2623                                close $fd
2624                        } err]} {
2625                        error_popup "Cannot write script:\n\n$err"
2626                }
2627        }
2628}
2629
2630proc do_macosx_app {} {
2631        global gitdir appname argv0 env
2632
2633        set reponame [lindex [file split \
2634                [file normalize [file dirname $gitdir]]] \
2635                end]
2636
2637        set fn [tk_getSaveFile \
2638                -parent . \
2639                -title "$appname ($reponame): Create Desktop Icon" \
2640                -initialdir [file join $env(HOME) Desktop] \
2641                -initialfile "Git $reponame.app"]
2642        if {$fn != {}} {
2643                if {[catch {
2644                                set Contents [file join $fn Contents]
2645                                set MacOS [file join $Contents MacOS]
2646                                set exe [file join $MacOS git-gui]
2647
2648                                file mkdir $MacOS
2649
2650                                set fd [open [file join $Contents Info.plist] w]
2651                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2652<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2653<plist version="1.0">
2654<dict>
2655        <key>CFBundleDevelopmentRegion</key>
2656        <string>English</string>
2657        <key>CFBundleExecutable</key>
2658        <string>git-gui</string>
2659        <key>CFBundleIdentifier</key>
2660        <string>org.spearce.git-gui</string>
2661        <key>CFBundleInfoDictionaryVersion</key>
2662        <string>6.0</string>
2663        <key>CFBundlePackageType</key>
2664        <string>APPL</string>
2665        <key>CFBundleSignature</key>
2666        <string>????</string>
2667        <key>CFBundleVersion</key>
2668        <string>1.0</string>
2669        <key>NSPrincipalClass</key>
2670        <string>NSApplication</string>
2671</dict>
2672</plist>}
2673                                close $fd
2674
2675                                set fd [open $exe w]
2676                                set gd [file normalize $gitdir]
2677                                set ep [file normalize [exec git --exec-path]]
2678                                regsub -all ' $gd "'\\''" gd
2679                                regsub -all ' $ep "'\\''" ep
2680                                puts $fd "#!/bin/sh"
2681                                foreach name [array names env] {
2682                                        if {[string match GIT_* $name]} {
2683                                                regsub -all ' $env($name) "'\\''" v
2684                                                puts $fd "export $name='$v'"
2685                                        }
2686                                }
2687                                puts $fd "export PATH='$ep':\$PATH"
2688                                puts $fd "export GIT_DIR='$gd'"
2689                                puts $fd "exec [file normalize $argv0]"
2690                                close $fd
2691
2692                                file attributes $exe -permissions u+x,g+x,o+x
2693                        } err]} {
2694                        error_popup "Cannot write icon:\n\n$err"
2695                }
2696        }
2697}
2698
2699proc toggle_or_diff {w x y} {
2700        global file_states file_lists current_diff ui_index ui_other
2701        global last_clicked selected_paths
2702
2703        set pos [split [$w index @$x,$y] .]
2704        set lno [lindex $pos 0]
2705        set col [lindex $pos 1]
2706        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2707        if {$path eq {}} {
2708                set last_clicked {}
2709                return
2710        }
2711
2712        set last_clicked [list $w $lno]
2713        array unset selected_paths
2714        $ui_index tag remove in_sel 0.0 end
2715        $ui_other tag remove in_sel 0.0 end
2716
2717        if {$col == 0} {
2718                if {$current_diff eq $path} {
2719                        set after {reshow_diff;}
2720                } else {
2721                        set after {}
2722                }
2723                switch -glob -- [lindex $file_states($path) 0] {
2724                A_ -
2725                M_ -
2726                DD -
2727                DO -
2728                DM {
2729                        update_indexinfo \
2730                                "Removing [short_path $path] from commit" \
2731                                [list $path] \
2732                                [concat $after {set ui_status_value {Ready.}}]
2733                }
2734                ?? {
2735                        update_index \
2736                                "Including [short_path $path]" \
2737                                [list $path] \
2738                                [concat $after {set ui_status_value {Ready.}}]
2739                }
2740                }
2741        } else {
2742                show_diff $path $w $lno
2743        }
2744}
2745
2746proc add_one_to_selection {w x y} {
2747        global file_lists
2748        global last_clicked selected_paths
2749
2750        set pos [split [$w index @$x,$y] .]
2751        set lno [lindex $pos 0]
2752        set col [lindex $pos 1]
2753        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2754        if {$path eq {}} {
2755                set last_clicked {}
2756                return
2757        }
2758
2759        set last_clicked [list $w $lno]
2760        if {[catch {set in_sel $selected_paths($path)}]} {
2761                set in_sel 0
2762        }
2763        if {$in_sel} {
2764                unset selected_paths($path)
2765                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2766        } else {
2767                set selected_paths($path) 1
2768                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2769        }
2770}
2771
2772proc add_range_to_selection {w x y} {
2773        global file_lists
2774        global last_clicked selected_paths
2775
2776        if {[lindex $last_clicked 0] ne $w} {
2777                toggle_or_diff $w $x $y
2778                return
2779        }
2780
2781        set pos [split [$w index @$x,$y] .]
2782        set lno [lindex $pos 0]
2783        set lc [lindex $last_clicked 1]
2784        if {$lc < $lno} {
2785                set begin $lc
2786                set end $lno
2787        } else {
2788                set begin $lno
2789                set end $lc
2790        }
2791
2792        foreach path [lrange $file_lists($w) \
2793                [expr {$begin - 1}] \
2794                [expr {$end - 1}]] {
2795                set selected_paths($path) 1
2796        }
2797        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2798}
2799
2800######################################################################
2801##
2802## config defaults
2803
2804set cursor_ptr arrow
2805font create font_diff -family Courier -size 10
2806font create font_ui
2807catch {
2808        label .dummy
2809        eval font configure font_ui [font actual [.dummy cget -font]]
2810        destroy .dummy
2811}
2812
2813font create font_uibold
2814font create font_diffbold
2815
2816if {[is_Windows]} {
2817        set M1B Control
2818        set M1T Ctrl
2819} elseif {[is_MacOSX]} {
2820        set M1B M1
2821        set M1T Cmd
2822} else {
2823        set M1B M1
2824        set M1T M1
2825}
2826
2827proc apply_config {} {
2828        global repo_config font_descs
2829
2830        foreach option $font_descs {
2831                set name [lindex $option 0]
2832                set font [lindex $option 1]
2833                if {[catch {
2834                        foreach {cn cv} $repo_config(gui.$name) {
2835                                font configure $font $cn $cv
2836                        }
2837                        } err]} {
2838                        error_popup "Invalid font specified in gui.$name:\n\n$err"
2839                }
2840                foreach {cn cv} [font configure $font] {
2841                        font configure ${font}bold $cn $cv
2842                }
2843                font configure ${font}bold -weight bold
2844        }
2845}
2846
2847set default_config(gui.trustmtime) false
2848set default_config(gui.pullsummary) true
2849set default_config(gui.partialinclude) false
2850set default_config(gui.diffcontext) 5
2851set default_config(gui.fontui) [font configure font_ui]
2852set default_config(gui.fontdiff) [font configure font_diff]
2853set font_descs {
2854        {fontui   font_ui   {Main Font}}
2855        {fontdiff font_diff {Diff/Console Font}}
2856}
2857load_config 0
2858apply_config
2859
2860######################################################################
2861##
2862## ui construction
2863
2864# -- Menu Bar
2865#
2866menu .mbar -tearoff 0
2867.mbar add cascade -label Repository -menu .mbar.repository
2868.mbar add cascade -label Edit -menu .mbar.edit
2869.mbar add cascade -label Commit -menu .mbar.commit
2870if {!$single_commit} {
2871        .mbar add cascade -label Fetch -menu .mbar.fetch
2872        .mbar add cascade -label Pull -menu .mbar.pull
2873        .mbar add cascade -label Push -menu .mbar.push
2874}
2875. configure -menu .mbar
2876
2877# -- Repository Menu
2878#
2879menu .mbar.repository
2880.mbar.repository add command \
2881        -label {Visualize Current Branch} \
2882        -command {do_gitk {}} \
2883        -font font_ui
2884if {![is_MacOSX]} {
2885        .mbar.repository add command \
2886                -label {Visualize All Branches} \
2887                -command {do_gitk {--all}} \
2888                -font font_ui
2889}
2890.mbar.repository add separator
2891
2892if {!$single_commit} {
2893        .mbar.repository add command -label {Repack Database} \
2894                -command do_repack \
2895                -font font_ui
2896
2897        .mbar.repository add command -label {Verify Database} \
2898                -command do_fsck_objects \
2899                -font font_ui
2900
2901        .mbar.repository add separator
2902
2903        if {[is_Windows]} {
2904                .mbar.repository add command \
2905                        -label {Create Desktop Icon} \
2906                        -command do_windows_shortcut \
2907                        -font font_ui
2908        } elseif {[is_MacOSX]} {
2909                .mbar.repository add command \
2910                        -label {Create Desktop Icon} \
2911                        -command do_macosx_app \
2912                        -font font_ui
2913        }
2914}
2915.mbar.repository add command -label Quit \
2916        -command do_quit \
2917        -accelerator $M1T-Q \
2918        -font font_ui
2919
2920# -- Edit Menu
2921#
2922menu .mbar.edit
2923.mbar.edit add command -label Undo \
2924        -command {catch {[focus] edit undo}} \
2925        -accelerator $M1T-Z \
2926        -font font_ui
2927.mbar.edit add command -label Redo \
2928        -command {catch {[focus] edit redo}} \
2929        -accelerator $M1T-Y \
2930        -font font_ui
2931.mbar.edit add separator
2932.mbar.edit add command -label Cut \
2933        -command {catch {tk_textCut [focus]}} \
2934        -accelerator $M1T-X \
2935        -font font_ui
2936.mbar.edit add command -label Copy \
2937        -command {catch {tk_textCopy [focus]}} \
2938        -accelerator $M1T-C \
2939        -font font_ui
2940.mbar.edit add command -label Paste \
2941        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2942        -accelerator $M1T-V \
2943        -font font_ui
2944.mbar.edit add command -label Delete \
2945        -command {catch {[focus] delete sel.first sel.last}} \
2946        -accelerator Del \
2947        -font font_ui
2948.mbar.edit add separator
2949.mbar.edit add command -label {Select All} \
2950        -command {catch {[focus] tag add sel 0.0 end}} \
2951        -accelerator $M1T-A \
2952        -font font_ui
2953
2954# -- Commit Menu
2955#
2956menu .mbar.commit
2957
2958.mbar.commit add radiobutton \
2959        -label {New Commit} \
2960        -command do_select_commit_type \
2961        -variable selected_commit_type \
2962        -value new \
2963        -font font_ui
2964lappend disable_on_lock \
2965        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2966
2967.mbar.commit add radiobutton \
2968        -label {Amend Last Commit} \
2969        -command do_select_commit_type \
2970        -variable selected_commit_type \
2971        -value amend \
2972        -font font_ui
2973lappend disable_on_lock \
2974        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2975
2976.mbar.commit add separator
2977
2978.mbar.commit add command -label Rescan \
2979        -command do_rescan \
2980        -accelerator F5 \
2981        -font font_ui
2982lappend disable_on_lock \
2983        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2984
2985.mbar.commit add command -label {Include In Commit} \
2986        -command do_include_selection \
2987        -font font_ui
2988lappend disable_on_lock \
2989        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2990
2991.mbar.commit add command -label {Include All In Commit} \
2992        -command do_include_all \
2993        -accelerator $M1T-I \
2994        -font font_ui
2995lappend disable_on_lock \
2996        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2997
2998.mbar.commit add command -label {Remove From Commit} \
2999        -command do_remove_selection \
3000        -font font_ui
3001lappend disable_on_lock \
3002        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3003
3004.mbar.commit add command -label {Revert Changes} \
3005        -command do_revert_selection \
3006        -font font_ui
3007lappend disable_on_lock \
3008        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3009
3010.mbar.commit add separator
3011
3012.mbar.commit add command -label {Sign Off} \
3013        -command do_signoff \
3014        -accelerator $M1T-S \
3015        -font font_ui
3016
3017.mbar.commit add command -label Commit \
3018        -command do_commit \
3019        -accelerator $M1T-Return \
3020        -font font_ui
3021lappend disable_on_lock \
3022        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3023
3024# -- Transport menus
3025#
3026if {!$single_commit} {
3027        menu .mbar.fetch
3028        menu .mbar.pull
3029        menu .mbar.push
3030}
3031
3032if {[is_MacOSX]} {
3033        # -- Apple Menu (Mac OS X only)
3034        #
3035        .mbar add cascade -label Apple -menu .mbar.apple
3036        menu .mbar.apple
3037
3038        .mbar.apple add command -label "About $appname" \
3039                -command do_about \
3040                -font font_ui
3041        .mbar.apple add command -label "$appname Options..." \
3042                -command do_options \
3043                -font font_ui
3044} else {
3045        # -- Edit Menu
3046        #
3047        .mbar.edit add separator
3048        .mbar.edit add command -label {Options...} \
3049                -command do_options \
3050                -font font_ui
3051
3052        # -- Help Menu
3053        #
3054        .mbar add cascade -label Help -menu .mbar.help
3055        menu .mbar.help
3056
3057        .mbar.help add command -label "About $appname" \
3058                -command do_about \
3059                -font font_ui
3060}
3061
3062
3063# -- Main Window Layout
3064#
3065panedwindow .vpane -orient vertical
3066panedwindow .vpane.files -orient horizontal
3067.vpane add .vpane.files -sticky nsew -height 100 -width 400
3068pack .vpane -anchor n -side top -fill both -expand 1
3069
3070# -- Index File List
3071#
3072frame .vpane.files.index -height 100 -width 400
3073label .vpane.files.index.title -text {Modified Files} \
3074        -background green \
3075        -font font_ui
3076text $ui_index -background white -borderwidth 0 \
3077        -width 40 -height 10 \
3078        -font font_ui \
3079        -cursor $cursor_ptr \
3080        -yscrollcommand {.vpane.files.index.sb set} \
3081        -state disabled
3082scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3083pack .vpane.files.index.title -side top -fill x
3084pack .vpane.files.index.sb -side right -fill y
3085pack $ui_index -side left -fill both -expand 1
3086.vpane.files add .vpane.files.index -sticky nsew
3087
3088# -- Other (Add) File List
3089#
3090frame .vpane.files.other -height 100 -width 100
3091label .vpane.files.other.title -text {Untracked Files} \
3092        -background red \
3093        -font font_ui
3094text $ui_other -background white -borderwidth 0 \
3095        -width 40 -height 10 \
3096        -font font_ui \
3097        -cursor $cursor_ptr \
3098        -yscrollcommand {.vpane.files.other.sb set} \
3099        -state disabled
3100scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3101pack .vpane.files.other.title -side top -fill x
3102pack .vpane.files.other.sb -side right -fill y
3103pack $ui_other -side left -fill both -expand 1
3104.vpane.files add .vpane.files.other -sticky nsew
3105
3106foreach i [list $ui_index $ui_other] {
3107        $i tag conf in_diff -font font_uibold
3108        $i tag conf in_sel \
3109                -background [$i cget -foreground] \
3110                -foreground [$i cget -background]
3111}
3112unset i
3113
3114# -- Diff and Commit Area
3115#
3116frame .vpane.lower -height 300 -width 400
3117frame .vpane.lower.commarea
3118frame .vpane.lower.diff -relief sunken -borderwidth 1
3119pack .vpane.lower.commarea -side top -fill x
3120pack .vpane.lower.diff -side bottom -fill both -expand 1
3121.vpane add .vpane.lower -stick nsew
3122
3123# -- Commit Area Buttons
3124#
3125frame .vpane.lower.commarea.buttons
3126label .vpane.lower.commarea.buttons.l -text {} \
3127        -anchor w \
3128        -justify left \
3129        -font font_ui
3130pack .vpane.lower.commarea.buttons.l -side top -fill x
3131pack .vpane.lower.commarea.buttons -side left -fill y
3132
3133button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3134        -command do_rescan \
3135        -font font_ui
3136pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3137lappend disable_on_lock \
3138        {.vpane.lower.commarea.buttons.rescan conf -state}
3139
3140button .vpane.lower.commarea.buttons.incall -text {Include All} \
3141        -command do_include_all \
3142        -font font_ui
3143pack .vpane.lower.commarea.buttons.incall -side top -fill x
3144lappend disable_on_lock \
3145        {.vpane.lower.commarea.buttons.incall conf -state}
3146
3147button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3148        -command do_signoff \
3149        -font font_ui
3150pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3151
3152button .vpane.lower.commarea.buttons.commit -text {Commit} \
3153        -command do_commit \
3154        -font font_ui
3155pack .vpane.lower.commarea.buttons.commit -side top -fill x
3156lappend disable_on_lock \
3157        {.vpane.lower.commarea.buttons.commit conf -state}
3158
3159# -- Commit Message Buffer
3160#
3161frame .vpane.lower.commarea.buffer
3162frame .vpane.lower.commarea.buffer.header
3163set ui_comm .vpane.lower.commarea.buffer.t
3164set ui_coml .vpane.lower.commarea.buffer.header.l
3165radiobutton .vpane.lower.commarea.buffer.header.new \
3166        -text {New Commit} \
3167        -command do_select_commit_type \
3168        -variable selected_commit_type \
3169        -value new \
3170        -font font_ui
3171lappend disable_on_lock \
3172        [list .vpane.lower.commarea.buffer.header.new conf -state]
3173radiobutton .vpane.lower.commarea.buffer.header.amend \
3174        -text {Amend Last Commit} \
3175        -command do_select_commit_type \
3176        -variable selected_commit_type \
3177        -value amend \
3178        -font font_ui
3179lappend disable_on_lock \
3180        [list .vpane.lower.commarea.buffer.header.amend conf -state]
3181label $ui_coml \
3182        -anchor w \
3183        -justify left \
3184        -font font_ui
3185proc trace_commit_type {varname args} {
3186        global ui_coml commit_type
3187        switch -glob -- $commit_type {
3188        initial       {set txt {Initial Commit Message:}}
3189        amend         {set txt {Amended Commit Message:}}
3190        amend-initial {set txt {Amended Initial Commit Message:}}
3191        amend-merge   {set txt {Amended Merge Commit Message:}}
3192        merge         {set txt {Merge Commit Message:}}
3193        *             {set txt {Commit Message:}}
3194        }
3195        $ui_coml conf -text $txt
3196}
3197trace add variable commit_type write trace_commit_type
3198pack $ui_coml -side left -fill x
3199pack .vpane.lower.commarea.buffer.header.amend -side right
3200pack .vpane.lower.commarea.buffer.header.new -side right
3201
3202text $ui_comm -background white -borderwidth 1 \
3203        -undo true \
3204        -maxundo 20 \
3205        -autoseparators true \
3206        -relief sunken \
3207        -width 75 -height 9 -wrap none \
3208        -font font_diff \
3209        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3210scrollbar .vpane.lower.commarea.buffer.sby \
3211        -command [list $ui_comm yview]
3212pack .vpane.lower.commarea.buffer.header -side top -fill x
3213pack .vpane.lower.commarea.buffer.sby -side right -fill y
3214pack $ui_comm -side left -fill y
3215pack .vpane.lower.commarea.buffer -side left -fill y
3216
3217# -- Commit Message Buffer Context Menu
3218#
3219set ctxm .vpane.lower.commarea.buffer.ctxm
3220menu $ctxm -tearoff 0
3221$ctxm add command \
3222        -label {Cut} \
3223        -font font_ui \
3224        -command {tk_textCut $ui_comm}
3225$ctxm add command \
3226        -label {Copy} \
3227        -font font_ui \
3228        -command {tk_textCopy $ui_comm}
3229$ctxm add command \
3230        -label {Paste} \
3231        -font font_ui \
3232        -command {tk_textPaste $ui_comm}
3233$ctxm add command \
3234        -label {Delete} \
3235        -font font_ui \
3236        -command {$ui_comm delete sel.first sel.last}
3237$ctxm add separator
3238$ctxm add command \
3239        -label {Select All} \
3240        -font font_ui \
3241        -command {$ui_comm tag add sel 0.0 end}
3242$ctxm add command \
3243        -label {Copy All} \
3244        -font font_ui \
3245        -command {
3246                $ui_comm tag add sel 0.0 end
3247                tk_textCopy $ui_comm
3248                $ui_comm tag remove sel 0.0 end
3249        }
3250$ctxm add separator
3251$ctxm add command \
3252        -label {Sign Off} \
3253        -font font_ui \
3254        -command do_signoff
3255bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3256
3257# -- Diff Header
3258#
3259set current_diff {}
3260set diff_actions [list]
3261proc trace_current_diff {varname args} {
3262        global current_diff diff_actions file_states
3263        if {$current_diff eq {}} {
3264                set s {}
3265                set f {}
3266                set p {}
3267                set o disabled
3268        } else {
3269                set p $current_diff
3270                set s [mapdesc [lindex $file_states($p) 0] $p]
3271                set f {File:}
3272                set p [escape_path $p]
3273                set o normal
3274        }
3275
3276        .vpane.lower.diff.header.status configure -text $s
3277        .vpane.lower.diff.header.file configure -text $f
3278        .vpane.lower.diff.header.path configure -text $p
3279        foreach w $diff_actions {
3280                uplevel #0 $w $o
3281        }
3282}
3283trace add variable current_diff write trace_current_diff
3284
3285frame .vpane.lower.diff.header -background orange
3286label .vpane.lower.diff.header.status \
3287        -background orange \
3288        -width $max_status_desc \
3289        -anchor w \
3290        -justify left \
3291        -font font_ui
3292label .vpane.lower.diff.header.file \
3293        -background orange \
3294        -anchor w \
3295        -justify left \
3296        -font font_ui
3297label .vpane.lower.diff.header.path \
3298        -background orange \
3299        -anchor w \
3300        -justify left \
3301        -font font_ui
3302pack .vpane.lower.diff.header.status -side left
3303pack .vpane.lower.diff.header.file -side left
3304pack .vpane.lower.diff.header.path -fill x
3305set ctxm .vpane.lower.diff.header.ctxm
3306menu $ctxm -tearoff 0
3307$ctxm add command \
3308        -label {Copy} \
3309        -font font_ui \
3310        -command {
3311                clipboard clear
3312                clipboard append \
3313                        -format STRING \
3314                        -type STRING \
3315                        -- $current_diff
3316        }
3317lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3318bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3319
3320# -- Diff Body
3321#
3322frame .vpane.lower.diff.body
3323set ui_diff .vpane.lower.diff.body.t
3324text $ui_diff -background white -borderwidth 0 \
3325        -width 80 -height 15 -wrap none \
3326        -font font_diff \
3327        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3328        -yscrollcommand {.vpane.lower.diff.body.sby set} \
3329        -state disabled
3330scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3331        -command [list $ui_diff xview]
3332scrollbar .vpane.lower.diff.body.sby -orient vertical \
3333        -command [list $ui_diff yview]
3334pack .vpane.lower.diff.body.sbx -side bottom -fill x
3335pack .vpane.lower.diff.body.sby -side right -fill y
3336pack $ui_diff -side left -fill both -expand 1
3337pack .vpane.lower.diff.header -side top -fill x
3338pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3339
3340$ui_diff tag conf d_@ -font font_diffbold
3341$ui_diff tag conf d_+  -foreground blue
3342$ui_diff tag conf d_-  -foreground red
3343$ui_diff tag conf d_++ -foreground {#00a000}
3344$ui_diff tag conf d_-- -foreground {#a000a0}
3345$ui_diff tag conf d_+- \
3346        -foreground red \
3347        -background {light goldenrod yellow}
3348$ui_diff tag conf d_-+ \
3349        -foreground blue \
3350        -background azure2
3351
3352# -- Diff Body Context Menu
3353#
3354set ctxm .vpane.lower.diff.body.ctxm
3355menu $ctxm -tearoff 0
3356$ctxm add command \
3357        -label {Copy} \
3358        -font font_ui \
3359        -command {tk_textCopy $ui_diff}
3360lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3361$ctxm add command \
3362        -label {Select All} \
3363        -font font_ui \
3364        -command {$ui_diff tag add sel 0.0 end}
3365lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3366$ctxm add command \
3367        -label {Copy All} \
3368        -font font_ui \
3369        -command {
3370                $ui_diff tag add sel 0.0 end
3371                tk_textCopy $ui_diff
3372                $ui_diff tag remove sel 0.0 end
3373        }
3374lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3375$ctxm add separator
3376$ctxm add command \
3377        -label {Decrease Font Size} \
3378        -font font_ui \
3379        -command {incr_font_size font_diff -1}
3380lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3381$ctxm add command \
3382        -label {Increase Font Size} \
3383        -font font_ui \
3384        -command {incr_font_size font_diff 1}
3385lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3386$ctxm add separator
3387$ctxm add command \
3388        -label {Show Less Context} \
3389        -font font_ui \
3390        -command {if {$repo_config(gui.diffcontext) >= 2} {
3391                incr repo_config(gui.diffcontext) -1
3392                reshow_diff
3393        }}
3394lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3395$ctxm add command \
3396        -label {Show More Context} \
3397        -font font_ui \
3398        -command {
3399                incr repo_config(gui.diffcontext)
3400                reshow_diff
3401        }
3402lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3403$ctxm add separator
3404$ctxm add command -label {Options...} \
3405        -font font_ui \
3406        -command do_options
3407bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3408
3409# -- Status Bar
3410#
3411set ui_status_value {Initializing...}
3412label .status -textvariable ui_status_value \
3413        -anchor w \
3414        -justify left \
3415        -borderwidth 1 \
3416        -relief sunken \
3417        -font font_ui
3418pack .status -anchor w -side bottom -fill x
3419
3420# -- Load geometry
3421#
3422catch {
3423set gm $repo_config(gui.geometry)
3424wm geometry . [lindex $gm 0]
3425.vpane sash place 0 \
3426        [lindex [.vpane sash coord 0] 0] \
3427        [lindex $gm 1]
3428.vpane.files sash place 0 \
3429        [lindex $gm 2] \
3430        [lindex [.vpane.files sash coord 0] 1]
3431unset gm
3432}
3433
3434# -- Key Bindings
3435#
3436bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3437bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3438bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3439bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3440bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3441bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3442bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3443bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3444bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3445bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3446bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3447
3448bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3449bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3450bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3451bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3452bind $ui_diff <$M1B-Key-v> {break}
3453bind $ui_diff <$M1B-Key-V> {break}
3454bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3455bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3456bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3457bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3458bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3459bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3460
3461bind .   <Destroy> do_quit
3462bind all <Key-F5> do_rescan
3463bind all <$M1B-Key-r> do_rescan
3464bind all <$M1B-Key-R> do_rescan
3465bind .   <$M1B-Key-s> do_signoff
3466bind .   <$M1B-Key-S> do_signoff
3467bind .   <$M1B-Key-i> do_include_all
3468bind .   <$M1B-Key-I> do_include_all
3469bind .   <$M1B-Key-Return> do_commit
3470bind all <$M1B-Key-q> do_quit
3471bind all <$M1B-Key-Q> do_quit
3472bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3473bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3474foreach i [list $ui_index $ui_other] {
3475        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3476        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3477        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3478}
3479unset i
3480
3481set file_lists($ui_index) [list]
3482set file_lists($ui_other) [list]
3483
3484set HEAD {}
3485set PARENT {}
3486set MERGE_HEAD [list]
3487set commit_type {}
3488set empty_tree {}
3489set current_diff {}
3490set selected_commit_type new
3491
3492wm title . "$appname ([file normalize [file dirname $gitdir]])"
3493focus -force $ui_comm
3494
3495# -- Warn the user about environmental problems.
3496#    Cygwin's Tcl does *not* pass its env array
3497#    onto any processes it spawns.  This means
3498#    that the git processes get none of our
3499#    environment.  That may not work...
3500#
3501if {[is_Windows]} {
3502        set ignored_env 0
3503        set suggest_user {}
3504        set msg "Possible environment issues exist.
3505
3506The following environment variables are probably
3507going to be ignored by any Git subprocess run
3508by $appname:
3509
3510"
3511        foreach name [array names env] {
3512                switch -regexp -- $name {
3513                {^GIT_INDEX_FILE$} -
3514                {^GIT_OBJECT_DIRECTORY$} -
3515                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3516                {^GIT_DIFF_OPTS$} -
3517                {^GIT_EXTERNAL_DIFF$} -
3518                {^GIT_PAGER$} -
3519                {^GIT_TRACE$} -
3520                {^GIT_CONFIG$} -
3521                {^GIT_CONFIG_LOCAL$} -
3522                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3523                        append msg " - $name\n"
3524                        incr ignored_env
3525                }
3526                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3527                        append msg " - $name\n"
3528                        incr ignored_env
3529                        set suggest_user $name
3530                }
3531                }
3532        }
3533        if {$ignored_env > 0} {
3534                append msg "
3535This is due to a known issue with the
3536Tcl binary distributed by Cygwin."
3537
3538                if {$suggest_user ne {}} {
3539                        append msg "
3540
3541A good replacement for $suggest_user
3542is placing values for the user.name and
3543user.email settings into your personal
3544~/.gitconfig file.
3545"
3546                }
3547                warn_popup $msg
3548        }
3549        unset ignored_env msg suggest_user name
3550}
3551
3552if {!$single_commit} {
3553        load_all_remotes
3554        populate_fetch_menu .mbar.fetch
3555        populate_pull_menu .mbar.pull
3556        populate_push_menu .mbar.push
3557}
3558lock_index begin-read
3559after 1 do_rescan