Andrew's git - gitweb.git/blob

afd9ac026e79cce4811de0cb4fa9b7c6d6bc23f6
   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 {[tk windowingsystem] eq {aqua}} {
1720                return 1
1721        }
1722        return 0
1723}
1724
1725proc is_Windows {} {
1726        global tcl_platform
1727        if {$tcl_platform(platform) eq {windows}} {
1728                return 1
1729        }
1730        return 0
1731}
1732
1733proc bind_button3 {w cmd} {
1734        bind $w <Any-Button-3> $cmd
1735        if {[is_MacOSX]} {
1736                bind $w <Control-Button-1> $cmd
1737        }
1738}
1739
1740proc incr_font_size {font {amt 1}} {
1741        set sz [font configure $font -size]
1742        incr sz $amt
1743        font configure $font -size $sz
1744        font configure ${font}bold -size $sz
1745}
1746
1747proc hook_failed_popup {hook msg} {
1748        global gitdir appname
1749
1750        set w .hookfail
1751        toplevel $w
1752
1753        frame $w.m
1754        label $w.m.l1 -text "$hook hook failed:" \
1755                -anchor w \
1756                -justify left \
1757                -font font_uibold
1758        text $w.m.t \
1759                -background white -borderwidth 1 \
1760                -relief sunken \
1761                -width 80 -height 10 \
1762                -font font_diff \
1763                -yscrollcommand [list $w.m.sby set]
1764        label $w.m.l2 \
1765                -text {You must correct the above errors before committing.} \
1766                -anchor w \
1767                -justify left \
1768                -font font_uibold
1769        scrollbar $w.m.sby -command [list $w.m.t yview]
1770        pack $w.m.l1 -side top -fill x
1771        pack $w.m.l2 -side bottom -fill x
1772        pack $w.m.sby -side right -fill y
1773        pack $w.m.t -side left -fill both -expand 1
1774        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1775
1776        $w.m.t insert 1.0 $msg
1777        $w.m.t conf -state disabled
1778
1779        button $w.ok -text OK \
1780                -width 15 \
1781                -font font_ui \
1782                -command "destroy $w"
1783        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1784
1785        bind $w <Visibility> "grab $w; focus $w"
1786        bind $w <Key-Return> "destroy $w"
1787        wm title $w "$appname ([lindex [file split \
1788                [file normalize [file dirname $gitdir]]] \
1789                end]): error"
1790        tkwait window $w
1791}
1792
1793set next_console_id 0
1794
1795proc new_console {short_title long_title} {
1796        global next_console_id console_data
1797        set w .console[incr next_console_id]
1798        set console_data($w) [list $short_title $long_title]
1799        return [console_init $w]
1800}
1801
1802proc console_init {w} {
1803        global console_cr console_data
1804        global gitdir appname M1B
1805
1806        set console_cr($w) 1.0
1807        toplevel $w
1808        frame $w.m
1809        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1810                -anchor w \
1811                -justify left \
1812                -font font_uibold
1813        text $w.m.t \
1814                -background white -borderwidth 1 \
1815                -relief sunken \
1816                -width 80 -height 10 \
1817                -font font_diff \
1818                -state disabled \
1819                -yscrollcommand [list $w.m.sby set]
1820        label $w.m.s -text {Working... please wait...} \
1821                -anchor w \
1822                -justify left \
1823                -font font_uibold
1824        scrollbar $w.m.sby -command [list $w.m.t yview]
1825        pack $w.m.l1 -side top -fill x
1826        pack $w.m.s -side bottom -fill x
1827        pack $w.m.sby -side right -fill y
1828        pack $w.m.t -side left -fill both -expand 1
1829        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1830
1831        menu $w.ctxm -tearoff 0
1832        $w.ctxm add command -label "Copy" \
1833                -font font_ui \
1834                -command "tk_textCopy $w.m.t"
1835        $w.ctxm add command -label "Select All" \
1836                -font font_ui \
1837                -command "$w.m.t tag add sel 0.0 end"
1838        $w.ctxm add command -label "Copy All" \
1839                -font font_ui \
1840                -command "
1841                        $w.m.t tag add sel 0.0 end
1842                        tk_textCopy $w.m.t
1843                        $w.m.t tag remove sel 0.0 end
1844                "
1845
1846        button $w.ok -text {Close} \
1847                -font font_ui \
1848                -state disabled \
1849                -command "destroy $w"
1850        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1851
1852        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1853        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1854        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1855        bind $w <Visibility> "focus $w"
1856        wm title $w "$appname ([lindex [file split \
1857                [file normalize [file dirname $gitdir]]] \
1858                end]): [lindex $console_data($w) 0]"
1859        return $w
1860}
1861
1862proc console_exec {w cmd {after {}}} {
1863        # -- Windows tosses the enviroment when we exec our child.
1864        #    But most users need that so we have to relogin. :-(
1865        #
1866        if {[is_Windows]} {
1867                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1868        }
1869
1870        # -- Tcl won't let us redirect both stdout and stderr to
1871        #    the same pipe.  So pass it through cat...
1872        #
1873        set cmd [concat | $cmd |& cat]
1874
1875        set fd_f [open $cmd r]
1876        fconfigure $fd_f -blocking 0 -translation binary
1877        fileevent $fd_f readable [list console_read $w $fd_f $after]
1878}
1879
1880proc console_read {w fd after} {
1881        global console_cr console_data
1882
1883        set buf [read $fd]
1884        if {$buf ne {}} {
1885                if {![winfo exists $w]} {console_init $w}
1886                $w.m.t conf -state normal
1887                set c 0
1888                set n [string length $buf]
1889                while {$c < $n} {
1890                        set cr [string first "\r" $buf $c]
1891                        set lf [string first "\n" $buf $c]
1892                        if {$cr < 0} {set cr [expr {$n + 1}]}
1893                        if {$lf < 0} {set lf [expr {$n + 1}]}
1894
1895                        if {$lf < $cr} {
1896                                $w.m.t insert end [string range $buf $c $lf]
1897                                set console_cr($w) [$w.m.t index {end -1c}]
1898                                set c $lf
1899                                incr c
1900                        } else {
1901                                $w.m.t delete $console_cr($w) end
1902                                $w.m.t insert end "\n"
1903                                $w.m.t insert end [string range $buf $c $cr]
1904                                set c $cr
1905                                incr c
1906                        }
1907                }
1908                $w.m.t conf -state disabled
1909                $w.m.t see end
1910        }
1911
1912        fconfigure $fd -blocking 1
1913        if {[eof $fd]} {
1914                if {[catch {close $fd}]} {
1915                        if {![winfo exists $w]} {console_init $w}
1916                        $w.m.s conf -background red -text {Error: Command Failed}
1917                        $w.ok conf -state normal
1918                        set ok 0
1919                } elseif {[winfo exists $w]} {
1920                        $w.m.s conf -background green -text {Success}
1921                        $w.ok conf -state normal
1922                        set ok 1
1923                }
1924                array unset console_cr $w
1925                array unset console_data $w
1926                if {$after ne {}} {
1927                        uplevel #0 $after $ok
1928                }
1929                return
1930        }
1931        fconfigure $fd -blocking 0
1932}
1933
1934######################################################################
1935##
1936## ui commands
1937
1938set starting_gitk_msg {Please wait... Starting gitk...}
1939
1940proc do_gitk {} {
1941        global ui_status_value starting_gitk_msg
1942
1943        set ui_status_value $starting_gitk_msg
1944        after 10000 {
1945                if {$ui_status_value eq $starting_gitk_msg} {
1946                        set ui_status_value {Ready.}
1947                }
1948        }
1949
1950        if {[is_Windows]} {
1951                exec sh -c gitk &
1952        } else {
1953                exec gitk &
1954        }
1955}
1956
1957proc do_repack {} {
1958        set w [new_console {repack} \
1959                {Repacking the object database}]
1960        set cmd [list git repack]
1961        lappend cmd -a
1962        lappend cmd -d
1963        console_exec $w $cmd
1964}
1965
1966proc do_fsck_objects {} {
1967        set w [new_console {fsck-objects} \
1968                {Verifying the object database with fsck-objects}]
1969        set cmd [list git fsck-objects]
1970        lappend cmd --full
1971        lappend cmd --cache
1972        lappend cmd --strict
1973        console_exec $w $cmd
1974}
1975
1976set is_quitting 0
1977
1978proc do_quit {} {
1979        global gitdir ui_comm is_quitting repo_config commit_type
1980
1981        if {$is_quitting} return
1982        set is_quitting 1
1983
1984        # -- Stash our current commit buffer.
1985        #
1986        set save [file join $gitdir GITGUI_MSG]
1987        set msg [string trim [$ui_comm get 0.0 end]]
1988        if {![string match amend* $commit_type]
1989                && [$ui_comm edit modified]
1990                && $msg ne {}} {
1991                catch {
1992                        set fd [open $save w]
1993                        puts $fd [string trim [$ui_comm get 0.0 end]]
1994                        close $fd
1995                }
1996        } else {
1997                catch {file delete $save}
1998        }
1999
2000        # -- Stash our current window geometry into this repository.
2001        #
2002        set cfg_geometry [list]
2003        lappend cfg_geometry [wm geometry .]
2004        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2005        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2006        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2007                set rc_geometry {}
2008        }
2009        if {$cfg_geometry ne $rc_geometry} {
2010                catch {exec git repo-config gui.geometry $cfg_geometry}
2011        }
2012
2013        destroy .
2014}
2015
2016proc do_rescan {} {
2017        rescan {set ui_status_value {Ready.}}
2018}
2019
2020proc remove_helper {txt paths} {
2021        global file_states current_diff
2022
2023        if {![lock_index begin-update]} return
2024
2025        set pathList [list]
2026        set after {}
2027        foreach path $paths {
2028                switch -glob -- [lindex $file_states($path) 0] {
2029                A? -
2030                M? -
2031                D? {
2032                        lappend pathList $path
2033                        if {$path eq $current_diff} {
2034                                set after {reshow_diff;}
2035                        }
2036                }
2037                }
2038        }
2039        if {$pathList eq {}} {
2040                unlock_index
2041        } else {
2042                update_indexinfo \
2043                        $txt \
2044                        $pathList \
2045                        [concat $after {set ui_status_value {Ready.}}]
2046        }
2047}
2048
2049proc do_remove_selection {} {
2050        global current_diff selected_paths
2051
2052        if {[array size selected_paths] > 0} {
2053                remove_helper \
2054                        {Removing selected files from commit} \
2055                        [array names selected_paths]
2056        } elseif {$current_diff ne {}} {
2057                remove_helper \
2058                        "Removing [short_path $current_diff] from commit" \
2059                        [list $current_diff]
2060        }
2061}
2062
2063proc include_helper {txt paths} {
2064        global file_states current_diff
2065
2066        if {![lock_index begin-update]} return
2067
2068        set pathList [list]
2069        set after {}
2070        foreach path $paths {
2071                switch -glob -- [lindex $file_states($path) 0] {
2072                AM -
2073                AD -
2074                MM -
2075                U? -
2076                _M -
2077                _D -
2078                _O {
2079                        lappend pathList $path
2080                        if {$path eq $current_diff} {
2081                                set after {reshow_diff;}
2082                        }
2083                }
2084                }
2085        }
2086        if {$pathList eq {}} {
2087                unlock_index
2088        } else {
2089                update_index \
2090                        $txt \
2091                        $pathList \
2092                        [concat $after {set ui_status_value {Ready to commit.}}]
2093        }
2094}
2095
2096proc do_include_selection {} {
2097        global current_diff selected_paths
2098
2099        if {[array size selected_paths] > 0} {
2100                include_helper \
2101                        {Including selected files} \
2102                        [array names selected_paths]
2103        } elseif {$current_diff ne {}} {
2104                include_helper \
2105                        "Including [short_path $current_diff]" \
2106                        [list $current_diff]
2107        }
2108}
2109
2110proc do_include_all {} {
2111        global file_states
2112
2113        set paths [list]
2114        foreach path [array names file_states] {
2115                switch -- [lindex $file_states($path) 0] {
2116                AM -
2117                AD -
2118                MM -
2119                _M -
2120                _D {lappend paths $path}
2121                }
2122        }
2123        include_helper \
2124                {Including all modified files} \
2125                $paths
2126}
2127
2128proc do_signoff {} {
2129        global ui_comm
2130
2131        set me [committer_ident]
2132        if {$me eq {}} return
2133
2134        set sob "Signed-off-by: $me"
2135        set last [$ui_comm get {end -1c linestart} {end -1c}]
2136        if {$last ne $sob} {
2137                $ui_comm edit separator
2138                if {$last ne {}
2139                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2140                        $ui_comm insert end "\n"
2141                }
2142                $ui_comm insert end "\n$sob"
2143                $ui_comm edit separator
2144                $ui_comm see end
2145        }
2146}
2147
2148proc do_select_commit_type {} {
2149        global commit_type selected_commit_type
2150
2151        if {$selected_commit_type eq {new}
2152                && [string match amend* $commit_type]} {
2153                create_new_commit
2154        } elseif {$selected_commit_type eq {amend}
2155                && ![string match amend* $commit_type]} {
2156                load_last_commit
2157
2158                # The amend request was rejected...
2159                #
2160                if {![string match amend* $commit_type]} {
2161                        set selected_commit_type new
2162                }
2163        }
2164}
2165
2166proc do_commit {} {
2167        commit_tree
2168}
2169
2170proc do_about {} {
2171        global appname copyright
2172        global tcl_patchLevel tk_patchLevel
2173
2174        set w .about_dialog
2175        toplevel $w
2176        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2177
2178        label $w.header -text "About $appname" \
2179                -font font_uibold
2180        pack $w.header -side top -fill x
2181
2182        frame $w.buttons
2183        button $w.buttons.close -text {Close} \
2184                -font font_ui \
2185                -command [list destroy $w]
2186        pack $w.buttons.close -side right
2187        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2188
2189        label $w.desc \
2190                -text "$appname - a commit creation tool for Git.
2191$copyright" \
2192                -padx 5 -pady 5 \
2193                -justify left \
2194                -anchor w \
2195                -borderwidth 1 \
2196                -relief solid \
2197                -font font_ui
2198        pack $w.desc -side top -fill x -padx 5 -pady 5
2199
2200        set v [exec git --version]
2201        append v "\n\n"
2202        if {$tcl_patchLevel eq $tk_patchLevel} {
2203                append v "Tcl/Tk version $tcl_patchLevel"
2204        } else {
2205                append v "Tcl version $tcl_patchLevel"
2206                append v ", Tk version $tk_patchLevel"
2207        }
2208
2209        label $w.vers \
2210                -text $v \
2211                -padx 5 -pady 5 \
2212                -justify left \
2213                -anchor w \
2214                -borderwidth 1 \
2215                -relief solid \
2216                -font font_ui
2217        pack $w.vers -side top -fill x -padx 5 -pady 5
2218
2219        bind $w <Visibility> "grab $w; focus $w"
2220        bind $w <Key-Escape> "destroy $w"
2221        wm title $w "About $appname"
2222        tkwait window $w
2223}
2224
2225proc do_options {} {
2226        global appname gitdir font_descs
2227        global repo_config global_config
2228        global repo_config_new global_config_new
2229
2230        array unset repo_config_new
2231        array unset global_config_new
2232        foreach name [array names repo_config] {
2233                set repo_config_new($name) $repo_config($name)
2234        }
2235        load_config 1
2236        foreach name [array names repo_config] {
2237                switch -- $name {
2238                gui.diffcontext {continue}
2239                }
2240                set repo_config_new($name) $repo_config($name)
2241        }
2242        foreach name [array names global_config] {
2243                set global_config_new($name) $global_config($name)
2244        }
2245        set reponame [lindex [file split \
2246                [file normalize [file dirname $gitdir]]] \
2247                end]
2248
2249        set w .options_editor
2250        toplevel $w
2251        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2252
2253        label $w.header -text "$appname Options" \
2254                -font font_uibold
2255        pack $w.header -side top -fill x
2256
2257        frame $w.buttons
2258        button $w.buttons.restore -text {Restore Defaults} \
2259                -font font_ui \
2260                -command do_restore_defaults
2261        pack $w.buttons.restore -side left
2262        button $w.buttons.save -text Save \
2263                -font font_ui \
2264                -command [list do_save_config $w]
2265        pack $w.buttons.save -side right
2266        button $w.buttons.cancel -text {Cancel} \
2267                -font font_ui \
2268                -command [list destroy $w]
2269        pack $w.buttons.cancel -side right
2270        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2271
2272        labelframe $w.repo -text "$reponame Repository" \
2273                -font font_ui \
2274                -relief raised -borderwidth 2
2275        labelframe $w.global -text {Global (All Repositories)} \
2276                -font font_ui \
2277                -relief raised -borderwidth 2
2278        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2279        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2280
2281        foreach option {
2282                {b partialinclude {Allow Partially Included Files}}
2283                {b pullsummary {Show Pull Summary}}
2284                {b trustmtime  {Trust File Modification Timestamps}}
2285                {i diffcontext {Number of Diff Context Lines}}
2286                } {
2287                set type [lindex $option 0]
2288                set name [lindex $option 1]
2289                set text [lindex $option 2]
2290                foreach f {repo global} {
2291                        switch $type {
2292                        b {
2293                                checkbutton $w.$f.$name -text $text \
2294                                        -variable ${f}_config_new(gui.$name) \
2295                                        -onvalue true \
2296                                        -offvalue false \
2297                                        -font font_ui
2298                                pack $w.$f.$name -side top -anchor w
2299                        }
2300                        i {
2301                                frame $w.$f.$name
2302                                label $w.$f.$name.l -text "$text:" -font font_ui
2303                                pack $w.$f.$name.l -side left -anchor w -fill x
2304                                spinbox $w.$f.$name.v \
2305                                        -textvariable ${f}_config_new(gui.$name) \
2306                                        -from 1 -to 99 -increment 1 \
2307                                        -width 3 \
2308                                        -font font_ui
2309                                pack $w.$f.$name.v -side right -anchor e
2310                                pack $w.$f.$name -side top -anchor w -fill x
2311                        }
2312                        }
2313                }
2314        }
2315
2316        set all_fonts [lsort [font families]]
2317        foreach option $font_descs {
2318                set name [lindex $option 0]
2319                set font [lindex $option 1]
2320                set text [lindex $option 2]
2321
2322                set global_config_new(gui.$font^^family) \
2323                        [font configure $font -family]
2324                set global_config_new(gui.$font^^size) \
2325                        [font configure $font -size]
2326
2327                frame $w.global.$name
2328                label $w.global.$name.l -text "$text:" -font font_ui
2329                pack $w.global.$name.l -side left -anchor w -fill x
2330                eval tk_optionMenu $w.global.$name.family \
2331                        global_config_new(gui.$font^^family) \
2332                        $all_fonts
2333                spinbox $w.global.$name.size \
2334                        -textvariable global_config_new(gui.$font^^size) \
2335                        -from 2 -to 80 -increment 1 \
2336                        -width 3 \
2337                        -font font_ui
2338                pack $w.global.$name.size -side right -anchor e
2339                pack $w.global.$name.family -side right -anchor e
2340                pack $w.global.$name -side top -anchor w -fill x
2341        }
2342
2343        bind $w <Visibility> "grab $w; focus $w"
2344        bind $w <Key-Escape> "destroy $w"
2345        wm title $w "$appname ($reponame): Options"
2346        tkwait window $w
2347}
2348
2349proc do_restore_defaults {} {
2350        global font_descs default_config repo_config
2351        global repo_config_new global_config_new
2352
2353        foreach name [array names default_config] {
2354                set repo_config_new($name) $default_config($name)
2355                set global_config_new($name) $default_config($name)
2356        }
2357
2358        foreach option $font_descs {
2359                set name [lindex $option 0]
2360                set repo_config(gui.$name) $default_config(gui.$name)
2361        }
2362        apply_config
2363
2364        foreach option $font_descs {
2365                set name [lindex $option 0]
2366                set font [lindex $option 1]
2367                set global_config_new(gui.$font^^family) \
2368                        [font configure $font -family]
2369                set global_config_new(gui.$font^^size) \
2370                        [font configure $font -size]
2371        }
2372}
2373
2374proc do_save_config {w} {
2375        if {[catch {save_config} err]} {
2376                error_popup "Failed to completely save options:\n\n$err"
2377        }
2378        reshow_diff
2379        destroy $w
2380}
2381
2382proc do_windows_shortcut {} {
2383        global gitdir appname argv0
2384
2385        set reponame [lindex [file split \
2386                [file normalize [file dirname $gitdir]]] \
2387                end]
2388
2389        if {[catch {
2390                set desktop [exec cygpath \
2391                        --windows \
2392                        --absolute \
2393                        --long-name \
2394                        --desktop]
2395                }]} {
2396                        set desktop .
2397        }
2398        set fn [tk_getSaveFile \
2399                -parent . \
2400                -title "$appname ($reponame): Create Desktop Icon" \
2401                -initialdir $desktop \
2402                -initialfile "Git $reponame.bat"]
2403        if {$fn != {}} {
2404                if {[catch {
2405                                set fd [open $fn w]
2406                                set sh [exec cygpath \
2407                                        --windows \
2408                                        --absolute \
2409                                        --long-name \
2410                                        /bin/sh]
2411                                set me [exec cygpath \
2412                                        --unix \
2413                                        --absolute \
2414                                        $argv0]
2415                                set gd [exec cygpath \
2416                                        --unix \
2417                                        --absolute \
2418                                        $gitdir]
2419                                regsub -all ' $me "'\\''" me
2420                                regsub -all ' $gd "'\\''" gd
2421                                puts -nonewline $fd "\"$sh\" --login -c \""
2422                                puts -nonewline $fd "GIT_DIR='$gd'"
2423                                puts -nonewline $fd " '$me'"
2424                                puts $fd "&\""
2425                                close $fd
2426                        } err]} {
2427                        error_popup "Cannot write script:\n\n$err"
2428                }
2429        }
2430}
2431
2432proc do_macosx_app {} {
2433        global gitdir appname argv0 env
2434
2435        set reponame [lindex [file split \
2436                [file normalize [file dirname $gitdir]]] \
2437                end]
2438
2439        set fn [tk_getSaveFile \
2440                -parent . \
2441                -title "$appname ($reponame): Create Desktop Icon" \
2442                -initialdir [file join $env(HOME) Desktop] \
2443                -initialfile "Git $reponame.app"]
2444        if {$fn != {}} {
2445                if {[catch {
2446                                set Contents [file join $fn Contents]
2447                                set MacOS [file join $Contents MacOS]
2448                                set exe [file join $MacOS git-gui]
2449
2450                                file mkdir $MacOS
2451
2452                                set fd [open [file join $Contents Info.plist] w]
2453                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2454<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2455<plist version="1.0">
2456<dict>
2457        <key>CFBundleDevelopmentRegion</key>
2458        <string>English</string>
2459        <key>CFBundleExecutable</key>
2460        <string>git-gui</string>
2461        <key>CFBundleIdentifier</key>
2462        <string>org.spearce.git-gui</string>
2463        <key>CFBundleInfoDictionaryVersion</key>
2464        <string>6.0</string>
2465        <key>CFBundlePackageType</key>
2466        <string>APPL</string>
2467        <key>CFBundleSignature</key>
2468        <string>????</string>
2469        <key>CFBundleVersion</key>
2470        <string>1.0</string>
2471        <key>NSPrincipalClass</key>
2472        <string>NSApplication</string>
2473</dict>
2474</plist>}
2475                                close $fd
2476
2477                                set fd [open $exe w]
2478                                set gd [file normalize $gitdir]
2479                                set ep [file normalize [exec git --exec-path]]
2480                                regsub -all ' $gd "'\\''" gd
2481                                regsub -all ' $ep "'\\''" ep
2482                                puts $fd "#!/bin/sh"
2483                                foreach name [array names env] {
2484                                        if {[string match GIT_* $name]} {
2485                                                regsub -all ' $env($name) "'\\''" v
2486                                                puts $fd "export $name='$v'"
2487                                        }
2488                                }
2489                                puts $fd "export PATH='$ep':\$PATH"
2490                                puts $fd "export GIT_DIR='$gd'"
2491                                puts $fd "exec [file normalize $argv0]"
2492                                close $fd
2493
2494                                file attributes $exe -permissions u+x,g+x,o+x
2495                        } err]} {
2496                        error_popup "Cannot write icon:\n\n$err"
2497                }
2498        }
2499}
2500
2501proc toggle_or_diff {w x y} {
2502        global file_states file_lists current_diff ui_index ui_other
2503        global last_clicked selected_paths
2504
2505        set pos [split [$w index @$x,$y] .]
2506        set lno [lindex $pos 0]
2507        set col [lindex $pos 1]
2508        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2509        if {$path eq {}} {
2510                set last_clicked {}
2511                return
2512        }
2513
2514        set last_clicked [list $w $lno]
2515        array unset selected_paths
2516        $ui_index tag remove in_sel 0.0 end
2517        $ui_other tag remove in_sel 0.0 end
2518
2519        if {$col == 0} {
2520                if {$current_diff eq $path} {
2521                        set after {reshow_diff;}
2522                } else {
2523                        set after {}
2524                }
2525                switch -glob -- [lindex $file_states($path) 0] {
2526                A_ -
2527                M_ -
2528                DD -
2529                DO -
2530                DM {
2531                        update_indexinfo \
2532                                "Removing [short_path $path] from commit" \
2533                                [list $path] \
2534                                [concat $after {set ui_status_value {Ready.}}]
2535                }
2536                ?? {
2537                        update_index \
2538                                "Including [short_path $path]" \
2539                                [list $path] \
2540                                [concat $after {set ui_status_value {Ready.}}]
2541                }
2542                }
2543        } else {
2544                show_diff $path $w $lno
2545        }
2546}
2547
2548proc add_one_to_selection {w x y} {
2549        global file_lists
2550        global last_clicked selected_paths
2551
2552        set pos [split [$w index @$x,$y] .]
2553        set lno [lindex $pos 0]
2554        set col [lindex $pos 1]
2555        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2556        if {$path eq {}} {
2557                set last_clicked {}
2558                return
2559        }
2560
2561        set last_clicked [list $w $lno]
2562        if {[catch {set in_sel $selected_paths($path)}]} {
2563                set in_sel 0
2564        }
2565        if {$in_sel} {
2566                unset selected_paths($path)
2567                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2568        } else {
2569                set selected_paths($path) 1
2570                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2571        }
2572}
2573
2574proc add_range_to_selection {w x y} {
2575        global file_lists
2576        global last_clicked selected_paths
2577
2578        if {[lindex $last_clicked 0] ne $w} {
2579                toggle_or_diff $w $x $y
2580                return
2581        }
2582
2583        set pos [split [$w index @$x,$y] .]
2584        set lno [lindex $pos 0]
2585        set lc [lindex $last_clicked 1]
2586        if {$lc < $lno} {
2587                set begin $lc
2588                set end $lno
2589        } else {
2590                set begin $lno
2591                set end $lc
2592        }
2593
2594        foreach path [lrange $file_lists($w) \
2595                [expr {$begin - 1}] \
2596                [expr {$end - 1}]] {
2597                set selected_paths($path) 1
2598        }
2599        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2600}
2601
2602######################################################################
2603##
2604## config defaults
2605
2606set cursor_ptr arrow
2607font create font_diff -family Courier -size 10
2608font create font_ui
2609catch {
2610        label .dummy
2611        eval font configure font_ui [font actual [.dummy cget -font]]
2612        destroy .dummy
2613}
2614
2615font create font_uibold
2616font create font_diffbold
2617
2618set M1B M1
2619set M1T M1
2620if {[is_Windows]} {
2621        set M1B Control
2622        set M1T Ctrl
2623} elseif {[is_MacOSX]} {
2624        set M1B M1
2625        set M1T Cmd
2626}
2627
2628proc apply_config {} {
2629        global repo_config font_descs
2630
2631        foreach option $font_descs {
2632                set name [lindex $option 0]
2633                set font [lindex $option 1]
2634                if {[catch {
2635                        foreach {cn cv} $repo_config(gui.$name) {
2636                                font configure $font $cn $cv
2637                        }
2638                        } err]} {
2639                        error_popup "Invalid font specified in gui.$name:\n\n$err"
2640                }
2641                foreach {cn cv} [font configure $font] {
2642                        font configure ${font}bold $cn $cv
2643                }
2644                font configure ${font}bold -weight bold
2645        }
2646}
2647
2648set default_config(gui.trustmtime) false
2649set default_config(gui.pullsummary) true
2650set default_config(gui.partialinclude) false
2651set default_config(gui.diffcontext) 5
2652set default_config(gui.fontui) [font configure font_ui]
2653set default_config(gui.fontdiff) [font configure font_diff]
2654set font_descs {
2655        {fontui   font_ui   {Main Font}}
2656        {fontdiff font_diff {Diff/Console Font}}
2657}
2658load_config 0
2659apply_config
2660
2661######################################################################
2662##
2663## ui construction
2664
2665# -- Menu Bar
2666#
2667menu .mbar -tearoff 0
2668.mbar add cascade -label Repository -menu .mbar.repository
2669.mbar add cascade -label Edit -menu .mbar.edit
2670.mbar add cascade -label Commit -menu .mbar.commit
2671if {!$single_commit} {
2672        .mbar add cascade -label Fetch -menu .mbar.fetch
2673        .mbar add cascade -label Pull -menu .mbar.pull
2674        .mbar add cascade -label Push -menu .mbar.push
2675}
2676. configure -menu .mbar
2677
2678# -- Repository Menu
2679#
2680menu .mbar.repository
2681.mbar.repository add command -label Visualize \
2682        -command do_gitk \
2683        -font font_ui
2684if {!$single_commit} {
2685        .mbar.repository add separator
2686
2687        .mbar.repository add command -label {Repack Database} \
2688                -command do_repack \
2689                -font font_ui
2690
2691        .mbar.repository add command -label {Verify Database} \
2692                -command do_fsck_objects \
2693                -font font_ui
2694
2695        .mbar.repository add separator
2696
2697        if {[is_Windows]} {
2698                .mbar.repository add command \
2699                        -label {Create Desktop Icon} \
2700                        -command do_windows_shortcut \
2701                        -font font_ui
2702        } elseif {[is_MacOSX]} {
2703                .mbar.repository add command \
2704                        -label {Create Desktop Icon} \
2705                        -command do_macosx_app \
2706                        -font font_ui
2707        }
2708}
2709.mbar.repository add command -label Quit \
2710        -command do_quit \
2711        -accelerator $M1T-Q \
2712        -font font_ui
2713
2714# -- Edit Menu
2715#
2716menu .mbar.edit
2717.mbar.edit add command -label Undo \
2718        -command {catch {[focus] edit undo}} \
2719        -accelerator $M1T-Z \
2720        -font font_ui
2721.mbar.edit add command -label Redo \
2722        -command {catch {[focus] edit redo}} \
2723        -accelerator $M1T-Y \
2724        -font font_ui
2725.mbar.edit add separator
2726.mbar.edit add command -label Cut \
2727        -command {catch {tk_textCut [focus]}} \
2728        -accelerator $M1T-X \
2729        -font font_ui
2730.mbar.edit add command -label Copy \
2731        -command {catch {tk_textCopy [focus]}} \
2732        -accelerator $M1T-C \
2733        -font font_ui
2734.mbar.edit add command -label Paste \
2735        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2736        -accelerator $M1T-V \
2737        -font font_ui
2738.mbar.edit add command -label Delete \
2739        -command {catch {[focus] delete sel.first sel.last}} \
2740        -accelerator Del \
2741        -font font_ui
2742.mbar.edit add separator
2743.mbar.edit add command -label {Select All} \
2744        -command {catch {[focus] tag add sel 0.0 end}} \
2745        -accelerator $M1T-A \
2746        -font font_ui
2747
2748# -- Commit Menu
2749#
2750menu .mbar.commit
2751
2752.mbar.commit add radiobutton \
2753        -label {New Commit} \
2754        -command do_select_commit_type \
2755        -variable selected_commit_type \
2756        -value new \
2757        -font font_ui
2758lappend disable_on_lock \
2759        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2760
2761.mbar.commit add radiobutton \
2762        -label {Amend Last Commit} \
2763        -command do_select_commit_type \
2764        -variable selected_commit_type \
2765        -value amend \
2766        -font font_ui
2767lappend disable_on_lock \
2768        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2769
2770.mbar.commit add separator
2771
2772.mbar.commit add command -label Rescan \
2773        -command do_rescan \
2774        -accelerator F5 \
2775        -font font_ui
2776lappend disable_on_lock \
2777        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2778
2779.mbar.commit add command -label {Remove From Commit} \
2780        -command do_remove_selection \
2781        -font font_ui
2782lappend disable_on_lock \
2783        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2784
2785.mbar.commit add command -label {Include In Commit} \
2786        -command do_include_selection \
2787        -font font_ui
2788lappend disable_on_lock \
2789        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2790
2791.mbar.commit add command -label {Include All In Commit} \
2792        -command do_include_all \
2793        -accelerator $M1T-I \
2794        -font font_ui
2795lappend disable_on_lock \
2796        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2797
2798.mbar.commit add separator
2799
2800.mbar.commit add command -label {Sign Off} \
2801        -command do_signoff \
2802        -accelerator $M1T-S \
2803        -font font_ui
2804
2805.mbar.commit add command -label Commit \
2806        -command do_commit \
2807        -accelerator $M1T-Return \
2808        -font font_ui
2809lappend disable_on_lock \
2810        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2811
2812# -- Transport menus
2813#
2814if {!$single_commit} {
2815        menu .mbar.fetch
2816        menu .mbar.pull
2817        menu .mbar.push
2818}
2819
2820if {[is_MacOSX]} {
2821        # -- Apple Menu (Mac OS X only)
2822        #
2823        .mbar add cascade -label Apple -menu .mbar.apple
2824        menu .mbar.apple
2825
2826        .mbar.apple add command -label "About $appname" \
2827                -command do_about \
2828                -font font_ui
2829        .mbar.apple add command -label "$appname Options..." \
2830                -command do_options \
2831                -font font_ui
2832} else {
2833        # -- Edit Menu
2834        #
2835        .mbar.edit add separator
2836        .mbar.edit add command -label {Options...} \
2837                -command do_options \
2838                -font font_ui
2839
2840        # -- Help Menu
2841        #
2842        .mbar add cascade -label Help -menu .mbar.help
2843        menu .mbar.help
2844
2845        .mbar.help add command -label "About $appname" \
2846                -command do_about \
2847                -font font_ui
2848}
2849
2850
2851# -- Main Window Layout
2852#
2853panedwindow .vpane -orient vertical
2854panedwindow .vpane.files -orient horizontal
2855.vpane add .vpane.files -sticky nsew -height 100 -width 400
2856pack .vpane -anchor n -side top -fill both -expand 1
2857
2858# -- Index File List
2859#
2860frame .vpane.files.index -height 100 -width 400
2861label .vpane.files.index.title -text {Modified Files} \
2862        -background green \
2863        -font font_ui
2864text $ui_index -background white -borderwidth 0 \
2865        -width 40 -height 10 \
2866        -font font_ui \
2867        -cursor $cursor_ptr \
2868        -yscrollcommand {.vpane.files.index.sb set} \
2869        -state disabled
2870scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2871pack .vpane.files.index.title -side top -fill x
2872pack .vpane.files.index.sb -side right -fill y
2873pack $ui_index -side left -fill both -expand 1
2874.vpane.files add .vpane.files.index -sticky nsew
2875
2876# -- Other (Add) File List
2877#
2878frame .vpane.files.other -height 100 -width 100
2879label .vpane.files.other.title -text {Untracked Files} \
2880        -background red \
2881        -font font_ui
2882text $ui_other -background white -borderwidth 0 \
2883        -width 40 -height 10 \
2884        -font font_ui \
2885        -cursor $cursor_ptr \
2886        -yscrollcommand {.vpane.files.other.sb set} \
2887        -state disabled
2888scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2889pack .vpane.files.other.title -side top -fill x
2890pack .vpane.files.other.sb -side right -fill y
2891pack $ui_other -side left -fill both -expand 1
2892.vpane.files add .vpane.files.other -sticky nsew
2893
2894foreach i [list $ui_index $ui_other] {
2895        $i tag conf in_diff -font font_uibold
2896        $i tag conf in_sel \
2897                -background [$i cget -foreground] \
2898                -foreground [$i cget -background]
2899}
2900unset i
2901
2902# -- Diff and Commit Area
2903#
2904frame .vpane.lower -height 300 -width 400
2905frame .vpane.lower.commarea
2906frame .vpane.lower.diff -relief sunken -borderwidth 1
2907pack .vpane.lower.commarea -side top -fill x
2908pack .vpane.lower.diff -side bottom -fill both -expand 1
2909.vpane add .vpane.lower -stick nsew
2910
2911# -- Commit Area Buttons
2912#
2913frame .vpane.lower.commarea.buttons
2914label .vpane.lower.commarea.buttons.l -text {} \
2915        -anchor w \
2916        -justify left \
2917        -font font_ui
2918pack .vpane.lower.commarea.buttons.l -side top -fill x
2919pack .vpane.lower.commarea.buttons -side left -fill y
2920
2921button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2922        -command do_rescan \
2923        -font font_ui
2924pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2925lappend disable_on_lock \
2926        {.vpane.lower.commarea.buttons.rescan conf -state}
2927
2928button .vpane.lower.commarea.buttons.incall -text {Include All} \
2929        -command do_include_all \
2930        -font font_ui
2931pack .vpane.lower.commarea.buttons.incall -side top -fill x
2932lappend disable_on_lock \
2933        {.vpane.lower.commarea.buttons.incall conf -state}
2934
2935button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2936        -command do_signoff \
2937        -font font_ui
2938pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2939
2940button .vpane.lower.commarea.buttons.commit -text {Commit} \
2941        -command do_commit \
2942        -font font_ui
2943pack .vpane.lower.commarea.buttons.commit -side top -fill x
2944lappend disable_on_lock \
2945        {.vpane.lower.commarea.buttons.commit conf -state}
2946
2947# -- Commit Message Buffer
2948#
2949frame .vpane.lower.commarea.buffer
2950frame .vpane.lower.commarea.buffer.header
2951set ui_comm .vpane.lower.commarea.buffer.t
2952set ui_coml .vpane.lower.commarea.buffer.header.l
2953radiobutton .vpane.lower.commarea.buffer.header.new \
2954        -text {New Commit} \
2955        -command do_select_commit_type \
2956        -variable selected_commit_type \
2957        -value new \
2958        -font font_ui
2959lappend disable_on_lock \
2960        [list .vpane.lower.commarea.buffer.header.new conf -state]
2961radiobutton .vpane.lower.commarea.buffer.header.amend \
2962        -text {Amend Last Commit} \
2963        -command do_select_commit_type \
2964        -variable selected_commit_type \
2965        -value amend \
2966        -font font_ui
2967lappend disable_on_lock \
2968        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2969label $ui_coml \
2970        -anchor w \
2971        -justify left \
2972        -font font_ui
2973proc trace_commit_type {varname args} {
2974        global ui_coml commit_type
2975        switch -glob -- $commit_type {
2976        initial       {set txt {Initial Commit Message:}}
2977        amend         {set txt {Amended Commit Message:}}
2978        amend-initial {set txt {Amended Initial Commit Message:}}
2979        amend-merge   {set txt {Amended Merge Commit Message:}}
2980        merge         {set txt {Merge Commit Message:}}
2981        *             {set txt {Commit Message:}}
2982        }
2983        $ui_coml conf -text $txt
2984}
2985trace add variable commit_type write trace_commit_type
2986pack $ui_coml -side left -fill x
2987pack .vpane.lower.commarea.buffer.header.amend -side right
2988pack .vpane.lower.commarea.buffer.header.new -side right
2989
2990text $ui_comm -background white -borderwidth 1 \
2991        -undo true \
2992        -maxundo 20 \
2993        -autoseparators true \
2994        -relief sunken \
2995        -width 75 -height 9 -wrap none \
2996        -font font_diff \
2997        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2998scrollbar .vpane.lower.commarea.buffer.sby \
2999        -command [list $ui_comm yview]
3000pack .vpane.lower.commarea.buffer.header -side top -fill x
3001pack .vpane.lower.commarea.buffer.sby -side right -fill y
3002pack $ui_comm -side left -fill y
3003pack .vpane.lower.commarea.buffer -side left -fill y
3004
3005# -- Commit Message Buffer Context Menu
3006#
3007set ctxm .vpane.lower.commarea.buffer.ctxm
3008menu $ctxm -tearoff 0
3009$ctxm add command \
3010        -label {Cut} \
3011        -font font_ui \
3012        -command {tk_textCut $ui_comm}
3013$ctxm add command \
3014        -label {Copy} \
3015        -font font_ui \
3016        -command {tk_textCopy $ui_comm}
3017$ctxm add command \
3018        -label {Paste} \
3019        -font font_ui \
3020        -command {tk_textPaste $ui_comm}
3021$ctxm add command \
3022        -label {Delete} \
3023        -font font_ui \
3024        -command {$ui_comm delete sel.first sel.last}
3025$ctxm add separator
3026$ctxm add command \
3027        -label {Select All} \
3028        -font font_ui \
3029        -command {$ui_comm tag add sel 0.0 end}
3030$ctxm add command \
3031        -label {Copy All} \
3032        -font font_ui \
3033        -command {
3034                $ui_comm tag add sel 0.0 end
3035                tk_textCopy $ui_comm
3036                $ui_comm tag remove sel 0.0 end
3037        }
3038$ctxm add separator
3039$ctxm add command \
3040        -label {Sign Off} \
3041        -font font_ui \
3042        -command do_signoff
3043bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3044
3045# -- Diff Header
3046#
3047set current_diff {}
3048set diff_actions [list]
3049proc trace_current_diff {varname args} {
3050        global current_diff diff_actions file_states
3051        if {$current_diff eq {}} {
3052                set s {}
3053                set f {}
3054                set p {}
3055                set o disabled
3056        } else {
3057                set p $current_diff
3058                set s [mapdesc [lindex $file_states($p) 0] $p]
3059                set f {File:}
3060                set p [escape_path $p]
3061                set o normal
3062        }
3063
3064        .vpane.lower.diff.header.status configure -text $s
3065        .vpane.lower.diff.header.file configure -text $f
3066        .vpane.lower.diff.header.path configure -text $p
3067        foreach w $diff_actions {
3068                uplevel #0 $w $o
3069        }
3070}
3071trace add variable current_diff write trace_current_diff
3072
3073frame .vpane.lower.diff.header -background orange
3074label .vpane.lower.diff.header.status \
3075        -background orange \
3076        -width $max_status_desc \
3077        -anchor w \
3078        -justify left \
3079        -font font_ui
3080label .vpane.lower.diff.header.file \
3081        -background orange \
3082        -anchor w \
3083        -justify left \
3084        -font font_ui
3085label .vpane.lower.diff.header.path \
3086        -background orange \
3087        -anchor w \
3088        -justify left \
3089        -font font_ui
3090pack .vpane.lower.diff.header.status -side left
3091pack .vpane.lower.diff.header.file -side left
3092pack .vpane.lower.diff.header.path -fill x
3093set ctxm .vpane.lower.diff.header.ctxm
3094menu $ctxm -tearoff 0
3095$ctxm add command \
3096        -label {Copy} \
3097        -font font_ui \
3098        -command {
3099                clipboard clear
3100                clipboard append \
3101                        -format STRING \
3102                        -type STRING \
3103                        -- $current_diff
3104        }
3105lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3106bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3107
3108# -- Diff Body
3109#
3110frame .vpane.lower.diff.body
3111set ui_diff .vpane.lower.diff.body.t
3112text $ui_diff -background white -borderwidth 0 \
3113        -width 80 -height 15 -wrap none \
3114        -font font_diff \
3115        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3116        -yscrollcommand {.vpane.lower.diff.body.sby set} \
3117        -state disabled
3118scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3119        -command [list $ui_diff xview]
3120scrollbar .vpane.lower.diff.body.sby -orient vertical \
3121        -command [list $ui_diff yview]
3122pack .vpane.lower.diff.body.sbx -side bottom -fill x
3123pack .vpane.lower.diff.body.sby -side right -fill y
3124pack $ui_diff -side left -fill both -expand 1
3125pack .vpane.lower.diff.header -side top -fill x
3126pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3127
3128$ui_diff tag conf d_@ -font font_diffbold
3129$ui_diff tag conf d_+  -foreground blue
3130$ui_diff tag conf d_-  -foreground red
3131$ui_diff tag conf d_++ -foreground {#00a000}
3132$ui_diff tag conf d_-- -foreground {#a000a0}
3133$ui_diff tag conf d_+- \
3134        -foreground red \
3135        -background {light goldenrod yellow}
3136$ui_diff tag conf d_-+ \
3137        -foreground blue \
3138        -background azure2
3139
3140# -- Diff Body Context Menu
3141#
3142set ctxm .vpane.lower.diff.body.ctxm
3143menu $ctxm -tearoff 0
3144$ctxm add command \
3145        -label {Copy} \
3146        -font font_ui \
3147        -command {tk_textCopy $ui_diff}
3148lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3149$ctxm add command \
3150        -label {Select All} \
3151        -font font_ui \
3152        -command {$ui_diff tag add sel 0.0 end}
3153lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3154$ctxm add command \
3155        -label {Copy All} \
3156        -font font_ui \
3157        -command {
3158                $ui_diff tag add sel 0.0 end
3159                tk_textCopy $ui_diff
3160                $ui_diff tag remove sel 0.0 end
3161        }
3162lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3163$ctxm add separator
3164$ctxm add command \
3165        -label {Decrease Font Size} \
3166        -font font_ui \
3167        -command {incr_font_size font_diff -1}
3168lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3169$ctxm add command \
3170        -label {Increase Font Size} \
3171        -font font_ui \
3172        -command {incr_font_size font_diff 1}
3173lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3174$ctxm add separator
3175$ctxm add command \
3176        -label {Show Less Context} \
3177        -font font_ui \
3178        -command {if {$repo_config(gui.diffcontext) >= 2} {
3179                incr repo_config(gui.diffcontext) -1
3180                reshow_diff
3181        }}
3182lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3183$ctxm add command \
3184        -label {Show More Context} \
3185        -font font_ui \
3186        -command {
3187                incr repo_config(gui.diffcontext)
3188                reshow_diff
3189        }
3190lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3191$ctxm add separator
3192$ctxm add command -label {Options...} \
3193        -font font_ui \
3194        -command do_options
3195bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3196
3197# -- Status Bar
3198#
3199set ui_status_value {Initializing...}
3200label .status -textvariable ui_status_value \
3201        -anchor w \
3202        -justify left \
3203        -borderwidth 1 \
3204        -relief sunken \
3205        -font font_ui
3206pack .status -anchor w -side bottom -fill x
3207
3208# -- Load geometry
3209#
3210catch {
3211set gm $repo_config(gui.geometry)
3212wm geometry . [lindex $gm 0]
3213.vpane sash place 0 \
3214        [lindex [.vpane sash coord 0] 0] \
3215        [lindex $gm 1]
3216.vpane.files sash place 0 \
3217        [lindex $gm 2] \
3218        [lindex [.vpane.files sash coord 0] 1]
3219unset gm
3220}
3221
3222# -- Key Bindings
3223#
3224bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3225bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3226bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3227bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3228bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3229bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3230bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3231bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3232bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3233bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3234bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3235
3236bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3237bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3238bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3239bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3240bind $ui_diff <$M1B-Key-v> {break}
3241bind $ui_diff <$M1B-Key-V> {break}
3242bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3243bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3244bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3245bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3246bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3247bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3248
3249bind .   <Destroy> do_quit
3250bind all <Key-F5> do_rescan
3251bind all <$M1B-Key-r> do_rescan
3252bind all <$M1B-Key-R> do_rescan
3253bind .   <$M1B-Key-s> do_signoff
3254bind .   <$M1B-Key-S> do_signoff
3255bind .   <$M1B-Key-i> do_include_all
3256bind .   <$M1B-Key-I> do_include_all
3257bind .   <$M1B-Key-Return> do_commit
3258bind all <$M1B-Key-q> do_quit
3259bind all <$M1B-Key-Q> do_quit
3260bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3261bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3262foreach i [list $ui_index $ui_other] {
3263        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3264        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3265        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3266}
3267unset i
3268
3269set file_lists($ui_index) [list]
3270set file_lists($ui_other) [list]
3271
3272set HEAD {}
3273set PARENT {}
3274set MERGE_HEAD [list]
3275set commit_type {}
3276set empty_tree {}
3277set current_diff {}
3278set selected_commit_type new
3279
3280wm title . "$appname ([file normalize [file dirname $gitdir]])"
3281focus -force $ui_comm
3282if {!$single_commit} {
3283        load_all_remotes
3284        populate_fetch_menu .mbar.fetch
3285        populate_pull_menu .mbar.pull
3286        populate_push_menu .mbar.push
3287}
3288lock_index begin-read
3289after 1 do_rescan