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