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