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