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