Andrew's git / gitweb.git / git-gui
?
git-guion commit git-gui: Allow update_index to also run a script when it completes. (04b3938)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5# Copyright (C) 2006 Shawn Pearce, Paul Mackerras.  All rights reserved.
   6# This program is free software; it may be used, copied, modified
   7# and distributed under the terms of the GNU General Public Licence,
   8# either version 2, or (at your option) any later version.
   9
  10set appname [lindex [file split $argv0] end]
  11set gitdir {}
  12
  13######################################################################
  14##
  15## config
  16
  17proc is_many_config {name} {
  18        switch -glob -- $name {
  19        remote.*.fetch -
  20        remote.*.push
  21                {return 1}
  22        *
  23                {return 0}
  24        }
  25}
  26
  27proc load_config {include_global} {
  28        global repo_config global_config default_config
  29
  30        array unset global_config
  31        if {$include_global} {
  32                catch {
  33                        set fd_rc [open "| git repo-config --global --list" r]
  34                        while {[gets $fd_rc line] >= 0} {
  35                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  36                                        if {[is_many_config $name]} {
  37                                                lappend global_config($name) $value
  38                                        } else {
  39                                                set global_config($name) $value
  40                                        }
  41                                }
  42                        }
  43                        close $fd_rc
  44                }
  45        }
  46
  47        array unset repo_config
  48        catch {
  49                set fd_rc [open "| git repo-config --list" r]
  50                while {[gets $fd_rc line] >= 0} {
  51                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  52                                if {[is_many_config $name]} {
  53                                        lappend repo_config($name) $value
  54                                } else {
  55                                        set repo_config($name) $value
  56                                }
  57                        }
  58                }
  59                close $fd_rc
  60        }
  61
  62        foreach name [array names default_config] {
  63                if {[catch {set v $global_config($name)}]} {
  64                        set global_config($name) $default_config($name)
  65                }
  66                if {[catch {set v $repo_config($name)}]} {
  67                        set repo_config($name) $default_config($name)
  68                }
  69        }
  70}
  71
  72proc save_config {} {
  73        global default_config font_descs
  74        global repo_config global_config
  75        global repo_config_new global_config_new
  76
  77        foreach option $font_descs {
  78                set name [lindex $option 0]
  79                set font [lindex $option 1]
  80                font configure $font \
  81                        -family $global_config_new(gui.$font^^family) \
  82                        -size $global_config_new(gui.$font^^size)
  83                font configure ${font}bold \
  84                        -family $global_config_new(gui.$font^^family) \
  85                        -size $global_config_new(gui.$font^^size)
  86                set global_config_new(gui.$name) [font configure $font]
  87                unset global_config_new(gui.$font^^family)
  88                unset global_config_new(gui.$font^^size)
  89        }
  90
  91        foreach name [array names default_config] {
  92                set value $global_config_new($name)
  93                if {$value ne $global_config($name)} {
  94                        if {$value eq $default_config($name)} {
  95                                catch {exec git repo-config --global --unset $name}
  96                        } else {
  97                                regsub -all "\[{}\]" $value {"} value
  98                                exec git repo-config --global $name $value
  99                        }
 100                        set global_config($name) $value
 101                        if {$value eq $repo_config($name)} {
 102                                catch {exec git repo-config --unset $name}
 103                                set repo_config($name) $value
 104                        }
 105                }
 106        }
 107
 108        foreach name [array names default_config] {
 109                set value $repo_config_new($name)
 110                if {$value ne $repo_config($name)} {
 111                        if {$value eq $global_config($name)} {
 112                                catch {exec git repo-config --unset $name}
 113                        } else {
 114                                regsub -all "\[{}\]" $value {"} value
 115                                exec git repo-config $name $value
 116                        }
 117                        set repo_config($name) $value
 118                }
 119        }
 120}
 121
 122proc error_popup {msg} {
 123        global gitdir appname
 124
 125        set title $appname
 126        if {$gitdir ne {}} {
 127                append title { (}
 128                append title [lindex \
 129                        [file split [file normalize [file dirname $gitdir]]] \
 130                        end]
 131                append title {)}
 132        }
 133        tk_messageBox \
 134                -parent . \
 135                -icon error \
 136                -type ok \
 137                -title "$title: error" \
 138                -message $msg
 139}
 140
 141proc info_popup {msg} {
 142        global gitdir appname
 143
 144        set title $appname
 145        if {$gitdir ne {}} {
 146                append title { (}
 147                append title [lindex \
 148                        [file split [file normalize [file dirname $gitdir]]] \
 149                        end]
 150                append title {)}
 151        }
 152        tk_messageBox \
 153                -parent . \
 154                -icon error \
 155                -type ok \
 156                -title $title \
 157                -message $msg
 158}
 159
 160######################################################################
 161##
 162## repository setup
 163
 164if {   [catch {set cdup [exec git rev-parse --show-cdup]} err]
 165        || [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
 166        catch {wm withdraw .}
 167        error_popup "Cannot find the git directory:\n\n$err"
 168        exit 1
 169}
 170if {$cdup ne ""} {
 171        cd $cdup
 172}
 173unset cdup
 174
 175set single_commit 0
 176if {$appname eq {git-citool}} {
 177        set single_commit 1
 178}
 179
 180######################################################################
 181##
 182## task management
 183
 184set rescan_active 0
 185set diff_active 0
 186set last_clicked {}
 187
 188set disable_on_lock [list]
 189set index_lock_type none
 190
 191set HEAD {}
 192set PARENT {}
 193set commit_type {}
 194
 195proc lock_index {type} {
 196        global index_lock_type disable_on_lock
 197
 198        if {$index_lock_type eq {none}} {
 199                set index_lock_type $type
 200                foreach w $disable_on_lock {
 201                        uplevel #0 $w disabled
 202                }
 203                return 1
 204        } elseif {$index_lock_type eq {begin-update} && $type eq {update}} {
 205                set index_lock_type $type
 206                return 1
 207        }
 208        return 0
 209}
 210
 211proc unlock_index {} {
 212        global index_lock_type disable_on_lock
 213
 214        set index_lock_type none
 215        foreach w $disable_on_lock {
 216                uplevel #0 $w normal
 217        }
 218}
 219
 220######################################################################
 221##
 222## status
 223
 224proc repository_state {hdvar ctvar} {
 225        global gitdir
 226        upvar $hdvar hd $ctvar ct
 227
 228        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 229                set ct initial
 230        } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
 231                set ct merge
 232        } else {
 233                set ct normal
 234        }
 235}
 236
 237proc rescan {after} {
 238        global HEAD PARENT commit_type
 239        global ui_index ui_other ui_status_value ui_comm
 240        global rescan_active file_states
 241        global repo_config
 242
 243        if {$rescan_active > 0 || ![lock_index read]} return
 244
 245        repository_state new_HEAD new_type
 246        if {$commit_type eq {amend}
 247                && $new_type eq {normal}
 248                && $new_HEAD eq $HEAD} {
 249        } else {
 250                set HEAD $new_HEAD
 251                set PARENT $new_HEAD
 252                set commit_type $new_type
 253        }
 254
 255        array unset file_states
 256
 257        if {![$ui_comm edit modified]
 258                || [string trim [$ui_comm get 0.0 end]] eq {}} {
 259                if {[load_message GITGUI_MSG]} {
 260                } elseif {[load_message MERGE_MSG]} {
 261                } elseif {[load_message SQUASH_MSG]} {
 262                }
 263                $ui_comm edit modified false
 264                $ui_comm edit reset
 265        }
 266
 267        if {$repo_config(gui.trustmtime) eq {true}} {
 268                rescan_stage2 {} $after
 269        } else {
 270                set rescan_active 1
 271                set ui_status_value {Refreshing file status...}
 272                set cmd [list git update-index]
 273                lappend cmd -q
 274                lappend cmd --unmerged
 275                lappend cmd --ignore-missing
 276                lappend cmd --refresh
 277                set fd_rf [open "| $cmd" r]
 278                fconfigure $fd_rf -blocking 0 -translation binary
 279                fileevent $fd_rf readable \
 280                        [list rescan_stage2 $fd_rf $after]
 281        }
 282}
 283
 284proc rescan_stage2 {fd after} {
 285        global gitdir PARENT commit_type
 286        global ui_index ui_other ui_status_value ui_comm
 287        global rescan_active
 288        global buf_rdi buf_rdf buf_rlo
 289
 290        if {$fd ne {}} {
 291                read $fd
 292                if {![eof $fd]} return
 293                close $fd
 294        }
 295
 296        set ls_others [list | git ls-files --others -z \
 297                --exclude-per-directory=.gitignore]
 298        set info_exclude [file join $gitdir info exclude]
 299        if {[file readable $info_exclude]} {
 300                lappend ls_others "--exclude-from=$info_exclude"
 301        }
 302
 303        set buf_rdi {}
 304        set buf_rdf {}
 305        set buf_rlo {}
 306
 307        set rescan_active 3
 308        set ui_status_value {Scanning for modified files ...}
 309        set fd_di [open "| git diff-index --cached -z $PARENT" r]
 310        set fd_df [open "| git diff-files -z" r]
 311        set fd_lo [open $ls_others r]
 312
 313        fconfigure $fd_di -blocking 0 -translation binary
 314        fconfigure $fd_df -blocking 0 -translation binary
 315        fconfigure $fd_lo -blocking 0 -translation binary
 316        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 317        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 318        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 319}
 320
 321proc load_message {file} {
 322        global gitdir ui_comm
 323
 324        set f [file join $gitdir $file]
 325        if {[file isfile $f]} {
 326                if {[catch {set fd [open $f r]}]} {
 327                        return 0
 328                }
 329                set content [string trim [read $fd]]
 330                close $fd
 331                $ui_comm delete 0.0 end
 332                $ui_comm insert end $content
 333                return 1
 334        }
 335        return 0
 336}
 337
 338proc read_diff_index {fd after} {
 339        global buf_rdi
 340
 341        append buf_rdi [read $fd]
 342        set c 0
 343        set n [string length $buf_rdi]
 344        while {$c < $n} {
 345                set z1 [string first "\0" $buf_rdi $c]
 346                if {$z1 == -1} break
 347                incr z1
 348                set z2 [string first "\0" $buf_rdi $z1]
 349                if {$z2 == -1} break
 350
 351                set c $z2
 352                incr z2 -1
 353                display_file \
 354                        [string range $buf_rdi $z1 $z2] \
 355                        [string index $buf_rdi [expr {$z1 - 2}]]_
 356                incr c
 357        }
 358        if {$c < $n} {
 359                set buf_rdi [string range $buf_rdi $c end]
 360        } else {
 361                set buf_rdi {}
 362        }
 363
 364        rescan_done $fd buf_rdi $after
 365}
 366
 367proc read_diff_files {fd after} {
 368        global buf_rdf
 369
 370        append buf_rdf [read $fd]
 371        set c 0
 372        set n [string length $buf_rdf]
 373        while {$c < $n} {
 374                set z1 [string first "\0" $buf_rdf $c]
 375                if {$z1 == -1} break
 376                incr z1
 377                set z2 [string first "\0" $buf_rdf $z1]
 378                if {$z2 == -1} break
 379
 380                set c $z2
 381                incr z2 -1
 382                display_file \
 383                        [string range $buf_rdf $z1 $z2] \
 384                        _[string index $buf_rdf [expr {$z1 - 2}]]
 385                incr c
 386        }
 387        if {$c < $n} {
 388                set buf_rdf [string range $buf_rdf $c end]
 389        } else {
 390                set buf_rdf {}
 391        }
 392
 393        rescan_done $fd buf_rdf $after
 394}
 395
 396proc read_ls_others {fd after} {
 397        global buf_rlo
 398
 399        append buf_rlo [read $fd]
 400        set pck [split $buf_rlo "\0"]
 401        set buf_rlo [lindex $pck end]
 402        foreach p [lrange $pck 0 end-1] {
 403                display_file $p _O
 404        }
 405        rescan_done $fd buf_rlo $after
 406}
 407
 408proc rescan_done {fd buf after} {
 409        global rescan_active
 410        global file_states repo_config
 411        upvar $buf to_clear
 412
 413        if {![eof $fd]} return
 414        set to_clear {}
 415        close $fd
 416        if {[incr rescan_active -1] > 0} return
 417
 418        prune_selection
 419        unlock_index
 420        display_all_files
 421
 422        if {$repo_config(gui.partialinclude) ne {true}} {
 423                set pathList  [list]
 424                foreach path [array names file_states] {
 425                        switch -- [lindex $file_states($path) 0] {
 426                        AM -
 427                        MM {lappend pathList $path}
 428                        }
 429                }
 430                if {$pathList ne {}} {
 431                        update_index \
 432                                "Updating included files" \
 433                                $pathList \
 434                                [concat {reshow_diff;} $after]
 435                        return
 436                }
 437        }
 438
 439        reshow_diff
 440        uplevel #0 $after
 441}
 442
 443proc prune_selection {} {
 444        global file_states selected_paths
 445
 446        foreach path [array names selected_paths] {
 447                if {[catch {set still_here $file_states($path)}]} {
 448                        unset selected_paths($path)
 449                }
 450        }
 451}
 452
 453######################################################################
 454##
 455## diff
 456
 457proc clear_diff {} {
 458        global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
 459
 460        $ui_diff conf -state normal
 461        $ui_diff delete 0.0 end
 462        $ui_diff conf -state disabled
 463
 464        set ui_fname_value {}
 465        set ui_fstatus_value {}
 466
 467        $ui_index tag remove in_diff 0.0 end
 468        $ui_other tag remove in_diff 0.0 end
 469}
 470
 471proc reshow_diff {} {
 472        global ui_fname_value ui_status_value file_states
 473
 474        if {$ui_fname_value eq {}
 475                || [catch {set s $file_states($ui_fname_value)}]} {
 476                clear_diff
 477        } else {
 478                show_diff $ui_fname_value
 479        }
 480}
 481
 482proc handle_empty_diff {} {
 483        global ui_fname_value file_states file_lists
 484
 485        set path $ui_fname_value
 486        set s $file_states($path)
 487        if {[lindex $s 0] ne {_M}} return
 488
 489        info_popup "No differences detected.
 490
 491[short_path $path] has no changes.
 492
 493The modification date of this file was updated
 494by another application and you currently have
 495the Trust File Modification Timestamps option
 496enabled, so Git did not automatically detect
 497that there are no content differences in this
 498file.
 499
 500This file will now be removed from the modified
 501files list, to prevent possible confusion.
 502"
 503        if {[catch {exec git update-index -- $path} err]} {
 504                error_popup "Failed to refresh index:\n\n$err"
 505        }
 506
 507        clear_diff
 508        set old_w [mapcol [lindex $file_states($path) 0] $path]
 509        set lno [lsearch -sorted $file_lists($old_w) $path]
 510        if {$lno >= 0} {
 511                set file_lists($old_w) \
 512                        [lreplace $file_lists($old_w) $lno $lno]
 513                incr lno
 514                $old_w conf -state normal
 515                $old_w delete $lno.0 [expr {$lno + 1}].0
 516                $old_w conf -state disabled
 517        }
 518}
 519
 520proc show_diff {path {w {}} {lno {}}} {
 521        global file_states file_lists
 522        global PARENT diff_3way diff_active repo_config
 523        global ui_diff ui_fname_value ui_fstatus_value ui_status_value
 524
 525        if {$diff_active || ![lock_index read]} return
 526
 527        clear_diff
 528        if {$w eq {} || $lno == {}} {
 529                foreach w [array names file_lists] {
 530                        set lno [lsearch -sorted $file_lists($w) $path]
 531                        if {$lno >= 0} {
 532                                incr lno
 533                                break
 534                        }
 535                }
 536        }
 537        if {$w ne {} && $lno >= 1} {
 538                $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 539        }
 540
 541        set s $file_states($path)
 542        set m [lindex $s 0]
 543        set diff_3way 0
 544        set diff_active 1
 545        set ui_fname_value $path
 546        set ui_fstatus_value [mapdesc $m $path]
 547        set ui_status_value "Loading diff of [escape_path $path]..."
 548
 549        set cmd [list | git diff-index]
 550        lappend cmd --no-color
 551        if {$repo_config(gui.diffcontext) > 0} {
 552                lappend cmd "-U$repo_config(gui.diffcontext)"
 553        }
 554        lappend cmd -p
 555
 556        switch $m {
 557        MM {
 558                lappend cmd -c
 559        }
 560        _O {
 561                if {[catch {
 562                                set fd [open $path r]
 563                                set content [read $fd]
 564                                close $fd
 565                        } err ]} {
 566                        set diff_active 0
 567                        unlock_index
 568                        set ui_status_value "Unable to display [escape_path $path]"
 569                        error_popup "Error loading file:\n\n$err"
 570                        return
 571                }
 572                $ui_diff conf -state normal
 573                $ui_diff insert end $content
 574                $ui_diff conf -state disabled
 575                set diff_active 0
 576                unlock_index
 577                set ui_status_value {Ready.}
 578                return
 579        }
 580        }
 581
 582        lappend cmd $PARENT
 583        lappend cmd --
 584        lappend cmd $path
 585
 586        if {[catch {set fd [open $cmd r]} err]} {
 587                set diff_active 0
 588                unlock_index
 589                set ui_status_value "Unable to display [escape_path $path]"
 590                error_popup "Error loading diff:\n\n$err"
 591                return
 592        }
 593
 594        fconfigure $fd -blocking 0 -translation auto
 595        fileevent $fd readable [list read_diff $fd]
 596}
 597
 598proc read_diff {fd} {
 599        global ui_diff ui_status_value diff_3way diff_active
 600        global repo_config
 601
 602        while {[gets $fd line] >= 0} {
 603                if {[string match {diff --git *} $line]} continue
 604                if {[string match {diff --combined *} $line]} continue
 605                if {[string match {--- *} $line]} continue
 606                if {[string match {+++ *} $line]} continue
 607                if {[string match index* $line]} {
 608                        if {[string first , $line] >= 0} {
 609                                set diff_3way 1
 610                        }
 611                }
 612
 613                $ui_diff conf -state normal
 614                if {!$diff_3way} {
 615                        set x [string index $line 0]
 616                        switch -- $x {
 617                        "@" {set tags da}
 618                        "+" {set tags dp}
 619                        "-" {set tags dm}
 620                        default {set tags {}}
 621                        }
 622                } else {
 623                        set x [string range $line 0 1]
 624                        switch -- $x {
 625                        default {set tags {}}
 626                        "@@" {set tags da}
 627                        "++" {set tags dp; set x " +"}
 628                        " +" {set tags {di bold}; set x "++"}
 629                        "+ " {set tags dni; set x "-+"}
 630                        "--" {set tags dm; set x " -"}
 631                        " -" {set tags {dm bold}; set x "--"}
 632                        "- " {set tags di; set x "+-"}
 633                        default {set tags {}}
 634                        }
 635                        set line [string replace $line 0 1 $x]
 636                }
 637                $ui_diff insert end $line $tags
 638                $ui_diff insert end "\n"
 639                $ui_diff conf -state disabled
 640        }
 641
 642        if {[eof $fd]} {
 643                close $fd
 644                set diff_active 0
 645                unlock_index
 646                set ui_status_value {Ready.}
 647
 648                if {$repo_config(gui.trustmtime) eq {true}
 649                        && [$ui_diff index end] eq {2.0}} {
 650                        handle_empty_diff
 651                }
 652        }
 653}
 654
 655######################################################################
 656##
 657## commit
 658
 659proc load_last_commit {} {
 660        global HEAD PARENT commit_type ui_comm
 661
 662        if {$commit_type eq {amend}} return
 663        if {$commit_type ne {normal}} {
 664                error_popup "Can't amend a $commit_type commit."
 665                return
 666        }
 667
 668        set msg {}
 669        set parent {}
 670        set parent_count 0
 671        if {[catch {
 672                        set fd [open "| git cat-file commit $HEAD" r]
 673                        while {[gets $fd line] > 0} {
 674                                if {[string match {parent *} $line]} {
 675                                        set parent [string range $line 7 end]
 676                                        incr parent_count
 677                                }
 678                        }
 679                        set msg [string trim [read $fd]]
 680                        close $fd
 681                } err]} {
 682                error_popup "Error loading commit data for amend:\n\n$err"
 683                return
 684        }
 685
 686        if {$parent_count == 0} {
 687                set commit_type amend
 688                set HEAD {}
 689                set PARENT {}
 690                rescan {set ui_status_value {Ready.}}
 691        } elseif {$parent_count == 1} {
 692                set commit_type amend
 693                set PARENT $parent
 694                $ui_comm delete 0.0 end
 695                $ui_comm insert end $msg
 696                $ui_comm edit modified false
 697                $ui_comm edit reset
 698                rescan {set ui_status_value {Ready.}}
 699        } else {
 700                error_popup {You can't amend a merge commit.}
 701                return
 702        }
 703}
 704
 705proc commit_tree {} {
 706        global tcl_platform HEAD gitdir commit_type file_states
 707        global pch_error
 708        global ui_status_value ui_comm
 709
 710        if {![lock_index update]} return
 711
 712        # -- Our in memory state should match the repository.
 713        #
 714        repository_state curHEAD cur_type
 715        if {$commit_type eq {amend}
 716                && $cur_type eq {normal}
 717                && $curHEAD eq $HEAD} {
 718        } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
 719                error_popup {Last scanned state does not match repository state.
 720
 721Its highly likely that another Git program modified the
 722repository since our last scan.  A rescan is required
 723before committing.
 724}
 725                unlock_index
 726                rescan {set ui_status_value {Ready.}}
 727                return
 728        }
 729
 730        # -- At least one file should differ in the index.
 731        #
 732        set files_ready 0
 733        foreach path [array names file_states] {
 734                set s $file_states($path)
 735                switch -glob -- [lindex $s 0] {
 736                _? {continue}
 737                A? -
 738                D? -
 739                M? {set files_ready 1; break}
 740                U? {
 741                        error_popup "Unmerged files cannot be committed.
 742
 743File [short_path $path] has merge conflicts.
 744You must resolve them and include the file before committing.
 745"
 746                        unlock_index
 747                        return
 748                }
 749                default {
 750                        error_popup "Unknown file state [lindex $s 0] detected.
 751
 752File [short_path $path] cannot be committed by this program.
 753"
 754                }
 755                }
 756        }
 757        if {!$files_ready} {
 758                error_popup {No included files to commit.
 759
 760You must include at least 1 file before you can commit.
 761}
 762                unlock_index
 763                return
 764        }
 765
 766        # -- A message is required.
 767        #
 768        set msg [string trim [$ui_comm get 1.0 end]]
 769        if {$msg eq {}} {
 770                error_popup {Please supply a commit message.
 771
 772A good commit message has the following format:
 773
 774- First line: Describe in one sentance what you did.
 775- Second line: Blank
 776- Remaining lines: Describe why this change is good.
 777}
 778                unlock_index
 779                return
 780        }
 781
 782        # -- Ask the pre-commit hook for the go-ahead.
 783        #
 784        set pchook [file join $gitdir hooks pre-commit]
 785        if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
 786                set pchook [list sh -c [concat \
 787                        "if test -x \"$pchook\";" \
 788                        "then exec \"$pchook\" 2>&1;" \
 789                        "fi"]]
 790        } elseif {[file executable $pchook]} {
 791                set pchook [list $pchook |& cat]
 792        } else {
 793                set pchook {}
 794        }
 795        if {$pchook ne {}} {
 796                set ui_status_value {Calling pre-commit hook...}
 797                set pch_error {}
 798                set fd_ph [open "| $pchook" r]
 799                fconfigure $fd_ph -blocking 0 -translation binary
 800                fileevent $fd_ph readable \
 801                        [list commit_stage1 $fd_ph $curHEAD $msg]
 802        } else {
 803                commit_stage2 $curHEAD $msg
 804        }
 805}
 806
 807proc commit_stage1 {fd_ph curHEAD msg} {
 808        global pch_error ui_status_value
 809
 810        append pch_error [read $fd_ph]
 811        fconfigure $fd_ph -blocking 1
 812        if {[eof $fd_ph]} {
 813                if {[catch {close $fd_ph}]} {
 814                        set ui_status_value {Commit declined by pre-commit hook.}
 815                        hook_failed_popup pre-commit $pch_error
 816                        unlock_index
 817                } else {
 818                        commit_stage2 $curHEAD $msg
 819                }
 820                set pch_error {}
 821        } else {
 822                fconfigure $fd_ph -blocking 0
 823        }
 824}
 825
 826proc commit_stage2 {curHEAD msg} {
 827        global ui_status_value
 828
 829        # -- Write the tree in the background.
 830        #
 831        set ui_status_value {Committing changes...}
 832        set fd_wt [open "| git write-tree" r]
 833        fileevent $fd_wt readable [list commit_stage3 $fd_wt $curHEAD $msg]
 834}
 835
 836proc commit_stage3 {fd_wt curHEAD msg} {
 837        global single_commit gitdir HEAD PARENT commit_type tcl_platform
 838        global ui_status_value ui_comm
 839        global file_states selected_paths
 840
 841        gets $fd_wt tree_id
 842        if {$tree_id eq {} || [catch {close $fd_wt} err]} {
 843                error_popup "write-tree failed:\n\n$err"
 844                set ui_status_value {Commit failed.}
 845                unlock_index
 846                return
 847        }
 848
 849        # -- Create the commit.
 850        #
 851        set cmd [list git commit-tree $tree_id]
 852        if {$PARENT ne {}} {
 853                lappend cmd -p $PARENT
 854        }
 855        if {$commit_type eq {merge}} {
 856                if {[catch {
 857                                set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 858                                while {[gets $fd_mh merge_head] >= 0} {
 859                                        lappend cmd -p $merge_head
 860                                }
 861                                close $fd_mh
 862                        } err]} {
 863                        error_popup "Loading MERGE_HEAD failed:\n\n$err"
 864                        set ui_status_value {Commit failed.}
 865                        unlock_index
 866                        return
 867                }
 868        }
 869        if {$PARENT eq {}} {
 870                # git commit-tree writes to stderr during initial commit.
 871                lappend cmd 2>/dev/null
 872        }
 873        lappend cmd << $msg
 874        if {[catch {set cmt_id [eval exec $cmd]} err]} {
 875                error_popup "commit-tree failed:\n\n$err"
 876                set ui_status_value {Commit failed.}
 877                unlock_index
 878                return
 879        }
 880
 881        # -- Update the HEAD ref.
 882        #
 883        set reflogm commit
 884        if {$commit_type ne {normal}} {
 885                append reflogm " ($commit_type)"
 886        }
 887        set i [string first "\n" $msg]
 888        if {$i >= 0} {
 889                append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
 890        } else {
 891                append reflogm {: } $msg
 892        }
 893        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 894        if {[catch {eval exec $cmd} err]} {
 895                error_popup "update-ref failed:\n\n$err"
 896                set ui_status_value {Commit failed.}
 897                unlock_index
 898                return
 899        }
 900
 901        # -- Cleanup after ourselves.
 902        #
 903        catch {file delete [file join $gitdir MERGE_HEAD]}
 904        catch {file delete [file join $gitdir MERGE_MSG]}
 905        catch {file delete [file join $gitdir SQUASH_MSG]}
 906        catch {file delete [file join $gitdir GITGUI_MSG]}
 907
 908        # -- Let rerere do its thing.
 909        #
 910        if {[file isdirectory [file join $gitdir rr-cache]]} {
 911                catch {exec git rerere}
 912        }
 913
 914        # -- Run the post-commit hook.
 915        #
 916        set pchook [file join $gitdir hooks post-commit]
 917        if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
 918                set pchook [list sh -c [concat \
 919                        "if test -x \"$pchook\";" \
 920                        "then exec \"$pchook\";" \
 921                        "fi"]]
 922        } elseif {![file executable $pchook]} {
 923                set pchook {}
 924        }
 925        if {$pchook ne {}} {
 926                catch {exec $pchook &}
 927        }
 928
 929        $ui_comm delete 0.0 end
 930        $ui_comm edit modified false
 931        $ui_comm edit reset
 932
 933        if {$single_commit} do_quit
 934
 935        # -- Update status without invoking any git commands.
 936        #
 937        set commit_type normal
 938        set HEAD $cmt_id
 939        set PARENT $cmt_id
 940
 941        foreach path [array names file_states] {
 942                set s $file_states($path)
 943                set m [lindex $s 0]
 944                switch -glob -- $m {
 945                A? -
 946                M? -
 947                D? {set m _[string index $m 1]}
 948                }
 949
 950                if {$m eq {__}} {
 951                        unset file_states($path)
 952                        catch {unset selected_paths($path)}
 953                } else {
 954                        lset file_states($path) 0 $m
 955                }
 956        }
 957
 958        display_all_files
 959        unlock_index
 960        reshow_diff
 961        set ui_status_value \
 962                "Changes committed as [string range $cmt_id 0 7]."
 963}
 964
 965######################################################################
 966##
 967## fetch pull push
 968
 969proc fetch_from {remote} {
 970        set w [new_console "fetch $remote" \
 971                "Fetching new changes from $remote"]
 972        set cmd [list git fetch]
 973        lappend cmd $remote
 974        console_exec $w $cmd
 975}
 976
 977proc pull_remote {remote branch} {
 978        global HEAD commit_type file_states repo_config
 979
 980        if {![lock_index update]} return
 981
 982        # -- Our in memory state should match the repository.
 983        #
 984        repository_state curHEAD cur_type
 985        if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
 986                error_popup {Last scanned state does not match repository state.
 987
 988Its highly likely that another Git program modified the
 989repository since our last scan.  A rescan is required
 990before a pull can be started.
 991}
 992                unlock_index
 993                rescan {set ui_status_value {Ready.}}
 994                return
 995        }
 996
 997        # -- No differences should exist before a pull.
 998        #
 999        if {[array size file_states] != 0} {
1000                error_popup {Uncommitted but modified files are present.
1001
1002You should not perform a pull with unmodified files in your working
1003directory as Git would be unable to recover from an incorrect merge.
1004
1005Commit or throw away all changes before starting a pull operation.
1006}
1007                unlock_index
1008                return
1009        }
1010
1011        set w [new_console "pull $remote $branch" \
1012                "Pulling new changes from branch $branch in $remote"]
1013        set cmd [list git pull]
1014        if {$repo_config(gui.pullsummary) eq {false}} {
1015                lappend cmd --no-summary
1016        }
1017        lappend cmd $remote
1018        lappend cmd $branch
1019        console_exec $w $cmd [list post_pull_remote $remote $branch]
1020}
1021
1022proc post_pull_remote {remote branch success} {
1023        global HEAD PARENT commit_type
1024        global ui_status_value
1025
1026        unlock_index
1027        if {$success} {
1028                repository_state HEAD commit_type
1029                set PARENT $HEAD
1030                set $ui_status_value "Pulling $branch from $remote complete."
1031        } else {
1032                set m "Conflicts detected while pulling $branch from $remote."
1033                rescan "set ui_status_value {$m}"
1034        }
1035}
1036
1037proc push_to {remote} {
1038        set w [new_console "push $remote" \
1039                "Pushing changes to $remote"]
1040        set cmd [list git push]
1041        lappend cmd $remote
1042        console_exec $w $cmd
1043}
1044
1045######################################################################
1046##
1047## ui helpers
1048
1049proc mapcol {state path} {
1050        global all_cols ui_other
1051
1052        if {[catch {set r $all_cols($state)}]} {
1053                puts "error: no column for state={$state} $path"
1054                return $ui_other
1055        }
1056        return $r
1057}
1058
1059proc mapicon {state path} {
1060        global all_icons
1061
1062        if {[catch {set r $all_icons($state)}]} {
1063                puts "error: no icon for state={$state} $path"
1064                return file_plain
1065        }
1066        return $r
1067}
1068
1069proc mapdesc {state path} {
1070        global all_descs
1071
1072        if {[catch {set r $all_descs($state)}]} {
1073                puts "error: no desc for state={$state} $path"
1074                return $state
1075        }
1076        return $r
1077}
1078
1079proc escape_path {path} {
1080        regsub -all "\n" $path "\\n" path
1081        return $path
1082}
1083
1084proc short_path {path} {
1085        return [escape_path [lindex [file split $path] end]]
1086}
1087
1088set next_icon_id 0
1089
1090proc merge_state {path new_state} {
1091        global file_states next_icon_id
1092
1093        set s0 [string index $new_state 0]
1094        set s1 [string index $new_state 1]
1095
1096        if {[catch {set info $file_states($path)}]} {
1097                set state __
1098                set icon n[incr next_icon_id]
1099        } else {
1100                set state [lindex $info 0]
1101                set icon [lindex $info 1]
1102        }
1103
1104        if {$s0 eq {_}} {
1105                set s0 [string index $state 0]
1106        } elseif {$s0 eq {*}} {
1107                set s0 _
1108        }
1109
1110        if {$s1 eq {_}} {
1111                set s1 [string index $state 1]
1112        } elseif {$s1 eq {*}} {
1113                set s1 _
1114        }
1115
1116        set file_states($path) [list $s0$s1 $icon]
1117        return $state
1118}
1119
1120proc display_file {path state} {
1121        global file_states file_lists selected_paths rescan_active
1122
1123        set old_m [merge_state $path $state]
1124        if {$rescan_active > 0} return
1125
1126        set s $file_states($path)
1127        set new_m [lindex $s 0]
1128        set new_w [mapcol $new_m $path] 
1129        set old_w [mapcol $old_m $path]
1130        set new_icon [mapicon $new_m $path]
1131
1132        if {$new_w ne $old_w} {
1133                set lno [lsearch -sorted $file_lists($old_w) $path]
1134                if {$lno >= 0} {
1135                        incr lno
1136                        $old_w conf -state normal
1137                        $old_w delete $lno.0 [expr {$lno + 1}].0
1138                        $old_w conf -state disabled
1139                }
1140
1141                lappend file_lists($new_w) $path
1142                set file_lists($new_w) [lsort $file_lists($new_w)]
1143                set lno [lsearch -sorted $file_lists($new_w) $path]
1144                incr lno
1145                $new_w conf -state normal
1146                $new_w image create $lno.0 \
1147                        -align center -padx 5 -pady 1 \
1148                        -name [lindex $s 1] \
1149                        -image $new_icon
1150                $new_w insert $lno.1 "[escape_path $path]\n"
1151                if {[catch {set in_sel $selected_paths($path)}]} {
1152                        set in_sel 0
1153                }
1154                if {$in_sel} {
1155                        $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1156                }
1157                $new_w conf -state disabled
1158        } elseif {$new_icon ne [mapicon $old_m $path]} {
1159                $new_w conf -state normal
1160                $new_w image conf [lindex $s 1] -image $new_icon
1161                $new_w conf -state disabled
1162        }
1163}
1164
1165proc display_all_files {} {
1166        global ui_index ui_other
1167        global file_states file_lists
1168        global last_clicked selected_paths
1169
1170        $ui_index conf -state normal
1171        $ui_other conf -state normal
1172
1173        $ui_index delete 0.0 end
1174        $ui_other delete 0.0 end
1175        set last_clicked {}
1176
1177        set file_lists($ui_index) [list]
1178        set file_lists($ui_other) [list]
1179
1180        foreach path [lsort [array names file_states]] {
1181                set s $file_states($path)
1182                set m [lindex $s 0]
1183                set w [mapcol $m $path]
1184                lappend file_lists($w) $path
1185                set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1186                $w image create end \
1187                        -align center -padx 5 -pady 1 \
1188                        -name [lindex $s 1] \
1189                        -image [mapicon $m $path]
1190                $w insert end "[escape_path $path]\n"
1191                if {[catch {set in_sel $selected_paths($path)}]} {
1192                        set in_sel 0
1193                }
1194                if {$in_sel} {
1195                        $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1196                }
1197        }
1198
1199        $ui_index conf -state disabled
1200        $ui_other conf -state disabled
1201}
1202
1203proc update_index {msg pathList after} {
1204        global update_index_cp update_index_rsd ui_status_value
1205
1206        if {![lock_index update]} return
1207
1208        set update_index_cp 0
1209        set update_index_rsd 0
1210        set pathList [lsort $pathList]
1211        set totalCnt [llength $pathList]
1212        set batch [expr {int($totalCnt * .01) + 1}]
1213        if {$batch > 25} {set batch 25}
1214
1215        set ui_status_value [format \
1216                "$msg... %i/%i files (%.2f%%)" \
1217                $update_index_cp \
1218                $totalCnt \
1219                0.0]
1220        set fd [open "| git update-index --add --remove -z --stdin" w]
1221        fconfigure $fd \
1222                -blocking 0 \
1223                -buffering full \
1224                -buffersize 512 \
1225                -translation binary
1226        fileevent $fd writable [list \
1227                write_update_index \
1228                $fd \
1229                $pathList \
1230                $totalCnt \
1231                $batch \
1232                $msg \
1233                $after \
1234                ]
1235}
1236
1237proc write_update_index {fd pathList totalCnt batch msg after} {
1238        global update_index_cp update_index_rsd ui_status_value
1239        global file_states ui_fname_value
1240
1241        if {$update_index_cp >= $totalCnt} {
1242                close $fd
1243                unlock_index
1244                if {$update_index_rsd} reshow_diff
1245                uplevel #0 $after
1246                return
1247        }
1248
1249        for {set i $batch} \
1250                {$update_index_cp < $totalCnt && $i > 0} \
1251                {incr i -1} {
1252                set path [lindex $pathList $update_index_cp]
1253                incr update_index_cp
1254
1255                switch -- [lindex $file_states($path) 0] {
1256                AM -
1257                _O {set new A*}
1258                _M -
1259                MM {set new M*}
1260                AD -
1261                _D {set new D*}
1262                default {continue}
1263                }
1264
1265                puts -nonewline $fd $path
1266                puts -nonewline $fd "\0"
1267                display_file $path $new
1268                if {$ui_fname_value eq $path} {
1269                        set update_index_rsd 1
1270                }
1271        }
1272
1273        set ui_status_value [format \
1274                "$msg... %i/%i files (%.2f%%)" \
1275                $update_index_cp \
1276                $totalCnt \
1277                [expr {100.0 * $update_index_cp / $totalCnt}]]
1278}
1279
1280######################################################################
1281##
1282## remote management
1283
1284proc load_all_remotes {} {
1285        global gitdir all_remotes repo_config
1286
1287        set all_remotes [list]
1288        set rm_dir [file join $gitdir remotes]
1289        if {[file isdirectory $rm_dir]} {
1290                set all_remotes [concat $all_remotes [glob \
1291                        -types f \
1292                        -tails \
1293                        -nocomplain \
1294                        -directory $rm_dir *]]
1295        }
1296
1297        foreach line [array names repo_config remote.*.url] {
1298                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1299                        lappend all_remotes $name
1300                }
1301        }
1302
1303        set all_remotes [lsort -unique $all_remotes]
1304}
1305
1306proc populate_remote_menu {m pfx op} {
1307        global all_remotes
1308
1309        foreach remote $all_remotes {
1310                $m add command -label "$pfx $remote..." \
1311                        -command [list $op $remote] \
1312                        -font font_ui
1313        }
1314}
1315
1316proc populate_pull_menu {m} {
1317        global gitdir repo_config all_remotes disable_on_lock
1318
1319        foreach remote $all_remotes {
1320                set rb {}
1321                if {[array get repo_config remote.$remote.url] ne {}} {
1322                        if {[array get repo_config remote.$remote.fetch] ne {}} {
1323                                regexp {^([^:]+):} \
1324                                        [lindex $repo_config(remote.$remote.fetch) 0] \
1325                                        line rb
1326                        }
1327                } else {
1328                        catch {
1329                                set fd [open [file join $gitdir remotes $remote] r]
1330                                while {[gets $fd line] >= 0} {
1331                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1332                                                break
1333                                        }
1334                                }
1335                                close $fd
1336                        }
1337                }
1338
1339                set rb_short $rb
1340                regsub ^refs/heads/ $rb {} rb_short
1341                if {$rb_short ne {}} {
1342                        $m add command \
1343                                -label "Branch $rb_short from $remote..." \
1344                                -command [list pull_remote $remote $rb] \
1345                                -font font_ui
1346                        lappend disable_on_lock \
1347                                [list $m entryconf [$m index last] -state]
1348                }
1349        }
1350}
1351
1352######################################################################
1353##
1354## icons
1355
1356set filemask {
1357#define mask_width 14
1358#define mask_height 15
1359static unsigned char mask_bits[] = {
1360   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1361   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1362   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1363}
1364
1365image create bitmap file_plain -background white -foreground black -data {
1366#define plain_width 14
1367#define plain_height 15
1368static unsigned char plain_bits[] = {
1369   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1370   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1371   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1372} -maskdata $filemask
1373
1374image create bitmap file_mod -background white -foreground blue -data {
1375#define mod_width 14
1376#define mod_height 15
1377static unsigned char mod_bits[] = {
1378   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1379   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1380   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1381} -maskdata $filemask
1382
1383image create bitmap file_fulltick -background white -foreground "#007000" -data {
1384#define file_fulltick_width 14
1385#define file_fulltick_height 15
1386static unsigned char file_fulltick_bits[] = {
1387   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1388   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1389   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1390} -maskdata $filemask
1391
1392image create bitmap file_parttick -background white -foreground "#005050" -data {
1393#define parttick_width 14
1394#define parttick_height 15
1395static unsigned char parttick_bits[] = {
1396   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1397   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1398   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1399} -maskdata $filemask
1400
1401image create bitmap file_question -background white -foreground black -data {
1402#define file_question_width 14
1403#define file_question_height 15
1404static unsigned char file_question_bits[] = {
1405   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1406   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1407   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1408} -maskdata $filemask
1409
1410image create bitmap file_removed -background white -foreground red -data {
1411#define file_removed_width 14
1412#define file_removed_height 15
1413static unsigned char file_removed_bits[] = {
1414   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1415   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1416   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1417} -maskdata $filemask
1418
1419image create bitmap file_merge -background white -foreground blue -data {
1420#define file_merge_width 14
1421#define file_merge_height 15
1422static unsigned char file_merge_bits[] = {
1423   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1424   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1425   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1426} -maskdata $filemask
1427
1428set ui_index .vpane.files.index.list
1429set ui_other .vpane.files.other.list
1430set max_status_desc 0
1431foreach i {
1432                {__ i plain    "Unmodified"}
1433                {_M i mod      "Modified"}
1434                {M_ i fulltick "Included in commit"}
1435                {MM i parttick "Partially included"}
1436
1437                {_O o plain    "Untracked"}
1438                {A_ o fulltick "Added by commit"}
1439                {AM o parttick "Partially added"}
1440                {AD o question "Added (but now gone)"}
1441
1442                {_D i question "Missing"}
1443                {D_ i removed  "Removed by commit"}
1444                {DD i removed  "Removed by commit"}
1445                {DO i removed  "Removed (still exists)"}
1446
1447                {UM i merge    "Merge conflicts"}
1448                {U_ i merge    "Merge conflicts"}
1449        } {
1450        if {$max_status_desc < [string length [lindex $i 3]]} {
1451                set max_status_desc [string length [lindex $i 3]]
1452        }
1453        if {[lindex $i 1] eq {i}} {
1454                set all_cols([lindex $i 0]) $ui_index
1455        } else {
1456                set all_cols([lindex $i 0]) $ui_other
1457        }
1458        set all_icons([lindex $i 0]) file_[lindex $i 2]
1459        set all_descs([lindex $i 0]) [lindex $i 3]
1460}
1461unset filemask i
1462
1463######################################################################
1464##
1465## util
1466
1467proc is_MacOSX {} {
1468        global tcl_platform tk_library
1469        if {$tcl_platform(platform) eq {unix}
1470                && $tcl_platform(os) eq {Darwin}
1471                && [string match /Library/Frameworks/* $tk_library]} {
1472                return 1
1473        }
1474        return 0
1475}
1476
1477proc bind_button3 {w cmd} {
1478        bind $w <Any-Button-3> $cmd
1479        if {[is_MacOSX]} {
1480                bind $w <Control-Button-1> $cmd
1481        }
1482}
1483
1484proc incr_font_size {font {amt 1}} {
1485        set sz [font configure $font -size]
1486        incr sz $amt
1487        font configure $font -size $sz
1488        font configure ${font}bold -size $sz
1489}
1490
1491proc hook_failed_popup {hook msg} {
1492        global gitdir appname
1493
1494        set w .hookfail
1495        toplevel $w
1496
1497        frame $w.m
1498        label $w.m.l1 -text "$hook hook failed:" \
1499                -anchor w \
1500                -justify left \
1501                -font font_uibold
1502        text $w.m.t \
1503                -background white -borderwidth 1 \
1504                -relief sunken \
1505                -width 80 -height 10 \
1506                -font font_diff \
1507                -yscrollcommand [list $w.m.sby set]
1508        label $w.m.l2 \
1509                -text {You must correct the above errors before committing.} \
1510                -anchor w \
1511                -justify left \
1512                -font font_uibold
1513        scrollbar $w.m.sby -command [list $w.m.t yview]
1514        pack $w.m.l1 -side top -fill x
1515        pack $w.m.l2 -side bottom -fill x
1516        pack $w.m.sby -side right -fill y
1517        pack $w.m.t -side left -fill both -expand 1
1518        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1519
1520        $w.m.t insert 1.0 $msg
1521        $w.m.t conf -state disabled
1522
1523        button $w.ok -text OK \
1524                -width 15 \
1525                -font font_ui \
1526                -command "destroy $w"
1527        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1528
1529        bind $w <Visibility> "grab $w; focus $w"
1530        bind $w <Key-Return> "destroy $w"
1531        wm title $w "$appname ([lindex [file split \
1532                [file normalize [file dirname $gitdir]]] \
1533                end]): error"
1534        tkwait window $w
1535}
1536
1537set next_console_id 0
1538
1539proc new_console {short_title long_title} {
1540        global next_console_id console_data
1541        set w .console[incr next_console_id]
1542        set console_data($w) [list $short_title $long_title]
1543        return [console_init $w]
1544}
1545
1546proc console_init {w} {
1547        global console_cr console_data
1548        global gitdir appname M1B
1549
1550        set console_cr($w) 1.0
1551        toplevel $w
1552        frame $w.m
1553        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1554                -anchor w \
1555                -justify left \
1556                -font font_uibold
1557        text $w.m.t \
1558                -background white -borderwidth 1 \
1559                -relief sunken \
1560                -width 80 -height 10 \
1561                -font font_diff \
1562                -state disabled \
1563                -yscrollcommand [list $w.m.sby set]
1564        label $w.m.s -text {Working... please wait...} \
1565                -anchor w \
1566                -justify left \
1567                -font font_uibold
1568        scrollbar $w.m.sby -command [list $w.m.t yview]
1569        pack $w.m.l1 -side top -fill x
1570        pack $w.m.s -side bottom -fill x
1571        pack $w.m.sby -side right -fill y
1572        pack $w.m.t -side left -fill both -expand 1
1573        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1574
1575        menu $w.ctxm -tearoff 0
1576        $w.ctxm add command -label "Copy" \
1577                -font font_ui \
1578                -command "tk_textCopy $w.m.t"
1579        $w.ctxm add command -label "Select All" \
1580                -font font_ui \
1581                -command "$w.m.t tag add sel 0.0 end"
1582        $w.ctxm add command -label "Copy All" \
1583                -font font_ui \
1584                -command "
1585                        $w.m.t tag add sel 0.0 end
1586                        tk_textCopy $w.m.t
1587                        $w.m.t tag remove sel 0.0 end
1588                "
1589
1590        button $w.ok -text {Close} \
1591                -font font_ui \
1592                -state disabled \
1593                -command "destroy $w"
1594        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1595
1596        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1597        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1598        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1599        bind $w <Visibility> "focus $w"
1600        wm title $w "$appname ([lindex [file split \
1601                [file normalize [file dirname $gitdir]]] \
1602                end]): [lindex $console_data($w) 0]"
1603        return $w
1604}
1605
1606proc console_exec {w cmd {after {}}} {
1607        global tcl_platform
1608
1609        # -- Windows tosses the enviroment when we exec our child.
1610        #    But most users need that so we have to relogin. :-(
1611        #
1612        if {$tcl_platform(platform) eq {windows}} {
1613                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1614        }
1615
1616        # -- Tcl won't let us redirect both stdout and stderr to
1617        #    the same pipe.  So pass it through cat...
1618        #
1619        set cmd [concat | $cmd |& cat]
1620
1621        set fd_f [open $cmd r]
1622        fconfigure $fd_f -blocking 0 -translation binary
1623        fileevent $fd_f readable [list console_read $w $fd_f $after]
1624}
1625
1626proc console_read {w fd after} {
1627        global console_cr console_data
1628
1629        set buf [read $fd]
1630        if {$buf ne {}} {
1631                if {![winfo exists $w]} {console_init $w}
1632                $w.m.t conf -state normal
1633                set c 0
1634                set n [string length $buf]
1635                while {$c < $n} {
1636                        set cr [string first "\r" $buf $c]
1637                        set lf [string first "\n" $buf $c]
1638                        if {$cr < 0} {set cr [expr {$n + 1}]}
1639                        if {$lf < 0} {set lf [expr {$n + 1}]}
1640
1641                        if {$lf < $cr} {
1642                                $w.m.t insert end [string range $buf $c $lf]
1643                                set console_cr($w) [$w.m.t index {end -1c}]
1644                                set c $lf
1645                                incr c
1646                        } else {
1647                                $w.m.t delete $console_cr($w) end
1648                                $w.m.t insert end "\n"
1649                                $w.m.t insert end [string range $buf $c $cr]
1650                                set c $cr
1651                                incr c
1652                        }
1653                }
1654                $w.m.t conf -state disabled
1655                $w.m.t see end
1656        }
1657
1658        fconfigure $fd -blocking 1
1659        if {[eof $fd]} {
1660                if {[catch {close $fd}]} {
1661                        if {![winfo exists $w]} {console_init $w}
1662                        $w.m.s conf -background red -text {Error: Command Failed}
1663                        $w.ok conf -state normal
1664                        set ok 0
1665                } elseif {[winfo exists $w]} {
1666                        $w.m.s conf -background green -text {Success}
1667                        $w.ok conf -state normal
1668                        set ok 1
1669                }
1670                array unset console_cr $w
1671                array unset console_data $w
1672                if {$after ne {}} {
1673                        uplevel #0 $after $ok
1674                }
1675                return
1676        }
1677        fconfigure $fd -blocking 0
1678}
1679
1680######################################################################
1681##
1682## ui commands
1683
1684set starting_gitk_msg {Please wait... Starting gitk...}
1685
1686proc do_gitk {} {
1687        global tcl_platform ui_status_value starting_gitk_msg
1688
1689        set ui_status_value $starting_gitk_msg
1690        after 10000 {
1691                if {$ui_status_value eq $starting_gitk_msg} {
1692                        set ui_status_value {Ready.}
1693                }
1694        }
1695
1696        if {$tcl_platform(platform) eq {windows}} {
1697                exec sh -c gitk &
1698        } else {
1699                exec gitk &
1700        }
1701}
1702
1703proc do_repack {} {
1704        set w [new_console "repack" "Repacking the object database"]
1705        set cmd [list git repack]
1706        lappend cmd -a
1707        lappend cmd -d
1708        console_exec $w $cmd
1709}
1710
1711set is_quitting 0
1712
1713proc do_quit {} {
1714        global gitdir ui_comm is_quitting repo_config
1715
1716        if {$is_quitting} return
1717        set is_quitting 1
1718
1719        # -- Stash our current commit buffer.
1720        #
1721        set save [file join $gitdir GITGUI_MSG]
1722        set msg [string trim [$ui_comm get 0.0 end]]
1723        if {[$ui_comm edit modified] && $msg ne {}} {
1724                catch {
1725                        set fd [open $save w]
1726                        puts $fd [string trim [$ui_comm get 0.0 end]]
1727                        close $fd
1728                }
1729        } elseif {$msg eq {} && [file exists $save]} {
1730                file delete $save
1731        }
1732
1733        # -- Stash our current window geometry into this repository.
1734        #
1735        set cfg_geometry [list]
1736        lappend cfg_geometry [wm geometry .]
1737        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1738        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1739        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1740                set rc_geometry {}
1741        }
1742        if {$cfg_geometry ne $rc_geometry} {
1743                catch {exec git repo-config gui.geometry $cfg_geometry}
1744        }
1745
1746        destroy .
1747}
1748
1749proc do_rescan {} {
1750        rescan {set ui_status_value {Ready.}}
1751}
1752
1753proc do_include_all {} {
1754        global file_states
1755
1756        if {![lock_index begin-update]} return
1757
1758        set pathList [list]
1759        foreach path [array names file_states] {
1760                set s $file_states($path)
1761                set m [lindex $s 0]
1762                switch -- $m {
1763                AM -
1764                MM -
1765                _M -
1766                _D {lappend pathList $path}
1767                }
1768        }
1769        if {$pathList eq {}} {
1770                unlock_index
1771        } else {
1772                update_index \
1773                        "Including all modified files" \
1774                        $pathList \
1775                        {set ui_status_value {Ready to commit.}}
1776        }
1777}
1778
1779set GIT_COMMITTER_IDENT {}
1780
1781proc do_signoff {} {
1782        global ui_comm GIT_COMMITTER_IDENT
1783
1784        if {$GIT_COMMITTER_IDENT eq {}} {
1785                if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1786                        error_popup "Unable to obtain your identity:\n\n$err"
1787                        return
1788                }
1789                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1790                        $me me GIT_COMMITTER_IDENT]} {
1791                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1792                        return
1793                }
1794        }
1795
1796        set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1797        set last [$ui_comm get {end -1c linestart} {end -1c}]
1798        if {$last ne $sob} {
1799                $ui_comm edit separator
1800                if {$last ne {}
1801                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1802                        $ui_comm insert end "\n"
1803                }
1804                $ui_comm insert end "\n$sob"
1805                $ui_comm edit separator
1806                $ui_comm see end
1807        }
1808}
1809
1810proc do_amend_last {} {
1811        load_last_commit
1812}
1813
1814proc do_commit {} {
1815        commit_tree
1816}
1817
1818proc do_options {} {
1819        global appname gitdir font_descs
1820        global repo_config global_config
1821        global repo_config_new global_config_new
1822
1823        array unset repo_config_new
1824        array unset global_config_new
1825        foreach name [array names repo_config] {
1826                set repo_config_new($name) $repo_config($name)
1827        }
1828        load_config 1
1829        foreach name [array names repo_config] {
1830                switch -- $name {
1831                gui.diffcontext {continue}
1832                }
1833                set repo_config_new($name) $repo_config($name)
1834        }
1835        foreach name [array names global_config] {
1836                set global_config_new($name) $global_config($name)
1837        }
1838        set reponame [lindex [file split \
1839                [file normalize [file dirname $gitdir]]] \
1840                end]
1841
1842        set w .options_editor
1843        toplevel $w
1844        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1845
1846        label $w.header -text "$appname Options" \
1847                -font font_uibold
1848        pack $w.header -side top -fill x
1849
1850        frame $w.buttons
1851        button $w.buttons.restore -text {Restore Defaults} \
1852                -font font_ui \
1853                -command do_restore_defaults
1854        pack $w.buttons.restore -side left
1855        button $w.buttons.save -text Save \
1856                -font font_ui \
1857                -command [list do_save_config $w]
1858        pack $w.buttons.save -side right
1859        button $w.buttons.cancel -text {Cancel} \
1860                -font font_ui \
1861                -command [list destroy $w]
1862        pack $w.buttons.cancel -side right
1863        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1864
1865        labelframe $w.repo -text "$reponame Repository" \
1866                -font font_ui \
1867                -relief raised -borderwidth 2
1868        labelframe $w.global -text {Global (All Repositories)} \
1869                -font font_ui \
1870                -relief raised -borderwidth 2
1871        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1872        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1873
1874        foreach option {
1875                {b partialinclude {Allow Partially Included Files}}
1876                {b pullsummary {Show Pull Summary}}
1877                {b trustmtime  {Trust File Modification Timestamps}}
1878                {i diffcontext {Number of Diff Context Lines}}
1879                } {
1880                set type [lindex $option 0]
1881                set name [lindex $option 1]
1882                set text [lindex $option 2]
1883                foreach f {repo global} {
1884                        switch $type {
1885                        b {
1886                                checkbutton $w.$f.$name -text $text \
1887                                        -variable ${f}_config_new(gui.$name) \
1888                                        -onvalue true \
1889                                        -offvalue false \
1890                                        -font font_ui
1891                                pack $w.$f.$name -side top -anchor w
1892                        }
1893                        i {
1894                                frame $w.$f.$name
1895                                label $w.$f.$name.l -text "$text:" -font font_ui
1896                                pack $w.$f.$name.l -side left -anchor w -fill x
1897                                spinbox $w.$f.$name.v \
1898                                        -textvariable ${f}_config_new(gui.$name) \
1899                                        -from 1 -to 99 -increment 1 \
1900                                        -width 3 \
1901                                        -font font_ui
1902                                pack $w.$f.$name.v -side right -anchor e
1903                                pack $w.$f.$name -side top -anchor w -fill x
1904                        }
1905                        }
1906                }
1907        }
1908
1909        set all_fonts [lsort [font families]]
1910        foreach option $font_descs {
1911                set name [lindex $option 0]
1912                set font [lindex $option 1]
1913                set text [lindex $option 2]
1914
1915                set global_config_new(gui.$font^^family) \
1916                        [font configure $font -family]
1917                set global_config_new(gui.$font^^size) \
1918                        [font configure $font -size]
1919
1920                frame $w.global.$name
1921                label $w.global.$name.l -text "$text:" -font font_ui
1922                pack $w.global.$name.l -side left -anchor w -fill x
1923                eval tk_optionMenu $w.global.$name.family \
1924                        global_config_new(gui.$font^^family) \
1925                        $all_fonts
1926                spinbox $w.global.$name.size \
1927                        -textvariable global_config_new(gui.$font^^size) \
1928                        -from 2 -to 80 -increment 1 \
1929                        -width 3 \
1930                        -font font_ui
1931                pack $w.global.$name.size -side right -anchor e
1932                pack $w.global.$name.family -side right -anchor e
1933                pack $w.global.$name -side top -anchor w -fill x
1934        }
1935
1936        bind $w <Visibility> "grab $w; focus $w"
1937        bind $w <Key-Escape> "destroy $w"
1938        wm title $w "$appname ($reponame): Options"
1939        tkwait window $w
1940}
1941
1942proc do_restore_defaults {} {
1943        global font_descs default_config repo_config
1944        global repo_config_new global_config_new
1945
1946        foreach name [array names default_config] {
1947                set repo_config_new($name) $default_config($name)
1948                set global_config_new($name) $default_config($name)
1949        }
1950
1951        foreach option $font_descs {
1952                set name [lindex $option 0]
1953                set repo_config(gui.$name) $default_config(gui.$name)
1954        }
1955        apply_config
1956
1957        foreach option $font_descs {
1958                set name [lindex $option 0]
1959                set font [lindex $option 1]
1960                set global_config_new(gui.$font^^family) \
1961                        [font configure $font -family]
1962                set global_config_new(gui.$font^^size) \
1963                        [font configure $font -size]
1964        }
1965}
1966
1967proc do_save_config {w} {
1968        if {[catch {save_config} err]} {
1969                error_popup "Failed to completely save options:\n\n$err"
1970        }
1971        reshow_diff
1972        destroy $w
1973}
1974
1975proc toggle_or_diff {w x y} {
1976        global file_lists ui_index ui_other
1977        global last_clicked selected_paths
1978
1979        set pos [split [$w index @$x,$y] .]
1980        set lno [lindex $pos 0]
1981        set col [lindex $pos 1]
1982        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1983        if {$path eq {}} {
1984                set last_clicked {}
1985                return
1986        }
1987
1988        set last_clicked [list $w $lno]
1989        array unset selected_paths
1990        $ui_index tag remove in_sel 0.0 end
1991        $ui_other tag remove in_sel 0.0 end
1992
1993        if {$col == 0} {
1994                update_index \
1995                        "Including [short_path $path]" \
1996                        [list $path] \
1997                        {set ui_status_value {Ready.}}
1998        } else {
1999                show_diff $path $w $lno
2000        }
2001}
2002
2003proc add_one_to_selection {w x y} {
2004        global file_lists
2005        global last_clicked selected_paths
2006
2007        set pos [split [$w index @$x,$y] .]
2008        set lno [lindex $pos 0]
2009        set col [lindex $pos 1]
2010        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2011        if {$path eq {}} {
2012                set last_clicked {}
2013                return
2014        }
2015
2016        set last_clicked [list $w $lno]
2017        if {[catch {set in_sel $selected_paths($path)}]} {
2018                set in_sel 0
2019        }
2020        if {$in_sel} {
2021                unset selected_paths($path)
2022                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2023        } else {
2024                set selected_paths($path) 1
2025                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2026        }
2027}
2028
2029proc add_range_to_selection {w x y} {
2030        global file_lists
2031        global last_clicked selected_paths
2032
2033        if {[lindex $last_clicked 0] ne $w} {
2034                toggle_or_diff $w $x $y
2035                return
2036        }
2037
2038        set pos [split [$w index @$x,$y] .]
2039        set lno [lindex $pos 0]
2040        set lc [lindex $last_clicked 1]
2041        if {$lc < $lno} {
2042                set begin $lc
2043                set end $lno
2044        } else {
2045                set begin $lno
2046                set end $lc
2047        }
2048
2049        foreach path [lrange $file_lists($w) \
2050                [expr {$begin - 1}] \
2051                [expr {$end - 1}]] {
2052                set selected_paths($path) 1
2053        }
2054        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2055}
2056
2057######################################################################
2058##
2059## config defaults
2060
2061set cursor_ptr arrow
2062font create font_diff -family Courier -size 10
2063font create font_ui
2064catch {
2065        label .dummy
2066        eval font configure font_ui [font actual [.dummy cget -font]]
2067        destroy .dummy
2068}
2069
2070font create font_uibold
2071font create font_diffbold
2072
2073set M1B M1
2074set M1T M1
2075if {$tcl_platform(platform) eq {windows}} {
2076        set M1B Control
2077        set M1T Ctrl
2078} elseif {[is_MacOSX]} {
2079        set M1B M1
2080        set M1T Cmd
2081}
2082
2083proc apply_config {} {
2084        global repo_config font_descs
2085
2086        foreach option $font_descs {
2087                set name [lindex $option 0]
2088                set font [lindex $option 1]
2089                if {[catch {
2090                        foreach {cn cv} $repo_config(gui.$name) {
2091                                font configure $font $cn $cv
2092                        }
2093                        } err]} {
2094                        error_popup "Invalid font specified in gui.$name:\n\n$err"
2095                }
2096                foreach {cn cv} [font configure $font] {
2097                        font configure ${font}bold $cn $cv
2098                }
2099                font configure ${font}bold -weight bold
2100        }
2101}
2102
2103set default_config(gui.trustmtime) false
2104set default_config(gui.pullsummary) true
2105set default_config(gui.partialinclude) false
2106set default_config(gui.diffcontext) 5
2107set default_config(gui.fontui) [font configure font_ui]
2108set default_config(gui.fontdiff) [font configure font_diff]
2109set font_descs {
2110        {fontui   font_ui   {Main Font}}
2111        {fontdiff font_diff {Diff/Console Font}}
2112}
2113load_config 0
2114apply_config
2115
2116######################################################################
2117##
2118## ui construction
2119
2120# -- Menu Bar
2121menu .mbar -tearoff 0
2122.mbar add cascade -label Project -menu .mbar.project
2123.mbar add cascade -label Edit -menu .mbar.edit
2124.mbar add cascade -label Commit -menu .mbar.commit
2125if {!$single_commit} {
2126        .mbar add cascade -label Fetch -menu .mbar.fetch
2127        .mbar add cascade -label Pull -menu .mbar.pull
2128        .mbar add cascade -label Push -menu .mbar.push
2129}
2130. configure -menu .mbar
2131
2132# -- Project Menu
2133menu .mbar.project
2134.mbar.project add command -label Visualize \
2135        -command do_gitk \
2136        -font font_ui
2137if {!$single_commit} {
2138        .mbar.project add command -label {Repack Database} \
2139                -command do_repack \
2140                -font font_ui
2141}
2142.mbar.project add command -label Quit \
2143        -command do_quit \
2144        -accelerator $M1T-Q \
2145        -font font_ui
2146
2147# -- Edit Menu
2148#
2149menu .mbar.edit
2150.mbar.edit add command -label Undo \
2151        -command {catch {[focus] edit undo}} \
2152        -accelerator $M1T-Z \
2153        -font font_ui
2154.mbar.edit add command -label Redo \
2155        -command {catch {[focus] edit redo}} \
2156        -accelerator $M1T-Y \
2157        -font font_ui
2158.mbar.edit add separator
2159.mbar.edit add command -label Cut \
2160        -command {catch {tk_textCut [focus]}} \
2161        -accelerator $M1T-X \
2162        -font font_ui
2163.mbar.edit add command -label Copy \
2164        -command {catch {tk_textCopy [focus]}} \
2165        -accelerator $M1T-C \
2166        -font font_ui
2167.mbar.edit add command -label Paste \
2168        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2169        -accelerator $M1T-V \
2170        -font font_ui
2171.mbar.edit add command -label Delete \
2172        -command {catch {[focus] delete sel.first sel.last}} \
2173        -accelerator Del \
2174        -font font_ui
2175.mbar.edit add separator
2176.mbar.edit add command -label {Select All} \
2177        -command {catch {[focus] tag add sel 0.0 end}} \
2178        -accelerator $M1T-A \
2179        -font font_ui
2180.mbar.edit add separator
2181.mbar.edit add command -label {Options...} \
2182        -command do_options \
2183        -font font_ui
2184
2185# -- Commit Menu
2186menu .mbar.commit
2187.mbar.commit add command -label Rescan \
2188        -command do_rescan \
2189        -accelerator F5 \
2190        -font font_ui
2191lappend disable_on_lock \
2192        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2193.mbar.commit add command -label {Amend Last Commit} \
2194        -command do_amend_last \
2195        -font font_ui
2196lappend disable_on_lock \
2197        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2198.mbar.commit add command -label {Include All Files} \
2199        -command do_include_all \
2200        -accelerator $M1T-I \
2201        -font font_ui
2202lappend disable_on_lock \
2203        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2204.mbar.commit add command -label {Sign Off} \
2205        -command do_signoff \
2206        -accelerator $M1T-S \
2207        -font font_ui
2208.mbar.commit add command -label Commit \
2209        -command do_commit \
2210        -accelerator $M1T-Return \
2211        -font font_ui
2212lappend disable_on_lock \
2213        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2214
2215if {!$single_commit} {
2216        # -- Fetch Menu
2217        menu .mbar.fetch
2218
2219        # -- Pull Menu
2220        menu .mbar.pull
2221
2222        # -- Push Menu
2223        menu .mbar.push
2224}
2225
2226# -- Main Window Layout
2227panedwindow .vpane -orient vertical
2228panedwindow .vpane.files -orient horizontal
2229.vpane add .vpane.files -sticky nsew -height 100 -width 400
2230pack .vpane -anchor n -side top -fill both -expand 1
2231
2232# -- Index File List
2233frame .vpane.files.index -height 100 -width 400
2234label .vpane.files.index.title -text {Modified Files} \
2235        -background green \
2236        -font font_ui
2237text $ui_index -background white -borderwidth 0 \
2238        -width 40 -height 10 \
2239        -font font_ui \
2240        -cursor $cursor_ptr \
2241        -yscrollcommand {.vpane.files.index.sb set} \
2242        -state disabled
2243scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2244pack .vpane.files.index.title -side top -fill x
2245pack .vpane.files.index.sb -side right -fill y
2246pack $ui_index -side left -fill both -expand 1
2247.vpane.files add .vpane.files.index -sticky nsew
2248
2249# -- Other (Add) File List
2250frame .vpane.files.other -height 100 -width 100
2251label .vpane.files.other.title -text {Untracked Files} \
2252        -background red \
2253        -font font_ui
2254text $ui_other -background white -borderwidth 0 \
2255        -width 40 -height 10 \
2256        -font font_ui \
2257        -cursor $cursor_ptr \
2258        -yscrollcommand {.vpane.files.other.sb set} \
2259        -state disabled
2260scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2261pack .vpane.files.other.title -side top -fill x
2262pack .vpane.files.other.sb -side right -fill y
2263pack $ui_other -side left -fill both -expand 1
2264.vpane.files add .vpane.files.other -sticky nsew
2265
2266foreach i [list $ui_index $ui_other] {
2267        $i tag conf in_diff -font font_uibold
2268        $i tag conf in_sel \
2269                -background [$i cget -foreground] \
2270                -foreground [$i cget -background]
2271}
2272unset i
2273
2274# -- Diff and Commit Area
2275frame .vpane.lower -height 300 -width 400
2276frame .vpane.lower.commarea
2277frame .vpane.lower.diff -relief sunken -borderwidth 1
2278pack .vpane.lower.commarea -side top -fill x
2279pack .vpane.lower.diff -side bottom -fill both -expand 1
2280.vpane add .vpane.lower -stick nsew
2281
2282# -- Commit Area Buttons
2283frame .vpane.lower.commarea.buttons
2284label .vpane.lower.commarea.buttons.l -text {} \
2285        -anchor w \
2286        -justify left \
2287        -font font_ui
2288pack .vpane.lower.commarea.buttons.l -side top -fill x
2289pack .vpane.lower.commarea.buttons -side left -fill y
2290
2291button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2292        -command do_rescan \
2293        -font font_ui
2294pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2295lappend disable_on_lock \
2296        {.vpane.lower.commarea.buttons.rescan conf -state}
2297
2298button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2299        -command do_amend_last \
2300        -font font_ui
2301pack .vpane.lower.commarea.buttons.amend -side top -fill x
2302lappend disable_on_lock \
2303        {.vpane.lower.commarea.buttons.amend conf -state}
2304
2305button .vpane.lower.commarea.buttons.incall -text {Include All} \
2306        -command do_include_all \
2307        -font font_ui
2308pack .vpane.lower.commarea.buttons.incall -side top -fill x
2309lappend disable_on_lock \
2310        {.vpane.lower.commarea.buttons.incall conf -state}
2311
2312button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2313        -command do_signoff \
2314        -font font_ui
2315pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2316
2317button .vpane.lower.commarea.buttons.commit -text {Commit} \
2318        -command do_commit \
2319        -font font_ui
2320pack .vpane.lower.commarea.buttons.commit -side top -fill x
2321lappend disable_on_lock \
2322        {.vpane.lower.commarea.buttons.commit conf -state}
2323
2324# -- Commit Message Buffer
2325frame .vpane.lower.commarea.buffer
2326set ui_comm .vpane.lower.commarea.buffer.t
2327set ui_coml .vpane.lower.commarea.buffer.l
2328label $ui_coml -text {Commit Message:} \
2329        -anchor w \
2330        -justify left \
2331        -font font_ui
2332trace add variable commit_type write {uplevel #0 {
2333        switch -glob $commit_type \
2334        initial {$ui_coml conf -text {Initial Commit Message:}} \
2335        amend   {$ui_coml conf -text {Amended Commit Message:}} \
2336        merge   {$ui_coml conf -text {Merge Commit Message:}} \
2337        *       {$ui_coml conf -text {Commit Message:}}
2338}}
2339text $ui_comm -background white -borderwidth 1 \
2340        -undo true \
2341        -maxundo 20 \
2342        -autoseparators true \
2343        -relief sunken \
2344        -width 75 -height 9 -wrap none \
2345        -font font_diff \
2346        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2347scrollbar .vpane.lower.commarea.buffer.sby \
2348        -command [list $ui_comm yview]
2349pack $ui_coml -side top -fill x
2350pack .vpane.lower.commarea.buffer.sby -side right -fill y
2351pack $ui_comm -side left -fill y
2352pack .vpane.lower.commarea.buffer -side left -fill y
2353
2354# -- Commit Message Buffer Context Menu
2355#
2356menu $ui_comm.ctxm -tearoff 0
2357$ui_comm.ctxm add command -label "Cut" \
2358        -font font_ui \
2359        -command "tk_textCut $ui_comm"
2360$ui_comm.ctxm add command -label "Copy" \
2361        -font font_ui \
2362        -command "tk_textCopy $ui_comm"
2363$ui_comm.ctxm add command -label "Paste" \
2364        -font font_ui \
2365        -command "tk_textPaste $ui_comm"
2366$ui_comm.ctxm add command -label "Delete" \
2367        -font font_ui \
2368        -command "$ui_comm delete sel.first sel.last"
2369$ui_comm.ctxm add separator
2370$ui_comm.ctxm add command -label "Select All" \
2371        -font font_ui \
2372        -command "$ui_comm tag add sel 0.0 end"
2373$ui_comm.ctxm add command -label "Copy All" \
2374        -font font_ui \
2375        -command "
2376                $ui_comm tag add sel 0.0 end
2377                tk_textCopy $ui_comm
2378                $ui_comm tag remove sel 0.0 end
2379        "
2380$ui_comm.ctxm add separator
2381$ui_comm.ctxm add command -label "Sign Off" \
2382        -font font_ui \
2383        -command do_signoff
2384bind_button3 $ui_comm "tk_popup $ui_comm.ctxm %X %Y"
2385
2386# -- Diff Header
2387set ui_fname_value {}
2388set ui_fstatus_value {}
2389frame .vpane.lower.diff.header -background orange
2390label .vpane.lower.diff.header.l4 \
2391        -textvariable ui_fstatus_value \
2392        -background orange \
2393        -width $max_status_desc \
2394        -anchor w \
2395        -justify left \
2396        -font font_ui
2397label .vpane.lower.diff.header.l1 -text {File:} \
2398        -background orange \
2399        -font font_ui
2400set ui_fname .vpane.lower.diff.header.l2
2401label $ui_fname \
2402        -textvariable ui_fname_value \
2403        -background orange \
2404        -anchor w \
2405        -justify left \
2406        -font font_ui
2407menu $ui_fname.ctxm -tearoff 0
2408$ui_fname.ctxm add command -label "Copy" \
2409        -font font_ui \
2410        -command {
2411                clipboard clear
2412                clipboard append \
2413                        -format STRING \
2414                        -type STRING \
2415                        -- $ui_fname_value
2416        }
2417bind_button3 $ui_fname "tk_popup $ui_fname.ctxm %X %Y"
2418pack .vpane.lower.diff.header.l4 -side left
2419pack .vpane.lower.diff.header.l1 -side left
2420pack $ui_fname -fill x
2421
2422# -- Diff Body
2423frame .vpane.lower.diff.body
2424set ui_diff .vpane.lower.diff.body.t
2425text $ui_diff -background white -borderwidth 0 \
2426        -width 80 -height 15 -wrap none \
2427        -font font_diff \
2428        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2429        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2430        -state disabled
2431scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2432        -command [list $ui_diff xview]
2433scrollbar .vpane.lower.diff.body.sby -orient vertical \
2434        -command [list $ui_diff yview]
2435pack .vpane.lower.diff.body.sbx -side bottom -fill x
2436pack .vpane.lower.diff.body.sby -side right -fill y
2437pack $ui_diff -side left -fill both -expand 1
2438pack .vpane.lower.diff.header -side top -fill x
2439pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2440
2441$ui_diff tag conf dm -foreground red
2442$ui_diff tag conf dp -foreground blue
2443$ui_diff tag conf di -foreground {#00a000}
2444$ui_diff tag conf dni -foreground {#a000a0}
2445$ui_diff tag conf da -font font_diffbold
2446$ui_diff tag conf bold -font font_diffbold
2447
2448# -- Diff Body Context Menu
2449#
2450menu $ui_diff.ctxm -tearoff 0
2451$ui_diff.ctxm add command -label "Copy" \
2452        -font font_ui \
2453        -command "tk_textCopy $ui_diff"
2454$ui_diff.ctxm add command -label "Select All" \
2455        -font font_ui \
2456        -command "$ui_diff tag add sel 0.0 end"
2457$ui_diff.ctxm add command -label "Copy All" \
2458        -font font_ui \
2459        -command "
2460                $ui_diff tag add sel 0.0 end
2461                tk_textCopy $ui_diff
2462                $ui_diff tag remove sel 0.0 end
2463        "
2464$ui_diff.ctxm add separator
2465$ui_diff.ctxm add command -label "Decrease Font Size" \
2466        -font font_ui \
2467        -command {incr_font_size font_diff -1}
2468$ui_diff.ctxm add command -label "Increase Font Size" \
2469        -font font_ui \
2470        -command {incr_font_size font_diff 1}
2471$ui_diff.ctxm add separator
2472$ui_diff.ctxm add command -label "Show Less Context" \
2473        -font font_ui \
2474        -command {if {$ui_fname_value ne {}
2475                && $repo_config(gui.diffcontext) >= 2} {
2476                incr repo_config(gui.diffcontext) -1
2477                reshow_diff
2478        }}
2479$ui_diff.ctxm add command -label "Show More Context" \
2480        -font font_ui \
2481        -command {if {$ui_fname_value ne {}} {
2482                incr repo_config(gui.diffcontext)
2483                reshow_diff
2484        }}
2485$ui_diff.ctxm add separator
2486$ui_diff.ctxm add command -label {Options...} \
2487        -font font_ui \
2488        -command do_options
2489bind_button3 $ui_diff "tk_popup $ui_diff.ctxm %X %Y"
2490
2491# -- Status Bar
2492set ui_status_value {Initializing...}
2493label .status -textvariable ui_status_value \
2494        -anchor w \
2495        -justify left \
2496        -borderwidth 1 \
2497        -relief sunken \
2498        -font font_ui
2499pack .status -anchor w -side bottom -fill x
2500
2501# -- Load geometry
2502catch {
2503set gm $repo_config(gui.geometry)
2504wm geometry . [lindex $gm 0]
2505.vpane sash place 0 \
2506        [lindex [.vpane sash coord 0] 0] \
2507        [lindex $gm 1]
2508.vpane.files sash place 0 \
2509        [lindex $gm 2] \
2510        [lindex [.vpane.files sash coord 0] 1]
2511unset gm
2512}
2513
2514# -- Key Bindings
2515bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2516bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2517bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2518bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2519bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2520bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2521bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2522bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2523bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2524bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2525bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2526
2527bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2528bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2529bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2530bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2531bind $ui_diff <$M1B-Key-v> {break}
2532bind $ui_diff <$M1B-Key-V> {break}
2533bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2534bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2535bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2536bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2537bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2538bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2539
2540bind .   <Destroy> do_quit
2541bind all <Key-F5> do_rescan
2542bind all <$M1B-Key-r> do_rescan
2543bind all <$M1B-Key-R> do_rescan
2544bind .   <$M1B-Key-s> do_signoff
2545bind .   <$M1B-Key-S> do_signoff
2546bind .   <$M1B-Key-i> do_include_all
2547bind .   <$M1B-Key-I> do_include_all
2548bind .   <$M1B-Key-Return> do_commit
2549bind all <$M1B-Key-q> do_quit
2550bind all <$M1B-Key-Q> do_quit
2551bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2552bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2553foreach i [list $ui_index $ui_other] {
2554        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2555        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2556        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2557}
2558unset i
2559
2560set file_lists($ui_index) [list]
2561set file_lists($ui_other) [list]
2562
2563wm title . "$appname ([file normalize [file dirname $gitdir]])"
2564focus -force $ui_comm
2565if {!$single_commit} {
2566        load_all_remotes
2567        populate_remote_menu .mbar.fetch From fetch_from
2568        populate_remote_menu .mbar.push To push_to
2569        populate_pull_menu .mbar.pull
2570}
2571after 1 do_rescan