git-gui

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec 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
  14 set single_commit 0
  15 set status_active 0
  16 set diff_active 0
  17 set checkin_active 0
  18 set commit_active 0
  19 set update_index_fd {}
  20
  21 set disable_on_lock [list]
  22 set index_lock_type none
  23
  24 set HEAD {}
  25 set PARENT {}
  26 set commit_type {}
  27
  28 proc 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
  44 proc 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
  57 proc 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
  70 proc 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
 115 proc 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
 152 proc 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
 169 proc 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
 198 proc 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
 227 proc 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
 239 proc 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
 267 proc 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
 277 proc 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
 333 proc 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
 388 proc 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
 433 proc 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
 449 Its highly likely that another Git program modified the
 450 repository since our last scan.  A rescan is required
 451 before 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
 471 File $path has merge conflicts.
 472 You 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
 480 File $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
 488 You 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
 500 A 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
 536 proc 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
 636 proc 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
 644 proc 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
 654 proc 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
 663 proc 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
 675 proc 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
 685 proc 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
 695 proc 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
 705 proc 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
 726 set next_icon_id 0
 727
 728 proc 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
 758 proc 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
 794 proc 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
 815 proc 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
 833 proc 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
 843 proc 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
 870 proc 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
 890 proc 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
 902 proc 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
 924 proc 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
 934 proc 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
 974 set filemask {
 975 #define mask_width 14
 976 #define mask_height 15
 977 static 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
 983 image create bitmap file_plain -background white -foreground black -data {
 984 #define plain_width 14
 985 #define plain_height 15
 986 static 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
 992 image create bitmap file_mod -background white -foreground blue -data {
 993 #define mod_width 14
 994 #define mod_height 15
 995 static 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
1001 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1002 #define file_fulltick_width 14
1003 #define file_fulltick_height 15
1004 static 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
1010 image create bitmap file_parttick -background white -foreground "#005050" -data {
1011 #define parttick_width 14
1012 #define parttick_height 15
1013 static 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
1019 image create bitmap file_question -background white -foreground black -data {
1020 #define file_question_width 14
1021 #define file_question_height 15
1022 static 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
1028 image create bitmap file_removed -background white -foreground red -data {
1029 #define file_removed_width 14
1030 #define file_removed_height 15
1031 static 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
1037 image create bitmap file_merge -background white -foreground blue -data {
1038 #define file_merge_width 14
1039 #define file_merge_height 15
1040 static 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
1046 set ui_index .vpane.files.index.list
1047 set ui_other .vpane.files.other.list
1048 set max_status_desc 0
1049 foreach 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 }
1079 unset filemask i
1080
1081 ######################################################################
1082 ##
1083 ## util
1084
1085 proc error_popup {msg} {
1086         set w .error
1087         toplevel $w
1088         wm transient $w .
1089         show_msg $w $w $msg
1090 }
1091
1092 proc 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
1110 proc 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
1157 set next_console_id 0
1158
1159 proc 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
1166 proc 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
1208 proc 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
1228 proc 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
1288 set starting_gitk_msg {Please wait... Starting gitk...}
1289
1290 proc 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
1307 proc 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
1315 proc 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
1334 proc do_rescan {} {
1335         update_status
1336 }
1337
1338 proc 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
1363 proc 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
1379 proc do_amend_last {} {
1380         load_last_commit
1381 }
1382
1383 proc do_commit {} {
1384         commit_tree
1385 }
1386
1387 # shift == 1: left click
1388 #          3: right click
1389 proc 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
1406 proc 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
1422 set mainfont {Helvetica 10}
1423 set difffont {Courier 10}
1424 set maincursor [. cget -cursor]
1425
1426 switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1427 windows,*   {set M1B Control; set M1T Ctrl}
1428 unix,Darwin {set M1B M1; set M1T Cmd}
1429 default     {set M1B M1; set M1T M1}
1430 }
1431
1432 # -- Menu Bar
1433 menu .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
1443 menu .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
1456 menu .mbar.commit
1457 .mbar.commit add command -label Rescan \
1458         -command do_rescan \
1459         -accelerator F5 \
1460         -font $mainfont
1461 lappend 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
1466 lappend 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
1472 lappend 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
1482 lappend disable_on_lock \
1483         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1484
1485 # -- Fetch Menu
1486 menu .mbar.fetch
1487
1488 # -- Pull Menu
1489 menu .mbar.pull
1490
1491 # -- Push Menu
1492 menu .mbar.push
1493
1494 # -- Options Menu
1495 menu .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
1502 panedwindow .vpane -orient vertical
1503 panedwindow .vpane.files -orient horizontal
1504 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1505 pack .vpane -anchor n -side top -fill both -expand 1
1506
1507 # -- Index File List
1508 frame .vpane.files.index -height 100 -width 400
1509 label .vpane.files.index.title -text {Modified Files} \
1510         -background green \
1511         -font $mainfont
1512 text $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
1518 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1519 pack .vpane.files.index.title -side top -fill x
1520 pack .vpane.files.index.sb -side right -fill y
1521 pack $ui_index -side left -fill both -expand 1
1522 .vpane.files add .vpane.files.index -sticky nsew
1523
1524 # -- Other (Add) File List
1525 frame .vpane.files.other -height 100 -width 100
1526 label .vpane.files.other.title -text {Untracked Files} \
1527         -background red \
1528         -font $mainfont
1529 text $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
1535 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1536 pack .vpane.files.other.title -side top -fill x
1537 pack .vpane.files.other.sb -side right -fill y
1538 pack $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
1545 frame .vpane.lower -height 400 -width 400
1546 frame .vpane.lower.commarea
1547 frame .vpane.lower.diff -relief sunken -borderwidth 1
1548 pack .vpane.lower.commarea -side top -fill x
1549 pack .vpane.lower.diff -side bottom -fill both -expand 1
1550 .vpane add .vpane.lower -stick nsew
1551
1552 # -- Commit Area Buttons
1553 frame .vpane.lower.commarea.buttons
1554 label .vpane.lower.commarea.buttons.l -text {} \
1555         -anchor w \
1556         -justify left \
1557         -font $mainfont
1558 pack .vpane.lower.commarea.buttons.l -side top -fill x
1559 pack .vpane.lower.commarea.buttons -side left -fill y
1560
1561 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1562         -command do_rescan \
1563         -font $mainfont
1564 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1565 lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
1566
1567 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1568         -command do_amend_last \
1569         -font $mainfont
1570 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1571 lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
1572
1573 button .vpane.lower.commarea.buttons.ciall -text {Check-in All} \
1574         -command do_checkin_all \
1575         -font $mainfont
1576 pack .vpane.lower.commarea.buttons.ciall -side top -fill x
1577 lappend disable_on_lock {.vpane.lower.commarea.buttons.ciall conf -state}
1578
1579 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1580         -command do_signoff \
1581         -font $mainfont
1582 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1583
1584 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1585         -command do_commit \
1586         -font $mainfont
1587 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1588 lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
1589
1590 # -- Commit Message Buffer
1591 frame .vpane.lower.commarea.buffer
1592 set ui_comm .vpane.lower.commarea.buffer.t
1593 set ui_coml .vpane.lower.commarea.buffer.l
1594 label $ui_coml -text {Commit Message:} \
1595         -anchor w \
1596         -justify left \
1597         -font $mainfont
1598 trace 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 }}
1605 text $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
1611 scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
1612 pack $ui_coml -side top -fill x
1613 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1614 pack $ui_comm -side left -fill y
1615 pack .vpane.lower.commarea.buffer -side left -fill y
1616
1617 # -- Diff Header
1618 set ui_fname_value {}
1619 set ui_fstatus_value {}
1620 frame .vpane.lower.diff.header -background orange
1621 label .vpane.lower.diff.header.l1 -text {File:} \
1622         -background orange \
1623         -font $mainfont
1624 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1625         -background orange \
1626         -anchor w \
1627         -justify left \
1628         -font $mainfont
1629 label .vpane.lower.diff.header.l3 -text {Status:} \
1630         -background orange \
1631         -font $mainfont
1632 label .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
1638 pack .vpane.lower.diff.header.l1 -side left
1639 pack .vpane.lower.diff.header.l2 -side left -fill x
1640 pack .vpane.lower.diff.header.l4 -side right
1641 pack .vpane.lower.diff.header.l3 -side right
1642
1643 # -- Diff Body
1644 frame .vpane.lower.diff.body
1645 set ui_diff .vpane.lower.diff.body.t
1646 text $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
1653 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1654         -command [list $ui_diff xview]
1655 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1656         -command [list $ui_diff yview]
1657 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1658 pack .vpane.lower.diff.body.sby -side right -fill y
1659 pack $ui_diff -side left -fill both -expand 1
1660 pack .vpane.lower.diff.header -side top -fill x
1661 pack .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
1671 set ui_status_value {Initializing...}
1672 label .status -textvariable ui_status_value \
1673         -anchor w \
1674         -justify left \
1675         -borderwidth 1 \
1676         -relief sunken \
1677         -font $mainfont
1678 pack .status -anchor w -side bottom -fill x
1679
1680 # -- Key Bindings
1681 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1682 bind .   <Destroy> do_quit
1683 bind all <Key-F5> do_rescan
1684 bind all <$M1B-Key-r> do_rescan
1685 bind all <$M1B-Key-R> do_rescan
1686 bind .   <$M1B-Key-s> do_signoff
1687 bind .   <$M1B-Key-S> do_signoff
1688 bind .   <$M1B-Key-u> do_checkin_all
1689 bind .   <$M1B-Key-U> do_checkin_all
1690 bind .   <$M1B-Key-Return> do_commit
1691 bind all <$M1B-Key-q> do_quit
1692 bind all <$M1B-Key-Q> do_quit
1693 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1694 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1695 foreach 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 }
1700 unset i M1B M1T
1701
1702 ######################################################################
1703 ##
1704 ## main
1705
1706 set appname [lindex [file split $argv0] end]
1707 set gitdir {}
1708
1709 if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
1710         show_msg {} . "Cannot find the git directory: $err"
1711         exit 1
1712 }
1713 if {$cdup != ""} {
1714         cd $cdup
1715 }
1716 unset cdup
1717
1718 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1719         show_msg {} . "Cannot find the git directory: $err"
1720         exit 1
1721 }
1722
1723 if {$appname == {git-citool}} {
1724         set single_commit 1
1725 }
1726
1727 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1728 focus -force $ui_comm
1729 load_repo_config
1730 load_all_remotes
1731 populate_remote_menu .mbar.fetch From fetch_from
1732 populate_remote_menu .mbar.push To push_to
1733 populate_pull_menu .mbar.pull
1734 update_status