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