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