git-guion commit git-gui: Allow the user to disable update-index --refresh during rescan. (e534f3a)
   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        set w [new_console "pull $remote $branch" \
 646                "Pulling new changes from branch $branch in $remote"]
 647        set cmd [list git pull]
 648        lappend cmd $remote
 649        lappend cmd $branch
 650        console_exec $w $cmd [list post_pull_remote $remote $branch]
 651}
 652
 653proc post_pull_remote {remote branch success} {
 654        if {$success} {
 655                update_status "Successfully pulled $branch from $remote."
 656        } else {
 657                update_status "Conflicts detected while pulling $branch from $remote."
 658        }
 659}
 660
 661proc push_to {remote} {
 662        set w [new_console "push $remote" \
 663                "Pushing changes to $remote"]
 664        set cmd [list git push]
 665        lappend cmd $remote
 666        console_exec $w $cmd
 667}
 668
 669######################################################################
 670##
 671## ui helpers
 672
 673proc mapcol {state path} {
 674        global all_cols ui_other
 675
 676        if {[catch {set r $all_cols($state)}]} {
 677                puts "error: no column for state={$state} $path"
 678                return $ui_other
 679        }
 680        return $r
 681}
 682
 683proc mapicon {state path} {
 684        global all_icons
 685
 686        if {[catch {set r $all_icons($state)}]} {
 687                puts "error: no icon for state={$state} $path"
 688                return file_plain
 689        }
 690        return $r
 691}
 692
 693proc mapdesc {state path} {
 694        global all_descs
 695
 696        if {[catch {set r $all_descs($state)}]} {
 697                puts "error: no desc for state={$state} $path"
 698                return $state
 699        }
 700        return $r
 701}
 702
 703proc bsearch {w path} {
 704        set hi [expr [lindex [split [$w index end] .] 0] - 2]
 705        if {$hi == 0} {
 706                return -1
 707        }
 708        set lo 0
 709        while {$lo < $hi} {
 710                set mi [expr [expr $lo + $hi] / 2]
 711                set ti [expr $mi + 1]
 712                set cmp [string compare [$w get $ti.1 $ti.end] $path]
 713                if {$cmp < 0} {
 714                        set lo $ti
 715                } elseif {$cmp == 0} {
 716                        return $mi
 717                } else {
 718                        set hi $mi
 719                }
 720        }
 721        return -[expr $lo + 1]
 722}
 723
 724set next_icon_id 0
 725
 726proc merge_state {path new_state} {
 727        global file_states next_icon_id
 728
 729        set s0 [string index $new_state 0]
 730        set s1 [string index $new_state 1]
 731
 732        if {[catch {set info $file_states($path)}]} {
 733                set state __
 734                set icon n[incr next_icon_id]
 735        } else {
 736                set state [lindex $info 0]
 737                set icon [lindex $info 1]
 738        }
 739
 740        if {$s0 == {_}} {
 741                set s0 [string index $state 0]
 742        } elseif {$s0 == {*}} {
 743                set s0 _
 744        }
 745
 746        if {$s1 == {_}} {
 747                set s1 [string index $state 1]
 748        } elseif {$s1 == {*}} {
 749                set s1 _
 750        }
 751
 752        set file_states($path) [list $s0$s1 $icon]
 753        return $state
 754}
 755
 756proc display_file {path state} {
 757        global ui_index ui_other file_states status_active
 758
 759        set old_m [merge_state $path $state]
 760        if {$status_active} return
 761
 762        set s $file_states($path)
 763        set new_m [lindex $s 0]
 764        set new_w [mapcol $new_m $path] 
 765        set old_w [mapcol $old_m $path]
 766        set new_icon [mapicon $new_m $path]
 767
 768        if {$new_w != $old_w} {
 769                set lno [bsearch $old_w $path]
 770                if {$lno >= 0} {
 771                        incr lno
 772                        $old_w conf -state normal
 773                        $old_w delete $lno.0 [expr $lno + 1].0
 774                        $old_w conf -state disabled
 775                }
 776
 777                set lno [expr abs([bsearch $new_w $path] + 1) + 1]
 778                $new_w conf -state normal
 779                $new_w image create $lno.0 \
 780                        -align center -padx 5 -pady 1 \
 781                        -name [lindex $s 1] \
 782                        -image [mapicon $m $path]
 783                $new_w insert $lno.1 "$path\n"
 784                $new_w conf -state disabled
 785        } elseif {$new_icon != [mapicon $old_m $path]} {
 786                $new_w conf -state normal
 787                $new_w image conf [lindex $s 1] -image $new_icon
 788                $new_w conf -state disabled
 789        }
 790}
 791
 792proc display_all_files {} {
 793        global ui_index ui_other file_states
 794
 795        $ui_index conf -state normal
 796        $ui_other conf -state normal
 797
 798        foreach path [lsort [array names file_states]] {
 799                set s $file_states($path)
 800                set m [lindex $s 0]
 801                set w [mapcol $m $path]
 802                $w image create end \
 803                        -align center -padx 5 -pady 1 \
 804                        -name [lindex $s 1] \
 805                        -image [mapicon $m $path]
 806                $w insert end "$path\n"
 807        }
 808
 809        $ui_index conf -state disabled
 810        $ui_other conf -state disabled
 811}
 812
 813proc with_update_index {body} {
 814        global update_index_fd
 815
 816        if {$update_index_fd == {}} {
 817                if {![lock_index update]} return
 818                set update_index_fd [open \
 819                        "| git update-index --add --remove -z --stdin" \
 820                        w]
 821                fconfigure $update_index_fd -translation binary
 822                uplevel 1 $body
 823                close $update_index_fd
 824                set update_index_fd {}
 825                unlock_index
 826        } else {
 827                uplevel 1 $body
 828        }
 829}
 830
 831proc update_index {path} {
 832        global update_index_fd
 833
 834        if {$update_index_fd == {}} {
 835                error {not in with_update_index}
 836        } else {
 837                puts -nonewline $update_index_fd "$path\0"
 838        }
 839}
 840
 841proc toggle_mode {path} {
 842        global file_states ui_fname_value
 843
 844        set s $file_states($path)
 845        set m [lindex $s 0]
 846
 847        switch -- $m {
 848        AM -
 849        _O {set new A*}
 850        _M -
 851        MM {set new M*}
 852        AD -
 853        _D {set new D*}
 854        default {return}
 855        }
 856
 857        with_update_index {update_index $path}
 858        display_file $path $new
 859        if {$ui_fname_value == $path} {
 860                show_diff $path
 861        }
 862}
 863
 864######################################################################
 865##
 866## config (fetch push pull)
 867
 868proc load_repo_config {} {
 869        global repo_config
 870        global cfg_trust_mtime
 871
 872        array unset repo_config
 873        catch {
 874                set fd_rc [open "| git repo-config --list" r]
 875                while {[gets $fd_rc line] >= 0} {
 876                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 877                                lappend repo_config($name) $value
 878                        }
 879                }
 880                close $fd_rc
 881        }
 882
 883        if {[catch {set cfg_trust_mtime $repo_config(gui.trustmtime)}]} {
 884                set cfg_trust_mtime false
 885        }
 886}
 887
 888proc save_my_config {} {
 889        global repo_config
 890        global cfg_trust_mtime
 891
 892        if {[catch {set rc_trustMTime $repo_config(gui.trustmtime)}]} {
 893                set rc_trustMTime false
 894        }
 895        if {$cfg_trust_mtime != $rc_trustMTime} {
 896                exec git repo-config gui.trustMTime $cfg_trust_mtime
 897        }
 898}
 899
 900proc load_all_remotes {} {
 901        global gitdir all_remotes repo_config
 902
 903        set all_remotes [list]
 904        set rm_dir [file join $gitdir remotes]
 905        if {[file isdirectory $rm_dir]} {
 906                set all_remotes [concat $all_remotes [glob \
 907                        -types f \
 908                        -tails \
 909                        -nocomplain \
 910                        -directory $rm_dir *]]
 911        }
 912
 913        foreach line [array names repo_config remote.*.url] {
 914                if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
 915                        lappend all_remotes $name
 916                }
 917        }
 918
 919        set all_remotes [lsort -unique $all_remotes]
 920}
 921
 922proc populate_remote_menu {m pfx op} {
 923        global all_remotes mainfont
 924
 925        foreach remote $all_remotes {
 926                $m add command -label "$pfx $remote..." \
 927                        -command [list $op $remote] \
 928                        -font $mainfont
 929        }
 930}
 931
 932proc populate_pull_menu {m} {
 933        global gitdir repo_config all_remotes mainfont
 934
 935        foreach remote $all_remotes {
 936                set rb {}
 937                if {[array get repo_config remote.$remote.url] != {}} {
 938                        if {[array get repo_config remote.$remote.fetch] != {}} {
 939                                regexp {^([^:]+):} \
 940                                        [lindex $repo_config(remote.$remote.fetch) 0] \
 941                                        line rb
 942                        }
 943                } else {
 944                        catch {
 945                                set fd [open [file join $gitdir remotes $remote] r]
 946                                while {[gets $fd line] >= 0} {
 947                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
 948                                                break
 949                                        }
 950                                }
 951                                close $fd
 952                        }
 953                }
 954
 955                set rb_short $rb
 956                regsub ^refs/heads/ $rb {} rb_short
 957                if {$rb_short != {}} {
 958                        $m add command \
 959                                -label "Branch $rb_short from $remote..." \
 960                                -command [list pull_remote $remote $rb] \
 961                                -font $mainfont
 962                }
 963        }
 964}
 965
 966######################################################################
 967##
 968## icons
 969
 970set filemask {
 971#define mask_width 14
 972#define mask_height 15
 973static unsigned char mask_bits[] = {
 974   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 975   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 976   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
 977}
 978
 979image create bitmap file_plain -background white -foreground black -data {
 980#define plain_width 14
 981#define plain_height 15
 982static unsigned char plain_bits[] = {
 983   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
 984   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
 985   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 986} -maskdata $filemask
 987
 988image create bitmap file_mod -background white -foreground blue -data {
 989#define mod_width 14
 990#define mod_height 15
 991static unsigned char mod_bits[] = {
 992   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
 993   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
 994   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
 995} -maskdata $filemask
 996
 997image create bitmap file_fulltick -background white -foreground "#007000" -data {
 998#define file_fulltick_width 14
 999#define file_fulltick_height 15
1000static unsigned char file_fulltick_bits[] = {
1001   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1002   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1003   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1004} -maskdata $filemask
1005
1006image create bitmap file_parttick -background white -foreground "#005050" -data {
1007#define parttick_width 14
1008#define parttick_height 15
1009static unsigned char parttick_bits[] = {
1010   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1011   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1012   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1013} -maskdata $filemask
1014
1015image create bitmap file_question -background white -foreground black -data {
1016#define file_question_width 14
1017#define file_question_height 15
1018static unsigned char file_question_bits[] = {
1019   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1020   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1021   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1022} -maskdata $filemask
1023
1024image create bitmap file_removed -background white -foreground red -data {
1025#define file_removed_width 14
1026#define file_removed_height 15
1027static unsigned char file_removed_bits[] = {
1028   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1029   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1030   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1031} -maskdata $filemask
1032
1033image create bitmap file_merge -background white -foreground blue -data {
1034#define file_merge_width 14
1035#define file_merge_height 15
1036static unsigned char file_merge_bits[] = {
1037   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1038   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1039   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1040} -maskdata $filemask
1041
1042set ui_index .vpane.files.index.list
1043set ui_other .vpane.files.other.list
1044set max_status_desc 0
1045foreach i {
1046                {__ i plain    "Unmodified"}
1047                {_M i mod      "Modified"}
1048                {M_ i fulltick "Checked in"}
1049                {MM i parttick "Partially checked in"}
1050
1051                {_O o plain    "Untracked"}
1052                {A_ o fulltick "Added"}
1053                {AM o parttick "Partially added"}
1054                {AD o question "Added (but now gone)"}
1055
1056                {_D i question "Missing"}
1057                {D_ i removed  "Removed"}
1058                {DD i removed  "Removed"}
1059                {DO i removed  "Removed (still exists)"}
1060
1061                {UM i merge    "Merge conflicts"}
1062                {U_ i merge    "Merge conflicts"}
1063        } {
1064        if {$max_status_desc < [string length [lindex $i 3]]} {
1065                set max_status_desc [string length [lindex $i 3]]
1066        }
1067        if {[lindex $i 1] == {i}} {
1068                set all_cols([lindex $i 0]) $ui_index
1069        } else {
1070                set all_cols([lindex $i 0]) $ui_other
1071        }
1072        set all_icons([lindex $i 0]) file_[lindex $i 2]
1073        set all_descs([lindex $i 0]) [lindex $i 3]
1074}
1075unset filemask i
1076
1077######################################################################
1078##
1079## util
1080
1081proc error_popup {msg} {
1082        set w .error
1083        toplevel $w
1084        wm transient $w .
1085        show_msg $w $w $msg
1086}
1087
1088proc show_msg {w top msg} {
1089        global gitdir appname mainfont
1090
1091        message $w.m -text $msg -justify left -aspect 400
1092        pack $w.m -side top -fill x -padx 5 -pady 10
1093        button $w.ok -text OK \
1094                -width 15 \
1095                -font $mainfont \
1096                -command "destroy $top"
1097        pack $w.ok -side bottom
1098        bind $top <Visibility> "grab $top; focus $top"
1099        bind $top <Key-Return> "destroy $top"
1100        wm title $w "$appname ([lindex [file split \
1101                [file normalize [file dirname $gitdir]]] \
1102                end]): error"
1103        tkwait window $top
1104}
1105
1106proc hook_failed_popup {hook msg} {
1107        global gitdir mainfont difffont appname
1108
1109        set w .hookfail
1110        toplevel $w
1111        wm transient $w .
1112
1113        frame $w.m
1114        label $w.m.l1 -text "$hook hook failed:" \
1115                -anchor w \
1116                -justify left \
1117                -font [concat $mainfont bold]
1118        text $w.m.t \
1119                -background white -borderwidth 1 \
1120                -relief sunken \
1121                -width 80 -height 10 \
1122                -font $difffont \
1123                -yscrollcommand [list $w.m.sby set]
1124        label $w.m.l2 \
1125                -text {You must correct the above errors before committing.} \
1126                -anchor w \
1127                -justify left \
1128                -font [concat $mainfont bold]
1129        scrollbar $w.m.sby -command [list $w.m.t yview]
1130        pack $w.m.l1 -side top -fill x
1131        pack $w.m.l2 -side bottom -fill x
1132        pack $w.m.sby -side right -fill y
1133        pack $w.m.t -side left -fill both -expand 1
1134        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1135
1136        $w.m.t insert 1.0 $msg
1137        $w.m.t conf -state disabled
1138
1139        button $w.ok -text OK \
1140                -width 15 \
1141                -font $mainfont \
1142                -command "destroy $w"
1143        pack $w.ok -side bottom
1144
1145        bind $w <Visibility> "grab $w; focus $w"
1146        bind $w <Key-Return> "destroy $w"
1147        wm title $w "$appname ([lindex [file split \
1148                [file normalize [file dirname $gitdir]]] \
1149                end]): error"
1150        tkwait window $w
1151}
1152
1153set next_console_id 0
1154
1155proc new_console {short_title long_title} {
1156        global next_console_id console_data
1157        set w .console[incr next_console_id]
1158        set console_data($w) [list $short_title $long_title]
1159        return [console_init $w]
1160}
1161
1162proc console_init {w} {
1163        global console_cr console_data
1164        global gitdir appname mainfont difffont
1165
1166        set console_cr($w) 1.0
1167        toplevel $w
1168        frame $w.m
1169        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1170                -anchor w \
1171                -justify left \
1172                -font [concat $mainfont bold]
1173        text $w.m.t \
1174                -background white -borderwidth 1 \
1175                -relief sunken \
1176                -width 80 -height 10 \
1177                -font $difffont \
1178                -state disabled \
1179                -yscrollcommand [list $w.m.sby set]
1180        label $w.m.s -anchor w \
1181                -justify left \
1182                -font [concat $mainfont bold]
1183        scrollbar $w.m.sby -command [list $w.m.t yview]
1184        pack $w.m.l1 -side top -fill x
1185        pack $w.m.s -side bottom -fill x
1186        pack $w.m.sby -side right -fill y
1187        pack $w.m.t -side left -fill both -expand 1
1188        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1189
1190        button $w.ok -text {Running...} \
1191                -width 15 \
1192                -font $mainfont \
1193                -state disabled \
1194                -command "destroy $w"
1195        pack $w.ok -side bottom
1196
1197        bind $w <Visibility> "focus $w"
1198        wm title $w "$appname ([lindex [file split \
1199                [file normalize [file dirname $gitdir]]] \
1200                end]): [lindex $console_data($w) 0]"
1201        return $w
1202}
1203
1204proc console_exec {w cmd {after {}}} {
1205        global tcl_platform
1206
1207        # -- Windows tosses the enviroment when we exec our child.
1208        #    But most users need that so we have to relogin. :-(
1209        #
1210        if {$tcl_platform(platform) == {windows}} {
1211                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1212        }
1213
1214        # -- Tcl won't let us redirect both stdout and stderr to
1215        #    the same pipe.  So pass it through cat...
1216        #
1217        set cmd [concat | $cmd |& cat]
1218
1219        set fd_f [open $cmd r]
1220        fconfigure $fd_f -blocking 0 -translation binary
1221        fileevent $fd_f readable [list console_read $w $fd_f $after]
1222}
1223
1224proc console_read {w fd after} {
1225        global console_cr console_data
1226
1227        set buf [read $fd]
1228        if {$buf != {}} {
1229                if {![winfo exists $w]} {console_init $w}
1230                $w.m.t conf -state normal
1231                set c 0
1232                set n [string length $buf]
1233                while {$c < $n} {
1234                        set cr [string first "\r" $buf $c]
1235                        set lf [string first "\n" $buf $c]
1236                        if {$cr < 0} {set cr [expr $n + 1]}
1237                        if {$lf < 0} {set lf [expr $n + 1]}
1238
1239                        if {$lf < $cr} {
1240                                $w.m.t insert end [string range $buf $c $lf]
1241                                set console_cr($w) [$w.m.t index {end -1c}]
1242                                set c $lf
1243                                incr c
1244                        } else {
1245                                $w.m.t delete $console_cr($w) end
1246                                $w.m.t insert end "\n"
1247                                $w.m.t insert end [string range $buf $c $cr]
1248                                set c $cr
1249                                incr c
1250                        }
1251                }
1252                $w.m.t conf -state disabled
1253                $w.m.t see end
1254        }
1255
1256        fconfigure $fd -blocking 1
1257        if {[eof $fd]} {
1258                if {[catch {close $fd}]} {
1259                        if {![winfo exists $w]} {console_init $w}
1260                        $w.m.s conf -background red -text {Error: Command Failed}
1261                        $w.ok conf -text Close
1262                        $w.ok conf -state normal
1263                        set ok 0
1264                } elseif {[winfo exists $w]} {
1265                        $w.m.s conf -background green -text {Success}
1266                        $w.ok conf -text Close
1267                        $w.ok conf -state normal
1268                        set ok 1
1269                }
1270                array unset console_cr $w
1271                array unset console_data $w
1272                if {$after != {}} {
1273                        uplevel #0 $after $ok
1274                }
1275                return
1276        }
1277        fconfigure $fd -blocking 0
1278}
1279
1280######################################################################
1281##
1282## ui commands
1283
1284set starting_gitk_msg {Please wait... Starting gitk...}
1285
1286proc do_gitk {} {
1287        global tcl_platform ui_status_value starting_gitk_msg
1288
1289        set ui_status_value $starting_gitk_msg
1290        after 10000 {
1291                if {$ui_status_value == $starting_gitk_msg} {
1292                        set ui_status_value {Ready.}
1293                }
1294        }
1295
1296        if {$tcl_platform(platform) == {windows}} {
1297                exec sh -c gitk &
1298        } else {
1299                exec gitk &
1300        }
1301}
1302
1303proc do_repack {} {
1304        set w [new_console "repack" "Repacking the object database"]
1305        set cmd [list git repack]
1306        lappend cmd -a
1307        lappend cmd -d
1308        console_exec $w $cmd
1309}
1310
1311proc do_quit {} {
1312        global gitdir ui_comm
1313
1314        set save [file join $gitdir GITGUI_MSG]
1315        set msg [string trim [$ui_comm get 0.0 end]]
1316        if {[$ui_comm edit modified] && $msg != {}} {
1317                catch {
1318                        set fd [open $save w]
1319                        puts $fd [string trim [$ui_comm get 0.0 end]]
1320                        close $fd
1321                }
1322        } elseif {$msg == {} && [file exists $save]} {
1323                file delete $save
1324        }
1325
1326        save_my_config
1327        destroy .
1328}
1329
1330proc do_rescan {} {
1331        update_status
1332}
1333
1334proc do_checkin_all {} {
1335        global checkin_active ui_status_value
1336
1337        if {$checkin_active || ![lock_index begin-update]} return
1338
1339        set checkin_active 1
1340        set ui_status_value {Checking in all files...}
1341        after 1 {
1342                with_update_index {
1343                        foreach path [array names file_states] {
1344                                set s $file_states($path)
1345                                set m [lindex $s 0]
1346                                switch -- $m {
1347                                AM -
1348                                MM -
1349                                _M -
1350                                _D {toggle_mode $path}
1351                                }
1352                        }
1353                }
1354                set checkin_active 0
1355                set ui_status_value {Ready.}
1356        }
1357}
1358
1359proc do_signoff {} {
1360        global ui_comm
1361
1362        catch {
1363                set me [exec git var GIT_COMMITTER_IDENT]
1364                if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
1365                        set str "Signed-off-by: $name"
1366                        if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1367                                $ui_comm insert end "\n"
1368                                $ui_comm insert end $str
1369                                $ui_comm see end
1370                        }
1371                }
1372        }
1373}
1374
1375proc do_amend_last {} {
1376        load_last_commit
1377}
1378
1379proc do_commit {} {
1380        commit_tree
1381}
1382
1383# shift == 1: left click
1384#          3: right click  
1385proc click {w x y shift wx wy} {
1386        global ui_index ui_other
1387
1388        set pos [split [$w index @$x,$y] .]
1389        set lno [lindex $pos 0]
1390        set col [lindex $pos 1]
1391        set path [$w get $lno.1 $lno.end]
1392        if {$path == {}} return
1393
1394        if {$col > 0 && $shift == 1} {
1395                $ui_index tag remove in_diff 0.0 end
1396                $ui_other tag remove in_diff 0.0 end
1397                $w tag add in_diff $lno.0 [expr $lno + 1].0
1398                show_diff $path
1399        }
1400}
1401
1402proc unclick {w x y} {
1403        set pos [split [$w index @$x,$y] .]
1404        set lno [lindex $pos 0]
1405        set col [lindex $pos 1]
1406        set path [$w get $lno.1 $lno.end]
1407        if {$path == {}} return
1408
1409        if {$col == 0} {
1410                toggle_mode $path
1411        }
1412}
1413
1414######################################################################
1415##
1416## ui init
1417
1418set mainfont {Helvetica 10}
1419set difffont {Courier 10}
1420set maincursor [. cget -cursor]
1421
1422switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1423windows,*   {set M1B Control; set M1T Ctrl}
1424unix,Darwin {set M1B M1; set M1T Cmd}
1425default     {set M1B M1; set M1T M1}
1426}
1427
1428# -- Menu Bar
1429menu .mbar -tearoff 0
1430.mbar add cascade -label Project -menu .mbar.project
1431.mbar add cascade -label Commit -menu .mbar.commit
1432.mbar add cascade -label Fetch -menu .mbar.fetch
1433.mbar add cascade -label Pull -menu .mbar.pull
1434.mbar add cascade -label Push -menu .mbar.push
1435.mbar add cascade -label Options -menu .mbar.options
1436. configure -menu .mbar
1437
1438# -- Project Menu
1439menu .mbar.project
1440.mbar.project add command -label Visualize \
1441        -command do_gitk \
1442        -font $mainfont
1443.mbar.project add command -label {Repack Database} \
1444        -command do_repack \
1445        -font $mainfont
1446.mbar.project add command -label Quit \
1447        -command do_quit \
1448        -accelerator $M1T-Q \
1449        -font $mainfont
1450
1451# -- Commit Menu
1452menu .mbar.commit
1453.mbar.commit add command -label Rescan \
1454        -command do_rescan \
1455        -accelerator F5 \
1456        -font $mainfont
1457lappend disable_on_lock \
1458        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1459.mbar.commit add command -label {Amend Last Commit} \
1460        -command do_amend_last \
1461        -font $mainfont
1462lappend disable_on_lock \
1463        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1464.mbar.commit add command -label {Check-in All Files} \
1465        -command do_checkin_all \
1466        -accelerator $M1T-U \
1467        -font $mainfont
1468lappend disable_on_lock \
1469        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1470.mbar.commit add command -label {Sign Off} \
1471        -command do_signoff \
1472        -accelerator $M1T-S \
1473        -font $mainfont
1474.mbar.commit add command -label Commit \
1475        -command do_commit \
1476        -accelerator $M1T-Return \
1477        -font $mainfont
1478lappend disable_on_lock \
1479        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1480
1481# -- Fetch Menu
1482menu .mbar.fetch
1483
1484# -- Pull Menu
1485menu .mbar.pull
1486
1487# -- Push Menu
1488menu .mbar.push
1489
1490# -- Options Menu
1491menu .mbar.options
1492.mbar.options add checkbutton -label {Trust File Modification Timestamp} \
1493        -offvalue false \
1494        -onvalue true \
1495        -variable cfg_trust_mtime
1496
1497# -- Main Window Layout
1498panedwindow .vpane -orient vertical
1499panedwindow .vpane.files -orient horizontal
1500.vpane add .vpane.files -sticky nsew -height 100 -width 400
1501pack .vpane -anchor n -side top -fill both -expand 1
1502
1503# -- Index File List
1504frame .vpane.files.index -height 100 -width 400
1505label .vpane.files.index.title -text {Modified Files} \
1506        -background green \
1507        -font $mainfont
1508text $ui_index -background white -borderwidth 0 \
1509        -width 40 -height 10 \
1510        -font $mainfont \
1511        -yscrollcommand {.vpane.files.index.sb set} \
1512        -cursor $maincursor \
1513        -state disabled
1514scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1515pack .vpane.files.index.title -side top -fill x
1516pack .vpane.files.index.sb -side right -fill y
1517pack $ui_index -side left -fill both -expand 1
1518.vpane.files add .vpane.files.index -sticky nsew
1519
1520# -- Other (Add) File List
1521frame .vpane.files.other -height 100 -width 100
1522label .vpane.files.other.title -text {Untracked Files} \
1523        -background red \
1524        -font $mainfont
1525text $ui_other -background white -borderwidth 0 \
1526        -width 40 -height 10 \
1527        -font $mainfont \
1528        -yscrollcommand {.vpane.files.other.sb set} \
1529        -cursor $maincursor \
1530        -state disabled
1531scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1532pack .vpane.files.other.title -side top -fill x
1533pack .vpane.files.other.sb -side right -fill y
1534pack $ui_other -side left -fill both -expand 1
1535.vpane.files add .vpane.files.other -sticky nsew
1536
1537$ui_index tag conf in_diff -font [concat $mainfont bold]
1538$ui_other tag conf in_diff -font [concat $mainfont bold]
1539
1540# -- Diff and Commit Area
1541frame .vpane.lower -height 400 -width 400
1542frame .vpane.lower.commarea
1543frame .vpane.lower.diff -relief sunken -borderwidth 1
1544pack .vpane.lower.commarea -side top -fill x
1545pack .vpane.lower.diff -side bottom -fill both -expand 1
1546.vpane add .vpane.lower -stick nsew
1547
1548# -- Commit Area Buttons
1549frame .vpane.lower.commarea.buttons
1550label .vpane.lower.commarea.buttons.l -text {} \
1551        -anchor w \
1552        -justify left \
1553        -font $mainfont
1554pack .vpane.lower.commarea.buttons.l -side top -fill x
1555pack .vpane.lower.commarea.buttons -side left -fill y
1556
1557button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1558        -command do_rescan \
1559        -font $mainfont
1560pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1561lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
1562
1563button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1564        -command do_amend_last \
1565        -font $mainfont
1566pack .vpane.lower.commarea.buttons.amend -side top -fill x
1567lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
1568
1569button .vpane.lower.commarea.buttons.ciall -text {Check-in All} \
1570        -command do_checkin_all \
1571        -font $mainfont
1572pack .vpane.lower.commarea.buttons.ciall -side top -fill x
1573lappend disable_on_lock {.vpane.lower.commarea.buttons.ciall conf -state}
1574
1575button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1576        -command do_signoff \
1577        -font $mainfont
1578pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1579
1580button .vpane.lower.commarea.buttons.commit -text {Commit} \
1581        -command do_commit \
1582        -font $mainfont
1583pack .vpane.lower.commarea.buttons.commit -side top -fill x
1584lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
1585
1586# -- Commit Message Buffer
1587frame .vpane.lower.commarea.buffer
1588set ui_comm .vpane.lower.commarea.buffer.t
1589set ui_coml .vpane.lower.commarea.buffer.l
1590label $ui_coml -text {Commit Message:} \
1591        -anchor w \
1592        -justify left \
1593        -font $mainfont
1594trace add variable commit_type write {uplevel #0 {
1595        switch -glob $commit_type \
1596        initial {$ui_coml conf -text {Initial Commit Message:}} \
1597        amend   {$ui_coml conf -text {Amended Commit Message:}} \
1598        merge   {$ui_coml conf -text {Merge Commit Message:}} \
1599        *       {$ui_coml conf -text {Commit Message:}}
1600}}
1601text $ui_comm -background white -borderwidth 1 \
1602        -relief sunken \
1603        -width 75 -height 9 -wrap none \
1604        -font $difffont \
1605        -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1606        -cursor $maincursor
1607scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
1608pack $ui_coml -side top -fill x
1609pack .vpane.lower.commarea.buffer.sby -side right -fill y
1610pack $ui_comm -side left -fill y
1611pack .vpane.lower.commarea.buffer -side left -fill y
1612
1613# -- Diff Header
1614set ui_fname_value {}
1615set ui_fstatus_value {}
1616frame .vpane.lower.diff.header -background orange
1617label .vpane.lower.diff.header.l1 -text {File:} \
1618        -background orange \
1619        -font $mainfont
1620label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1621        -background orange \
1622        -anchor w \
1623        -justify left \
1624        -font $mainfont
1625label .vpane.lower.diff.header.l3 -text {Status:} \
1626        -background orange \
1627        -font $mainfont
1628label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1629        -background orange \
1630        -width $max_status_desc \
1631        -anchor w \
1632        -justify left \
1633        -font $mainfont
1634pack .vpane.lower.diff.header.l1 -side left
1635pack .vpane.lower.diff.header.l2 -side left -fill x
1636pack .vpane.lower.diff.header.l4 -side right
1637pack .vpane.lower.diff.header.l3 -side right
1638
1639# -- Diff Body
1640frame .vpane.lower.diff.body
1641set ui_diff .vpane.lower.diff.body.t
1642text $ui_diff -background white -borderwidth 0 \
1643        -width 80 -height 15 -wrap none \
1644        -font $difffont \
1645        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1646        -yscrollcommand {.vpane.lower.diff.body.sby set} \
1647        -cursor $maincursor \
1648        -state disabled
1649scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1650        -command [list $ui_diff xview]
1651scrollbar .vpane.lower.diff.body.sby -orient vertical \
1652        -command [list $ui_diff yview]
1653pack .vpane.lower.diff.body.sbx -side bottom -fill x
1654pack .vpane.lower.diff.body.sby -side right -fill y
1655pack $ui_diff -side left -fill both -expand 1
1656pack .vpane.lower.diff.header -side top -fill x
1657pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1658
1659$ui_diff tag conf dm -foreground red
1660$ui_diff tag conf dp -foreground blue
1661$ui_diff tag conf da -font [concat $difffont bold]
1662$ui_diff tag conf di -foreground "#00a000"
1663$ui_diff tag conf dni -foreground "#a000a0"
1664$ui_diff tag conf bold -font [concat $difffont bold]
1665
1666# -- Status Bar
1667set ui_status_value {Initializing...}
1668label .status -textvariable ui_status_value \
1669        -anchor w \
1670        -justify left \
1671        -borderwidth 1 \
1672        -relief sunken \
1673        -font $mainfont
1674pack .status -anchor w -side bottom -fill x
1675
1676# -- Key Bindings
1677bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1678bind .   <Destroy> do_quit
1679bind all <Key-F5> do_rescan
1680bind all <$M1B-Key-r> do_rescan
1681bind all <$M1B-Key-R> do_rescan
1682bind .   <$M1B-Key-s> do_signoff
1683bind .   <$M1B-Key-S> do_signoff
1684bind .   <$M1B-Key-u> do_checkin_all
1685bind .   <$M1B-Key-U> do_checkin_all
1686bind .   <$M1B-Key-Return> do_commit
1687bind all <$M1B-Key-q> do_quit
1688bind all <$M1B-Key-Q> do_quit
1689bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1690bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1691foreach i [list $ui_index $ui_other] {
1692        bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1693        bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1694        bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1695}
1696unset i M1B M1T
1697
1698######################################################################
1699##
1700## main
1701
1702set appname [lindex [file split $argv0] end]
1703set gitdir {}
1704
1705if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
1706        show_msg {} . "Cannot find the git directory: $err"
1707        exit 1
1708}
1709if {$cdup != ""} {
1710        cd $cdup
1711}
1712unset cdup
1713
1714if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1715        show_msg {} . "Cannot find the git directory: $err"
1716        exit 1
1717}
1718
1719if {$appname == {git-citool}} {
1720        set single_commit 1
1721}
1722
1723wm title . "$appname ([file normalize [file dirname $gitdir]])"
1724focus -force $ui_comm
1725load_repo_config
1726load_all_remotes
1727populate_remote_menu .mbar.fetch From fetch_from
1728populate_remote_menu .mbar.push To push_to
1729populate_pull_menu .mbar.pull
1730update_status