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