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