git-guion commit git-gui: Added repack database menu option, to invoke git repack. (d1536c4)
   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
  10######################################################################
  11##
  12## task management
  13
  14set single_commit 0
  15set status_active 0
  16set diff_active 0
  17set checkin_active 0
  18set commit_active 0
  19set update_index_fd {}
  20
  21set disable_on_lock [list]
  22set index_lock_type none
  23
  24set HEAD {}
  25set PARENT {}
  26set commit_type {}
  27
  28proc lock_index {type} {
  29        global index_lock_type disable_on_lock
  30
  31        if {$index_lock_type == {none}} {
  32                set index_lock_type $type
  33                foreach w $disable_on_lock {
  34                        uplevel #0 $w disabled
  35                }
  36                return 1
  37        } elseif {$index_lock_type == {begin-update} && $type == {update}} {
  38                set index_lock_type $type
  39                return 1
  40        }
  41        return 0
  42}
  43
  44proc unlock_index {} {
  45        global index_lock_type disable_on_lock
  46
  47        set index_lock_type none
  48        foreach w $disable_on_lock {
  49                uplevel #0 $w normal
  50        }
  51}
  52
  53######################################################################
  54##
  55## status
  56
  57proc repository_state {hdvar ctvar} {
  58        global gitdir
  59        upvar $hdvar hd $ctvar ct
  60
  61        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
  62                set ct initial
  63        } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
  64                set ct merge
  65        } else {
  66                set ct normal
  67        }
  68}
  69
  70proc update_status {{final Ready.}} {
  71        global HEAD PARENT commit_type
  72        global ui_index ui_other ui_status_value ui_comm
  73        global status_active file_states
  74
  75        if {$status_active || ![lock_index read]} return
  76
  77        repository_state new_HEAD new_type
  78        if {$commit_type == {amend} 
  79                && $new_type == {normal}
  80                && $new_HEAD == $HEAD} {
  81        } else {
  82                set HEAD $new_HEAD
  83                set PARENT $new_HEAD
  84                set commit_type $new_type
  85        }
  86
  87        array unset file_states
  88        foreach w [list $ui_index $ui_other] {
  89                $w conf -state normal
  90                $w delete 0.0 end
  91                $w conf -state disabled
  92        }
  93
  94        if {![$ui_comm edit modified]
  95                || [string trim [$ui_comm get 0.0 end]] == {}} {
  96                if {[load_message GITGUI_MSG]} {
  97                } elseif {[load_message MERGE_MSG]} {
  98                } elseif {[load_message SQUASH_MSG]} {
  99                }
 100                $ui_comm edit modified false
 101        }
 102
 103        set status_active 1
 104        set ui_status_value {Refreshing file status...}
 105        set fd_rf [open "| git update-index -q --unmerged --refresh" r]
 106        fconfigure $fd_rf -blocking 0 -translation binary
 107        fileevent $fd_rf readable [list read_refresh $fd_rf $final]
 108}
 109
 110proc read_refresh {fd final} {
 111        global gitdir PARENT commit_type
 112        global ui_index ui_other ui_status_value ui_comm
 113        global status_active file_states
 114        global buf_rdi buf_rdf buf_rlo
 115
 116        read $fd
 117        if {![eof $fd]} return
 118        close $fd
 119
 120        set ls_others [list | git ls-files --others -z \
 121                --exclude-per-directory=.gitignore]
 122        set info_exclude [file join $gitdir info exclude]
 123        if {[file readable $info_exclude]} {
 124                lappend ls_others "--exclude-from=$info_exclude"
 125        }
 126
 127        set buf_rdi {}
 128        set buf_rdf {}
 129        set buf_rlo {}
 130
 131        set status_active 3
 132        set ui_status_value {Scanning for modified files ...}
 133        set fd_di [open "| git diff-index --cached -z $PARENT" r]
 134        set fd_df [open "| git diff-files -z" r]
 135        set fd_lo [open $ls_others r]
 136
 137        fconfigure $fd_di -blocking 0 -translation binary
 138        fconfigure $fd_df -blocking 0 -translation binary
 139        fconfigure $fd_lo -blocking 0 -translation binary
 140        fileevent $fd_di readable [list read_diff_index $fd_di $final]
 141        fileevent $fd_df readable [list read_diff_files $fd_df $final]
 142        fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
 143}
 144
 145proc load_message {file} {
 146        global gitdir ui_comm
 147
 148        set f [file join $gitdir $file]
 149        if {[file isfile $f]} {
 150                if {[catch {set fd [open $f r]}]} {
 151                        return 0
 152                }
 153                set content [string trim [read $fd]]
 154                close $fd
 155                $ui_comm delete 0.0 end
 156                $ui_comm insert end $content
 157                return 1
 158        }
 159        return 0
 160}
 161
 162proc read_diff_index {fd final} {
 163        global buf_rdi
 164
 165        append buf_rdi [read $fd]
 166        set c 0
 167        set n [string length $buf_rdi]
 168        while {$c < $n} {
 169                set z1 [string first "\0" $buf_rdi $c]
 170                if {$z1 == -1} break
 171                incr z1
 172                set z2 [string first "\0" $buf_rdi $z1]
 173                if {$z2 == -1} break
 174
 175                set c $z2
 176                incr z2 -1
 177                display_file \
 178                        [string range $buf_rdi $z1 $z2] \
 179                        [string index $buf_rdi [expr $z1 - 2]]_
 180                incr c
 181        }
 182        if {$c < $n} {
 183                set buf_rdi [string range $buf_rdi $c end]
 184        } else {
 185                set buf_rdi {}
 186        }
 187
 188        status_eof $fd buf_rdi $final
 189}
 190
 191proc read_diff_files {fd final} {
 192        global buf_rdf
 193
 194        append buf_rdf [read $fd]
 195        set c 0
 196        set n [string length $buf_rdf]
 197        while {$c < $n} {
 198                set z1 [string first "\0" $buf_rdf $c]
 199                if {$z1 == -1} break
 200                incr z1
 201                set z2 [string first "\0" $buf_rdf $z1]
 202                if {$z2 == -1} break
 203
 204                set c $z2
 205                incr z2 -1
 206                display_file \
 207                        [string range $buf_rdf $z1 $z2] \
 208                        _[string index $buf_rdf [expr $z1 - 2]]
 209                incr c
 210        }
 211        if {$c < $n} {
 212                set buf_rdf [string range $buf_rdf $c end]
 213        } else {
 214                set buf_rdf {}
 215        }
 216
 217        status_eof $fd buf_rdf $final
 218}
 219
 220proc read_ls_others {fd final} {
 221        global buf_rlo
 222
 223        append buf_rlo [read $fd]
 224        set pck [split $buf_rlo "\0"]
 225        set buf_rlo [lindex $pck end]
 226        foreach p [lrange $pck 0 end-1] {
 227                display_file $p _O
 228        }
 229        status_eof $fd buf_rlo $final
 230}
 231
 232proc status_eof {fd buf final} {
 233        global status_active $buf
 234        global ui_fname_value ui_status_value file_states
 235
 236        if {[eof $fd]} {
 237                set $buf {}
 238                close $fd
 239
 240                if {[incr status_active -1] == 0} {
 241                        unlock_index
 242
 243                        display_all_files
 244                        set ui_status_value $final
 245
 246                        if {$ui_fname_value != {} && [array names file_states \
 247                                -exact $ui_fname_value] != {}}  {
 248                                show_diff $ui_fname_value
 249                        } else {
 250                                clear_diff
 251                        }
 252                }
 253        }
 254}
 255
 256######################################################################
 257##
 258## diff
 259
 260proc clear_diff {} {
 261        global ui_diff ui_fname_value ui_fstatus_value
 262
 263        $ui_diff conf -state normal
 264        $ui_diff delete 0.0 end
 265        $ui_diff conf -state disabled
 266        set ui_fname_value {}
 267        set ui_fstatus_value {}
 268}
 269
 270proc show_diff {path} {
 271        global file_states PARENT diff_3way diff_active
 272        global ui_diff ui_fname_value ui_fstatus_value ui_status_value
 273
 274        if {$diff_active || ![lock_index read]} return
 275
 276        clear_diff
 277        set s $file_states($path)
 278        set m [lindex $s 0]
 279        set diff_3way 0
 280        set diff_active 1
 281        set ui_fname_value $path
 282        set ui_fstatus_value [mapdesc $m $path]
 283        set ui_status_value "Loading diff of $path..."
 284
 285        set cmd [list | git diff-index -p $PARENT -- $path]
 286        switch $m {
 287        AM {
 288        }
 289        MM {
 290                set cmd [list | git diff-index -p -c $PARENT $path]
 291        }
 292        _O {
 293                if {[catch {
 294                                set fd [open $path r]
 295                                set content [read $fd]
 296                                close $fd
 297                        } err ]} {
 298                        set diff_active 0
 299                        unlock_index
 300                        set ui_status_value "Unable to display $path"
 301                        error_popup "Error loading file:\n$err"
 302                        return
 303                }
 304                $ui_diff conf -state normal
 305                $ui_diff insert end $content
 306                $ui_diff conf -state disabled
 307                set diff_active 0
 308                unlock_index
 309                set ui_status_value {Ready.}
 310                return
 311        }
 312        }
 313
 314        if {[catch {set fd [open $cmd r]} err]} {
 315                set diff_active 0
 316                unlock_index
 317                set ui_status_value "Unable to display $path"
 318                error_popup "Error loading diff:\n$err"
 319                return
 320        }
 321
 322        fconfigure $fd -blocking 0 -translation auto
 323        fileevent $fd readable [list read_diff $fd]
 324}
 325
 326proc read_diff {fd} {
 327        global ui_diff ui_status_value diff_3way diff_active
 328
 329        while {[gets $fd line] >= 0} {
 330                if {[string match {diff --git *} $line]} continue
 331                if {[string match {diff --combined *} $line]} continue
 332                if {[string match {--- *} $line]} continue
 333                if {[string match {+++ *} $line]} continue
 334                if {[string match index* $line]} {
 335                        if {[string first , $line] >= 0} {
 336                                set diff_3way 1
 337                        }
 338                }
 339
 340                $ui_diff conf -state normal
 341                if {!$diff_3way} {
 342                        set x [string index $line 0]
 343                        switch -- $x {
 344                        "@" {set tags da}
 345                        "+" {set tags dp}
 346                        "-" {set tags dm}
 347                        default {set tags {}}
 348                        }
 349                } else {
 350                        set x [string range $line 0 1]
 351                        switch -- $x {
 352                        default {set tags {}}
 353                        "@@" {set tags da}
 354                        "++" {set tags dp; set x " +"}
 355                        " +" {set tags {di bold}; set x "++"}
 356                        "+ " {set tags dni; set x "-+"}
 357                        "--" {set tags dm; set x " -"}
 358                        " -" {set tags {dm bold}; set x "--"}
 359                        "- " {set tags di; set x "+-"}
 360                        default {set tags {}}
 361                        }
 362                        set line [string replace $line 0 1 $x]
 363                }
 364                $ui_diff insert end $line $tags
 365                $ui_diff insert end "\n"
 366                $ui_diff conf -state disabled
 367        }
 368
 369        if {[eof $fd]} {
 370                close $fd
 371                set diff_active 0
 372                unlock_index
 373                set ui_status_value {Ready.}
 374        }
 375}
 376
 377######################################################################
 378##
 379## commit
 380
 381proc load_last_commit {} {
 382        global HEAD PARENT commit_type ui_comm
 383
 384        if {$commit_type == {amend}} return
 385        if {$commit_type != {normal}} {
 386                error_popup "Can't amend a $commit_type commit."
 387                return
 388        }
 389
 390        set msg {}
 391        set parent {}
 392        set parent_count 0
 393        if {[catch {
 394                        set fd [open "| git cat-file commit $HEAD" r]
 395                        while {[gets $fd line] > 0} {
 396                                if {[string match {parent *} $line]} {
 397                                        set parent [string range $line 7 end]
 398                                        incr parent_count
 399                                }
 400                        }
 401                        set msg [string trim [read $fd]]
 402                        close $fd
 403                } err]} {
 404                error_popup "Error loading commit data for amend:\n$err"
 405                return
 406        }
 407
 408        if {$parent_count == 0} {
 409                set commit_type amend
 410                set HEAD {}
 411                set PARENT {}
 412                update_status
 413        } elseif {$parent_count == 1} {
 414                set commit_type amend
 415                set PARENT $parent
 416                $ui_comm delete 0.0 end
 417                $ui_comm insert end $msg
 418                $ui_comm edit modified false
 419                update_status
 420        } else {
 421                error_popup {You can't amend a merge commit.}
 422                return
 423        }
 424}
 425
 426proc commit_tree {} {
 427        global tcl_platform HEAD gitdir commit_type file_states
 428        global commit_active ui_status_value
 429        global ui_comm
 430
 431        if {$commit_active || ![lock_index update]} return
 432
 433        # -- Our in memory state should match the repository.
 434        #
 435        repository_state curHEAD cur_type
 436        if {$commit_type == {amend} 
 437                && $cur_type == {normal}
 438                && $curHEAD == $HEAD} {
 439        } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
 440                error_popup {Last scanned state does not match repository state.
 441
 442Its highly likely that another Git program modified the
 443repository since our last scan.  A rescan is required
 444before committing.
 445}
 446                unlock_index
 447                update_status
 448                return
 449        }
 450
 451        # -- At least one file should differ in the index.
 452        #
 453        set files_ready 0
 454        foreach path [array names file_states] {
 455                set s $file_states($path)
 456                switch -glob -- [lindex $s 0] {
 457                _* {continue}
 458                A* -
 459                D* -
 460                M* {set files_ready 1; break}
 461                U* {
 462                        error_popup "Unmerged files cannot be committed.
 463
 464File $path has merge conflicts.
 465You must resolve them and check the file in before committing.
 466"
 467                        unlock_index
 468                        return
 469                }
 470                default {
 471                        error_popup "Unknown file state [lindex $s 0] detected.
 472
 473File $path cannot be committed by this program.
 474"
 475                }
 476                }
 477        }
 478        if {!$files_ready} {
 479                error_popup {No checked-in files to commit.
 480
 481You must check-in at least 1 file before you can commit.
 482}
 483                unlock_index
 484                return
 485        }
 486
 487        # -- A message is required.
 488        #
 489        set msg [string trim [$ui_comm get 1.0 end]]
 490        if {$msg == {}} {
 491                error_popup {Please supply a commit message.
 492
 493A good commit message has the following format:
 494
 495- First line: Describe in one sentance what you did.
 496- Second line: Blank
 497- Remaining lines: Describe why this change is good.
 498}
 499                unlock_index
 500                return
 501        }
 502
 503        # -- Ask the pre-commit hook for the go-ahead.
 504        #
 505        set pchook [file join $gitdir hooks pre-commit]
 506        if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
 507                set pchook [list sh -c \
 508                        "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
 509        } elseif {[file executable $pchook]} {
 510                set pchook [list $pchook]
 511        } else {
 512                set pchook {}
 513        }
 514        if {$pchook != {} && [catch {eval exec $pchook} err]} {
 515                hook_failed_popup pre-commit $err
 516                unlock_index
 517                return
 518        }
 519
 520        # -- Write the tree in the background.
 521        #
 522        set commit_active 1
 523        set ui_status_value {Committing changes...}
 524
 525        set fd_wt [open "| git write-tree" r]
 526        fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
 527}
 528
 529proc commit_stage2 {fd_wt curHEAD msg} {
 530        global single_commit gitdir PARENT commit_type
 531        global commit_active ui_status_value ui_comm
 532
 533        gets $fd_wt tree_id
 534        close $fd_wt
 535
 536        if {$tree_id == {}} {
 537                error_popup "write-tree failed"
 538                set commit_active 0
 539                set ui_status_value {Commit failed.}
 540                unlock_index
 541                return
 542        }
 543
 544        # -- Create the commit.
 545        #
 546        set cmd [list git commit-tree $tree_id]
 547        if {$PARENT != {}} {
 548                lappend cmd -p $PARENT
 549        }
 550        if {$commit_type == {merge}} {
 551                if {[catch {
 552                                set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 553                                while {[gets $fd_mh merge_head] >= 0} {
 554                                        lappend cmd -p $merge_head
 555                                }
 556                                close $fd_mh
 557                        } err]} {
 558                        error_popup "Loading MERGE_HEADs failed:\n$err"
 559                        set commit_active 0
 560                        set ui_status_value {Commit failed.}
 561                        unlock_index
 562                        return
 563                }
 564        }
 565        if {$PARENT == {}} {
 566                # git commit-tree writes to stderr during initial commit.
 567                lappend cmd 2>/dev/null
 568        }
 569        lappend cmd << $msg
 570        if {[catch {set cmt_id [eval exec $cmd]} err]} {
 571                error_popup "commit-tree failed:\n$err"
 572                set commit_active 0
 573                set ui_status_value {Commit failed.}
 574                unlock_index
 575                return
 576        }
 577
 578        # -- Update the HEAD ref.
 579        #
 580        set reflogm commit
 581        if {$commit_type != {normal}} {
 582                append reflogm " ($commit_type)"
 583        }
 584        set i [string first "\n" $msg]
 585        if {$i >= 0} {
 586                append reflogm {: } [string range $msg 0 [expr $i - 1]]
 587        } else {
 588                append reflogm {: } $msg
 589        }
 590        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 591        if {[catch {eval exec $cmd} err]} {
 592                error_popup "update-ref failed:\n$err"
 593                set commit_active 0
 594                set ui_status_value {Commit failed.}
 595                unlock_index
 596                return
 597        }
 598
 599        # -- Cleanup after ourselves.
 600        #
 601        catch {file delete [file join $gitdir MERGE_HEAD]}
 602        catch {file delete [file join $gitdir MERGE_MSG]}
 603        catch {file delete [file join $gitdir SQUASH_MSG]}
 604        catch {file delete [file join $gitdir GITGUI_MSG]}
 605
 606        # -- Let rerere do its thing.
 607        #
 608        if {[file isdirectory [file join $gitdir rr-cache]]} {
 609                catch {exec git rerere}
 610        }
 611
 612        $ui_comm delete 0.0 end
 613        $ui_comm edit modified false
 614
 615        if {$single_commit} do_quit
 616
 617        set commit_type {}
 618        set commit_active 0
 619        set HEAD $cmt_id
 620        set PARENT $cmt_id
 621        unlock_index
 622        update_status "Changes committed as $cmt_id."
 623}
 624
 625######################################################################
 626##
 627## fetch pull push
 628
 629proc fetch_from {remote} {
 630        set w [new_console "fetch $remote" \
 631                "Fetching new changes from $remote"]
 632        set cmd [list git fetch]
 633        lappend cmd $remote
 634        console_exec $w $cmd
 635}
 636
 637proc pull_remote {remote branch} {
 638        set w [new_console "pull $remote $branch" \
 639                "Pulling new changes from branch $branch in $remote"]
 640        set cmd [list git pull]
 641        lappend cmd $remote
 642        lappend cmd $branch
 643        console_exec $w $cmd [list post_pull_remote $remote $branch]
 644}
 645
 646proc post_pull_remote {remote branch success} {
 647        if {$success} {
 648                update_status "Successfully pulled $branch from $remote."
 649        } else {
 650                update_status "Conflicts detected while pulling $branch from $remote."
 651        }
 652}
 653
 654proc push_to {remote} {
 655        set w [new_console "push $remote" \
 656                "Pushing changes to $remote"]
 657        set cmd [list git push]
 658        lappend cmd $remote
 659        console_exec $w $cmd
 660}
 661
 662######################################################################
 663##
 664## ui helpers
 665
 666proc mapcol {state path} {
 667        global all_cols ui_other
 668
 669        if {[catch {set r $all_cols($state)}]} {
 670                puts "error: no column for state={$state} $path"
 671                return $ui_other
 672        }
 673        return $r
 674}
 675
 676proc mapicon {state path} {
 677        global all_icons
 678
 679        if {[catch {set r $all_icons($state)}]} {
 680                puts "error: no icon for state={$state} $path"
 681                return file_plain
 682        }
 683        return $r
 684}
 685
 686proc mapdesc {state path} {
 687        global all_descs
 688
 689        if {[catch {set r $all_descs($state)}]} {
 690                puts "error: no desc for state={$state} $path"
 691                return $state
 692        }
 693        return $r
 694}
 695
 696proc bsearch {w path} {
 697        set hi [expr [lindex [split [$w index end] .] 0] - 2]
 698        if {$hi == 0} {
 699                return -1
 700        }
 701        set lo 0
 702        while {$lo < $hi} {
 703                set mi [expr [expr $lo + $hi] / 2]
 704                set ti [expr $mi + 1]
 705                set cmp [string compare [$w get $ti.1 $ti.end] $path]
 706                if {$cmp < 0} {
 707                        set lo $ti
 708                } elseif {$cmp == 0} {
 709                        return $mi
 710                } else {
 711                        set hi $mi
 712                }
 713        }
 714        return -[expr $lo + 1]
 715}
 716
 717set next_icon_id 0
 718
 719proc merge_state {path new_state} {
 720        global file_states next_icon_id
 721
 722        set s0 [string index $new_state 0]
 723        set s1 [string index $new_state 1]
 724
 725        if {[catch {set info $file_states($path)}]} {
 726                set state __
 727                set icon n[incr next_icon_id]
 728        } else {
 729                set state [lindex $info 0]
 730                set icon [lindex $info 1]
 731        }
 732
 733        if {$s0 == {_}} {
 734                set s0 [string index $state 0]
 735        } elseif {$s0 == {*}} {
 736                set s0 _
 737        }
 738
 739        if {$s1 == {_}} {
 740                set s1 [string index $state 1]
 741        } elseif {$s1 == {*}} {
 742                set s1 _
 743        }
 744
 745        set file_states($path) [list $s0$s1 $icon]
 746        return $state
 747}
 748
 749proc display_file {path state} {
 750        global ui_index ui_other file_states status_active
 751
 752        set old_m [merge_state $path $state]
 753        if {$status_active} return
 754
 755        set s $file_states($path)
 756        set new_m [lindex $s 0]
 757        set new_w [mapcol $new_m $path] 
 758        set old_w [mapcol $old_m $path]
 759        set new_icon [mapicon $new_m $path]
 760
 761        if {$new_w != $old_w} {
 762                set lno [bsearch $old_w $path]
 763                if {$lno >= 0} {
 764                        incr lno
 765                        $old_w conf -state normal
 766                        $old_w delete $lno.0 [expr $lno + 1].0
 767                        $old_w conf -state disabled
 768                }
 769
 770                set lno [expr abs([bsearch $new_w $path] + 1) + 1]
 771                $new_w conf -state normal
 772                $new_w image create $lno.0 \
 773                        -align center -padx 5 -pady 1 \
 774                        -name [lindex $s 1] \
 775                        -image [mapicon $m $path]
 776                $new_w insert $lno.1 "$path\n"
 777                $new_w conf -state disabled
 778        } elseif {$new_icon != [mapicon $old_m $path]} {
 779                $new_w conf -state normal
 780                $new_w image conf [lindex $s 1] -image $new_icon
 781                $new_w conf -state disabled
 782        }
 783}
 784
 785proc display_all_files {} {
 786        global ui_index ui_other file_states
 787
 788        $ui_index conf -state normal
 789        $ui_other conf -state normal
 790
 791        foreach path [lsort [array names file_states]] {
 792                set s $file_states($path)
 793                set m [lindex $s 0]
 794                set w [mapcol $m $path]
 795                $w image create end \
 796                        -align center -padx 5 -pady 1 \
 797                        -name [lindex $s 1] \
 798                        -image [mapicon $m $path]
 799                $w insert end "$path\n"
 800        }
 801
 802        $ui_index conf -state disabled
 803        $ui_other conf -state disabled
 804}
 805
 806proc with_update_index {body} {
 807        global update_index_fd
 808
 809        if {$update_index_fd == {}} {
 810                if {![lock_index update]} return
 811                set update_index_fd [open \
 812                        "| git update-index --add --remove -z --stdin" \
 813                        w]
 814                fconfigure $update_index_fd -translation binary
 815                uplevel 1 $body
 816                close $update_index_fd
 817                set update_index_fd {}
 818                unlock_index
 819        } else {
 820                uplevel 1 $body
 821        }
 822}
 823
 824proc update_index {path} {
 825        global update_index_fd
 826
 827        if {$update_index_fd == {}} {
 828                error {not in with_update_index}
 829        } else {
 830                puts -nonewline $update_index_fd "$path\0"
 831        }
 832}
 833
 834proc toggle_mode {path} {
 835        global file_states ui_fname_value
 836
 837        set s $file_states($path)
 838        set m [lindex $s 0]
 839
 840        switch -- $m {
 841        AM -
 842        _O {set new A*}
 843        _M -
 844        MM {set new M*}
 845        AD -
 846        _D {set new D*}
 847        default {return}
 848        }
 849
 850        with_update_index {update_index $path}
 851        display_file $path $new
 852        if {$ui_fname_value == $path} {
 853                show_diff $path
 854        }
 855}
 856
 857######################################################################
 858##
 859## config (fetch push pull)
 860
 861proc load_repo_config {} {
 862        global repo_config
 863
 864        array unset repo_config
 865        catch {
 866                set fd_rc [open "| git repo-config --list" r]
 867                while {[gets $fd_rc line] >= 0} {
 868                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 869                                lappend repo_config($name) $value
 870                        }
 871                }
 872                close $fd_rc
 873        }
 874}
 875
 876proc load_all_remotes {} {
 877        global gitdir all_remotes repo_config
 878
 879        set all_remotes [list]
 880        set rm_dir [file join $gitdir remotes]
 881        if {[file isdirectory $rm_dir]} {
 882                set all_remotes [concat $all_remotes [glob \
 883                        -types f \
 884                        -tails \
 885                        -nocomplain \
 886                        -directory $rm_dir *]]
 887        }
 888
 889        foreach line [array names repo_config remote.*.url] {
 890                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
 891                        lappend all_remotes $name
 892                }
 893        }
 894
 895        set all_remotes [lsort -unique $all_remotes]
 896}
 897
 898proc populate_remote_menu {m pfx op} {
 899        global all_remotes mainfont
 900
 901        foreach remote $all_remotes {
 902                $m add command -label "$pfx $remote..." \
 903                        -command [list $op $remote] \
 904                        -font $mainfont
 905        }
 906}
 907
 908proc populate_pull_menu {m} {
 909        global gitdir repo_config all_remotes mainfont
 910
 911        foreach remote $all_remotes {
 912                set rb {}
 913                if {[array get repo_config remote.$remote.url] != {}} {
 914                        if {[array get repo_config remote.$remote.fetch] != {}} {
 915                                regexp {^([^:]+):} \
 916                                        [lindex $repo_config(remote.$remote.fetch) 0] \
 917                                        line rb
 918                        }
 919                } else {
 920                        catch {
 921                                set fd [open [file join $gitdir remotes $remote] r]
 922                                while {[gets $fd line] >= 0} {
 923                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
 924                                                break
 925                                        }
 926                                }
 927                                close $fd
 928                        }
 929                }
 930
 931                set rb_short $rb
 932                regsub ^refs/heads/ $rb {} rb_short
 933                if {$rb_short != {}} {
 934                        $m add command \
 935                                -label "Branch $rb_short from $remote..." \
 936                                -command [list pull_remote $remote $rb] \
 937                                -font $mainfont
 938                }
 939        }
 940}
 941
 942######################################################################
 943##
 944## icons
 945
 946set filemask {
 947#define mask_width 14
 948#define mask_height 15
 949static unsigned char mask_bits[] = {
 950   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 951   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 952   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
 953}
 954
 955image create bitmap file_plain -background white -foreground black -data {
 956#define plain_width 14
 957#define plain_height 15
 958static unsigned char plain_bits[] = {
 959   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
 960   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
 961   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 962} -maskdata $filemask
 963
 964image create bitmap file_mod -background white -foreground blue -data {
 965#define mod_width 14
 966#define mod_height 15
 967static unsigned char mod_bits[] = {
 968   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
 969   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
 970   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
 971} -maskdata $filemask
 972
 973image create bitmap file_fulltick -background white -foreground "#007000" -data {
 974#define file_fulltick_width 14
 975#define file_fulltick_height 15
 976static unsigned char file_fulltick_bits[] = {
 977   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
 978   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
 979   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 980} -maskdata $filemask
 981
 982image create bitmap file_parttick -background white -foreground "#005050" -data {
 983#define parttick_width 14
 984#define parttick_height 15
 985static unsigned char parttick_bits[] = {
 986   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
 987   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
 988   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 989} -maskdata $filemask
 990
 991image create bitmap file_question -background white -foreground black -data {
 992#define file_question_width 14
 993#define file_question_height 15
 994static unsigned char file_question_bits[] = {
 995   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
 996   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
 997   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 998} -maskdata $filemask
 999
1000image create bitmap file_removed -background white -foreground red -data {
1001#define file_removed_width 14
1002#define file_removed_height 15
1003static unsigned char file_removed_bits[] = {
1004   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1005   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1006   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1007} -maskdata $filemask
1008
1009image create bitmap file_merge -background white -foreground blue -data {
1010#define file_merge_width 14
1011#define file_merge_height 15
1012static unsigned char file_merge_bits[] = {
1013   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1014   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1015   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1016} -maskdata $filemask
1017
1018set ui_index .vpane.files.index.list
1019set ui_other .vpane.files.other.list
1020set max_status_desc 0
1021foreach i {
1022                {__ i plain    "Unmodified"}
1023                {_M i mod      "Modified"}
1024                {M_ i fulltick "Checked in"}
1025                {MM i parttick "Partially checked in"}
1026
1027                {_O o plain    "Untracked"}
1028                {A_ o fulltick "Added"}
1029                {AM o parttick "Partially added"}
1030                {AD o question "Added (but now gone)"}
1031
1032                {_D i question "Missing"}
1033                {D_ i removed  "Removed"}
1034                {DD i removed  "Removed"}
1035                {DO i removed  "Removed (still exists)"}
1036
1037                {UM i merge    "Merge conflicts"}
1038                {U_ i merge    "Merge conflicts"}
1039        } {
1040        if {$max_status_desc < [string length [lindex $i 3]]} {
1041                set max_status_desc [string length [lindex $i 3]]
1042        }
1043        if {[lindex $i 1] == {i}} {
1044                set all_cols([lindex $i 0]) $ui_index
1045        } else {
1046                set all_cols([lindex $i 0]) $ui_other
1047        }
1048        set all_icons([lindex $i 0]) file_[lindex $i 2]
1049        set all_descs([lindex $i 0]) [lindex $i 3]
1050}
1051unset filemask i
1052
1053######################################################################
1054##
1055## util
1056
1057proc error_popup {msg} {
1058        set w .error
1059        toplevel $w
1060        wm transient $w .
1061        show_msg $w $w $msg
1062}
1063
1064proc show_msg {w top msg} {
1065        global gitdir appname mainfont
1066
1067        message $w.m -text $msg -justify left -aspect 400
1068        pack $w.m -side top -fill x -padx 5 -pady 10
1069        button $w.ok -text OK \
1070                -width 15 \
1071                -font $mainfont \
1072                -command "destroy $top"
1073        pack $w.ok -side bottom
1074        bind $top <Visibility> "grab $top; focus $top"
1075        bind $top <Key-Return> "destroy $top"
1076        wm title $w "$appname ([lindex [file split \
1077                [file normalize [file dirname $gitdir]]] \
1078                end]): error"
1079        tkwait window $top
1080}
1081
1082proc hook_failed_popup {hook msg} {
1083        global gitdir mainfont difffont appname
1084
1085        set w .hookfail
1086        toplevel $w
1087        wm transient $w .
1088
1089        frame $w.m
1090        label $w.m.l1 -text "$hook hook failed:" \
1091                -anchor w \
1092                -justify left \
1093                -font [concat $mainfont bold]
1094        text $w.m.t \
1095                -background white -borderwidth 1 \
1096                -relief sunken \
1097                -width 80 -height 10 \
1098                -font $difffont \
1099                -yscrollcommand [list $w.m.sby set]
1100        label $w.m.l2 \
1101                -text {You must correct the above errors before committing.} \
1102                -anchor w \
1103                -justify left \
1104                -font [concat $mainfont bold]
1105        scrollbar $w.m.sby -command [list $w.m.t yview]
1106        pack $w.m.l1 -side top -fill x
1107        pack $w.m.l2 -side bottom -fill x
1108        pack $w.m.sby -side right -fill y
1109        pack $w.m.t -side left -fill both -expand 1
1110        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1111
1112        $w.m.t insert 1.0 $msg
1113        $w.m.t conf -state disabled
1114
1115        button $w.ok -text OK \
1116                -width 15 \
1117                -font $mainfont \
1118                -command "destroy $w"
1119        pack $w.ok -side bottom
1120
1121        bind $w <Visibility> "grab $w; focus $w"
1122        bind $w <Key-Return> "destroy $w"
1123        wm title $w "$appname ([lindex [file split \
1124                [file normalize [file dirname $gitdir]]] \
1125                end]): error"
1126        tkwait window $w
1127}
1128
1129set next_console_id 0
1130
1131proc new_console {short_title long_title} {
1132        global next_console_id console_data
1133        set w .console[incr next_console_id]
1134        set console_data($w) [list $short_title $long_title]
1135        return [console_init $w]
1136}
1137
1138proc console_init {w} {
1139        global console_cr console_data
1140        global gitdir appname mainfont difffont
1141
1142        set console_cr($w) 1.0
1143        toplevel $w
1144        frame $w.m
1145        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1146                -anchor w \
1147                -justify left \
1148                -font [concat $mainfont bold]
1149        text $w.m.t \
1150                -background white -borderwidth 1 \
1151                -relief sunken \
1152                -width 80 -height 10 \
1153                -font $difffont \
1154                -state disabled \
1155                -yscrollcommand [list $w.m.sby set]
1156        label $w.m.s -anchor w \
1157                -justify left \
1158                -font [concat $mainfont bold]
1159        scrollbar $w.m.sby -command [list $w.m.t yview]
1160        pack $w.m.l1 -side top -fill x
1161        pack $w.m.s -side bottom -fill x
1162        pack $w.m.sby -side right -fill y
1163        pack $w.m.t -side left -fill both -expand 1
1164        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1165
1166        button $w.ok -text {Running...} \
1167                -width 15 \
1168                -font $mainfont \
1169                -state disabled \
1170                -command "destroy $w"
1171        pack $w.ok -side bottom
1172
1173        bind $w <Visibility> "focus $w"
1174        wm title $w "$appname ([lindex [file split \
1175                [file normalize [file dirname $gitdir]]] \
1176                end]): [lindex $console_data($w) 0]"
1177        return $w
1178}
1179
1180proc console_exec {w cmd {after {}}} {
1181        global tcl_platform
1182
1183        # -- Windows tosses the enviroment when we exec our child.
1184        #    But most users need that so we have to relogin. :-(
1185        #
1186        if {$tcl_platform(platform) == {windows}} {
1187                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1188        }
1189
1190        # -- Tcl won't let us redirect both stdout and stderr to
1191        #    the same pipe.  So pass it through cat...
1192        #
1193        set cmd [concat | $cmd |& cat]
1194
1195        set fd_f [open $cmd r]
1196        fconfigure $fd_f -blocking 0 -translation binary
1197        fileevent $fd_f readable [list console_read $w $fd_f $after]
1198}
1199
1200proc console_read {w fd after} {
1201        global console_cr console_data
1202
1203        set buf [read $fd]
1204        if {$buf != {}} {
1205                if {![winfo exists $w]} {console_init $w}
1206                $w.m.t conf -state normal
1207                set c 0
1208                set n [string length $buf]
1209                while {$c < $n} {
1210                        set cr [string first "\r" $buf $c]
1211                        set lf [string first "\n" $buf $c]
1212                        if {$cr < 0} {set cr [expr $n + 1]}
1213                        if {$lf < 0} {set lf [expr $n + 1]}
1214
1215                        if {$lf < $cr} {
1216                                $w.m.t insert end [string range $buf $c $lf]
1217                                set console_cr($w) [$w.m.t index {end -1c}]
1218                                set c $lf
1219                                incr c
1220                        } else {
1221                                $w.m.t delete $console_cr($w) end
1222                                $w.m.t insert end "\n"
1223                                $w.m.t insert end [string range $buf $c $cr]
1224                                set c $cr
1225                                incr c
1226                        }
1227                }
1228                $w.m.t conf -state disabled
1229                $w.m.t see end
1230        }
1231
1232        fconfigure $fd -blocking 1
1233        if {[eof $fd]} {
1234                if {[catch {close $fd}]} {
1235                        if {![winfo exists $w]} {console_init $w}
1236                        $w.m.s conf -background red -text {Error: Command Failed}
1237                        $w.ok conf -text Close
1238                        $w.ok conf -state normal
1239                        set ok 0
1240                } elseif {[winfo exists $w]} {
1241                        $w.m.s conf -background green -text {Success}
1242                        $w.ok conf -text Close
1243                        $w.ok conf -state normal
1244                        set ok 1
1245                }
1246                array unset console_cr $w
1247                array unset console_data $w
1248                if {$after != {}} {
1249                        uplevel #0 $after $ok
1250                }
1251                return
1252        }
1253        fconfigure $fd -blocking 0
1254}
1255
1256######################################################################
1257##
1258## ui commands
1259
1260set starting_gitk_msg {Please wait... Starting gitk...}
1261
1262proc do_gitk {} {
1263        global tcl_platform ui_status_value starting_gitk_msg
1264
1265        set ui_status_value $starting_gitk_msg
1266        after 10000 {
1267                if {$ui_status_value == $starting_gitk_msg} {
1268                        set ui_status_value {Ready.}
1269                }
1270        }
1271
1272        if {$tcl_platform(platform) == {windows}} {
1273                exec sh -c gitk &
1274        } else {
1275                exec gitk &
1276        }
1277}
1278
1279proc do_repack {} {
1280        set w [new_console "repack" "Repacking the object database"]
1281        set cmd [list git repack]
1282        lappend cmd -a
1283        lappend cmd -d
1284        console_exec $w $cmd
1285}
1286
1287proc do_quit {} {
1288        global gitdir ui_comm
1289
1290        set save [file join $gitdir GITGUI_MSG]
1291        set msg [string trim [$ui_comm get 0.0 end]]
1292        if {[$ui_comm edit modified] && $msg != {}} {
1293                catch {
1294                        set fd [open $save w]
1295                        puts $fd [string trim [$ui_comm get 0.0 end]]
1296                        close $fd
1297                }
1298        } elseif {$msg == {} && [file exists $save]} {
1299                file delete $save
1300        }
1301
1302        destroy .
1303}
1304
1305proc do_rescan {} {
1306        update_status
1307}
1308
1309proc do_checkin_all {} {
1310        global checkin_active ui_status_value
1311
1312        if {$checkin_active || ![lock_index begin-update]} return
1313
1314        set checkin_active 1
1315        set ui_status_value {Checking in all files...}
1316        after 1 {
1317                with_update_index {
1318                        foreach path [array names file_states] {
1319                                set s $file_states($path)
1320                                set m [lindex $s 0]
1321                                switch -- $m {
1322                                AM -
1323                                MM -
1324                                _M -
1325                                _D {toggle_mode $path}
1326                                }
1327                        }
1328                }
1329                set checkin_active 0
1330                set ui_status_value {Ready.}
1331        }
1332}
1333
1334proc do_signoff {} {
1335        global ui_comm
1336
1337        catch {
1338                set me [exec git var GIT_COMMITTER_IDENT]
1339                if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
1340                        set str "Signed-off-by: $name"
1341                        if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1342                                $ui_comm insert end "\n"
1343                                $ui_comm insert end $str
1344                                $ui_comm see end
1345                        }
1346                }
1347        }
1348}
1349
1350proc do_amend_last {} {
1351        load_last_commit
1352}
1353
1354proc do_commit {} {
1355        commit_tree
1356}
1357
1358# shift == 1: left click
1359#          3: right click  
1360proc click {w x y shift wx wy} {
1361        global ui_index ui_other
1362
1363        set pos [split [$w index @$x,$y] .]
1364        set lno [lindex $pos 0]
1365        set col [lindex $pos 1]
1366        set path [$w get $lno.1 $lno.end]
1367        if {$path == {}} return
1368
1369        if {$col > 0 && $shift == 1} {
1370                $ui_index tag remove in_diff 0.0 end
1371                $ui_other tag remove in_diff 0.0 end
1372                $w tag add in_diff $lno.0 [expr $lno + 1].0
1373                show_diff $path
1374        }
1375}
1376
1377proc unclick {w x y} {
1378        set pos [split [$w index @$x,$y] .]
1379        set lno [lindex $pos 0]
1380        set col [lindex $pos 1]
1381        set path [$w get $lno.1 $lno.end]
1382        if {$path == {}} return
1383
1384        if {$col == 0} {
1385                toggle_mode $path
1386        }
1387}
1388
1389######################################################################
1390##
1391## ui init
1392
1393set mainfont {Helvetica 10}
1394set difffont {Courier 10}
1395set maincursor [. cget -cursor]
1396
1397switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1398windows,*   {set M1B Control; set M1T Ctrl}
1399unix,Darwin {set M1B M1; set M1T Cmd}
1400default     {set M1B M1; set M1T M1}
1401}
1402
1403# -- Menu Bar
1404menu .mbar -tearoff 0
1405.mbar add cascade -label Project -menu .mbar.project
1406.mbar add cascade -label Commit -menu .mbar.commit
1407.mbar add cascade -label Fetch -menu .mbar.fetch
1408.mbar add cascade -label Pull -menu .mbar.pull
1409.mbar add cascade -label Push -menu .mbar.push
1410. configure -menu .mbar
1411
1412# -- Project Menu
1413menu .mbar.project
1414.mbar.project add command -label Visualize \
1415        -command do_gitk \
1416        -font $mainfont
1417.mbar.project add command -label {Repack Database} \
1418        -command do_repack \
1419        -font $mainfont
1420.mbar.project add command -label Quit \
1421        -command do_quit \
1422        -accelerator $M1T-Q \
1423        -font $mainfont
1424
1425# -- Commit Menu
1426menu .mbar.commit
1427.mbar.commit add command -label Rescan \
1428        -command do_rescan \
1429        -accelerator F5 \
1430        -font $mainfont
1431lappend disable_on_lock \
1432        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1433.mbar.commit add command -label {Amend Last Commit} \
1434        -command do_amend_last \
1435        -font $mainfont
1436lappend disable_on_lock \
1437        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1438.mbar.commit add command -label {Check-in All Files} \
1439        -command do_checkin_all \
1440        -accelerator $M1T-U \
1441        -font $mainfont
1442lappend disable_on_lock \
1443        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1444.mbar.commit add command -label {Sign Off} \
1445        -command do_signoff \
1446        -accelerator $M1T-S \
1447        -font $mainfont
1448.mbar.commit add command -label Commit \
1449        -command do_commit \
1450        -accelerator $M1T-Return \
1451        -font $mainfont
1452lappend disable_on_lock \
1453        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1454
1455# -- Fetch Menu
1456menu .mbar.fetch
1457
1458# -- Pull Menu
1459menu .mbar.pull
1460
1461# -- Push Menu
1462menu .mbar.push
1463
1464# -- Main Window Layout
1465panedwindow .vpane -orient vertical
1466panedwindow .vpane.files -orient horizontal
1467.vpane add .vpane.files -sticky nsew -height 100 -width 400
1468pack .vpane -anchor n -side top -fill both -expand 1
1469
1470# -- Index File List
1471frame .vpane.files.index -height 100 -width 400
1472label .vpane.files.index.title -text {Modified Files} \
1473        -background green \
1474        -font $mainfont
1475text $ui_index -background white -borderwidth 0 \
1476        -width 40 -height 10 \
1477        -font $mainfont \
1478        -yscrollcommand {.vpane.files.index.sb set} \
1479        -cursor $maincursor \
1480        -state disabled
1481scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1482pack .vpane.files.index.title -side top -fill x
1483pack .vpane.files.index.sb -side right -fill y
1484pack $ui_index -side left -fill both -expand 1
1485.vpane.files add .vpane.files.index -sticky nsew
1486
1487# -- Other (Add) File List
1488frame .vpane.files.other -height 100 -width 100
1489label .vpane.files.other.title -text {Untracked Files} \
1490        -background red \
1491        -font $mainfont
1492text $ui_other -background white -borderwidth 0 \
1493        -width 40 -height 10 \
1494        -font $mainfont \
1495        -yscrollcommand {.vpane.files.other.sb set} \
1496        -cursor $maincursor \
1497        -state disabled
1498scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1499pack .vpane.files.other.title -side top -fill x
1500pack .vpane.files.other.sb -side right -fill y
1501pack $ui_other -side left -fill both -expand 1
1502.vpane.files add .vpane.files.other -sticky nsew
1503
1504$ui_index tag conf in_diff -font [concat $mainfont bold]
1505$ui_other tag conf in_diff -font [concat $mainfont bold]
1506
1507# -- Diff and Commit Area
1508frame .vpane.lower -height 400 -width 400
1509frame .vpane.lower.commarea
1510frame .vpane.lower.diff -relief sunken -borderwidth 1
1511pack .vpane.lower.commarea -side top -fill x
1512pack .vpane.lower.diff -side bottom -fill both -expand 1
1513.vpane add .vpane.lower -stick nsew
1514
1515# -- Commit Area Buttons
1516frame .vpane.lower.commarea.buttons
1517label .vpane.lower.commarea.buttons.l -text {} \
1518        -anchor w \
1519        -justify left \
1520        -font $mainfont
1521pack .vpane.lower.commarea.buttons.l -side top -fill x
1522pack .vpane.lower.commarea.buttons -side left -fill y
1523
1524button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1525        -command do_rescan \
1526        -font $mainfont
1527pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1528lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
1529
1530button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1531        -command do_amend_last \
1532        -font $mainfont
1533pack .vpane.lower.commarea.buttons.amend -side top -fill x
1534lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
1535
1536button .vpane.lower.commarea.buttons.ciall -text {Check-in All} \
1537        -command do_checkin_all \
1538        -font $mainfont
1539pack .vpane.lower.commarea.buttons.ciall -side top -fill x
1540lappend disable_on_lock {.vpane.lower.commarea.buttons.ciall conf -state}
1541
1542button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1543        -command do_signoff \
1544        -font $mainfont
1545pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1546
1547button .vpane.lower.commarea.buttons.commit -text {Commit} \
1548        -command do_commit \
1549        -font $mainfont
1550pack .vpane.lower.commarea.buttons.commit -side top -fill x
1551lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
1552
1553# -- Commit Message Buffer
1554frame .vpane.lower.commarea.buffer
1555set ui_comm .vpane.lower.commarea.buffer.t
1556set ui_coml .vpane.lower.commarea.buffer.l
1557label $ui_coml -text {Commit Message:} \
1558        -anchor w \
1559        -justify left \
1560        -font $mainfont
1561trace add variable commit_type write {uplevel #0 {
1562        switch -glob $commit_type \
1563        initial {$ui_coml conf -text {Initial Commit Message:}} \
1564        amend   {$ui_coml conf -text {Amended Commit Message:}} \
1565        merge   {$ui_coml conf -text {Merge Commit Message:}} \
1566        *       {$ui_coml conf -text {Commit Message:}}
1567}}
1568text $ui_comm -background white -borderwidth 1 \
1569        -relief sunken \
1570        -width 75 -height 9 -wrap none \
1571        -font $difffont \
1572        -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1573        -cursor $maincursor
1574scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
1575pack $ui_coml -side top -fill x
1576pack .vpane.lower.commarea.buffer.sby -side right -fill y
1577pack $ui_comm -side left -fill y
1578pack .vpane.lower.commarea.buffer -side left -fill y
1579
1580# -- Diff Header
1581set ui_fname_value {}
1582set ui_fstatus_value {}
1583frame .vpane.lower.diff.header -background orange
1584label .vpane.lower.diff.header.l1 -text {File:} \
1585        -background orange \
1586        -font $mainfont
1587label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1588        -background orange \
1589        -anchor w \
1590        -justify left \
1591        -font $mainfont
1592label .vpane.lower.diff.header.l3 -text {Status:} \
1593        -background orange \
1594        -font $mainfont
1595label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1596        -background orange \
1597        -width $max_status_desc \
1598        -anchor w \
1599        -justify left \
1600        -font $mainfont
1601pack .vpane.lower.diff.header.l1 -side left
1602pack .vpane.lower.diff.header.l2 -side left -fill x
1603pack .vpane.lower.diff.header.l4 -side right
1604pack .vpane.lower.diff.header.l3 -side right
1605
1606# -- Diff Body
1607frame .vpane.lower.diff.body
1608set ui_diff .vpane.lower.diff.body.t
1609text $ui_diff -background white -borderwidth 0 \
1610        -width 80 -height 15 -wrap none \
1611        -font $difffont \
1612        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1613        -yscrollcommand {.vpane.lower.diff.body.sby set} \
1614        -cursor $maincursor \
1615        -state disabled
1616scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1617        -command [list $ui_diff xview]
1618scrollbar .vpane.lower.diff.body.sby -orient vertical \
1619        -command [list $ui_diff yview]
1620pack .vpane.lower.diff.body.sbx -side bottom -fill x
1621pack .vpane.lower.diff.body.sby -side right -fill y
1622pack $ui_diff -side left -fill both -expand 1
1623pack .vpane.lower.diff.header -side top -fill x
1624pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1625
1626$ui_diff tag conf dm -foreground red
1627$ui_diff tag conf dp -foreground blue
1628$ui_diff tag conf da -font [concat $difffont bold]
1629$ui_diff tag conf di -foreground "#00a000"
1630$ui_diff tag conf dni -foreground "#a000a0"
1631$ui_diff tag conf bold -font [concat $difffont bold]
1632
1633# -- Status Bar
1634set ui_status_value {Initializing...}
1635label .status -textvariable ui_status_value \
1636        -anchor w \
1637        -justify left \
1638        -borderwidth 1 \
1639        -relief sunken \
1640        -font $mainfont
1641pack .status -anchor w -side bottom -fill x
1642
1643# -- Key Bindings
1644bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1645bind .   <Destroy> do_quit
1646bind all <Key-F5> do_rescan
1647bind all <$M1B-Key-r> do_rescan
1648bind all <$M1B-Key-R> do_rescan
1649bind .   <$M1B-Key-s> do_signoff
1650bind .   <$M1B-Key-S> do_signoff
1651bind .   <$M1B-Key-u> do_checkin_all
1652bind .   <$M1B-Key-U> do_checkin_all
1653bind .   <$M1B-Key-Return> do_commit
1654bind all <$M1B-Key-q> do_quit
1655bind all <$M1B-Key-Q> do_quit
1656bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1657bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1658foreach i [list $ui_index $ui_other] {
1659        bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1660        bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1661        bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1662}
1663unset i M1B M1T
1664
1665######################################################################
1666##
1667## main
1668
1669set appname [lindex [file split $argv0] end]
1670set gitdir {}
1671
1672if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
1673        show_msg {} . "Cannot find the git directory: $err"
1674        exit 1
1675}
1676if {$cdup != ""} {
1677        cd $cdup
1678}
1679unset cdup
1680
1681if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1682        show_msg {} . "Cannot find the git directory: $err"
1683        exit 1
1684}
1685
1686if {$appname == {git-citool}} {
1687        set single_commit 1
1688}
1689
1690wm title . "$appname ([file normalize [file dirname $gitdir]])"
1691focus -force $ui_comm
1692load_repo_config
1693load_all_remotes
1694populate_remote_menu .mbar.fetch From fetch_from
1695populate_remote_menu .mbar.push To push_to
1696populate_pull_menu .mbar.pull
1697update_status