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
 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                 }
 965         }
 966 }
 967
 968 ######################################################################
 969 ##
 970 ## icons
 971
 972 set filemask {
 973 #define mask_width 14
 974 #define mask_height 15
 975 static unsigned char mask_bits[] = {
 976    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 977    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 978    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
 979 }
 980
 981 image create bitmap file_plain -background white -foreground black -data {
 982 #define plain_width 14
 983 #define plain_height 15
 984 static unsigned char plain_bits[] = {
 985    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
 986    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
 987    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 988 } -maskdata $filemask
 989
 990 image create bitmap file_mod -background white -foreground blue -data {
 991 #define mod_width 14
 992 #define mod_height 15
 993 static unsigned char mod_bits[] = {
 994    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
 995    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
 996    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
 997 } -maskdata $filemask
 998
 999 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1000 #define file_fulltick_width 14
1001 #define file_fulltick_height 15
1002 static unsigned char file_fulltick_bits[] = {
1003    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1004    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1005    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1006 } -maskdata $filemask
1007
1008 image create bitmap file_parttick -background white -foreground "#005050" -data {
1009 #define parttick_width 14
1010 #define parttick_height 15
1011 static unsigned char parttick_bits[] = {
1012    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1013    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1014    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1015 } -maskdata $filemask
1016
1017 image create bitmap file_question -background white -foreground black -data {
1018 #define file_question_width 14
1019 #define file_question_height 15
1020 static unsigned char file_question_bits[] = {
1021    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1022    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1023    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1024 } -maskdata $filemask
1025
1026 image create bitmap file_removed -background white -foreground red -data {
1027 #define file_removed_width 14
1028 #define file_removed_height 15
1029 static unsigned char file_removed_bits[] = {
1030    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1031    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1032    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1033 } -maskdata $filemask
1034
1035 image create bitmap file_merge -background white -foreground blue -data {
1036 #define file_merge_width 14
1037 #define file_merge_height 15
1038 static unsigned char file_merge_bits[] = {
1039    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1040    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1041    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1042 } -maskdata $filemask
1043
1044 set ui_index .vpane.files.index.list
1045 set ui_other .vpane.files.other.list
1046 set max_status_desc 0
1047 foreach i {
1048                 {__ i plain    "Unmodified"}
1049                 {_M i mod      "Modified"}
1050                 {M_ i fulltick "Checked in"}
1051                 {MM i parttick "Partially checked in"}
1052
1053                 {_O o plain    "Untracked"}
1054                 {A_ o fulltick "Added"}
1055                 {AM o parttick "Partially added"}
1056                 {AD o question "Added (but now gone)"}
1057
1058                 {_D i question "Missing"}
1059                 {D_ i removed  "Removed"}
1060                 {DD i removed  "Removed"}
1061                 {DO i removed  "Removed (still exists)"}
1062
1063                 {UM i merge    "Merge conflicts"}
1064                 {U_ i merge    "Merge conflicts"}
1065         } {
1066         if {$max_status_desc < [string length [lindex $i 3]]} {
1067                 set max_status_desc [string length [lindex $i 3]]
1068         }
1069         if {[lindex $i 1] == {i}} {
1070                 set all_cols([lindex $i 0]) $ui_index
1071         } else {
1072                 set all_cols([lindex $i 0]) $ui_other
1073         }
1074         set all_icons([lindex $i 0]) file_[lindex $i 2]
1075         set all_descs([lindex $i 0]) [lindex $i 3]
1076 }
1077 unset filemask i
1078
1079 ######################################################################
1080 ##
1081 ## util
1082
1083 proc error_popup {msg} {
1084         set w .error
1085         toplevel $w
1086         wm transient $w .
1087         show_msg $w $w $msg
1088 }
1089
1090 proc show_msg {w top msg} {
1091         global gitdir appname mainfont
1092
1093         message $w.m -text $msg -justify left -aspect 400
1094         pack $w.m -side top -fill x -padx 5 -pady 10
1095         button $w.ok -text OK \
1096                 -width 15 \
1097                 -font $mainfont \
1098                 -command "destroy $top"
1099         pack $w.ok -side bottom
1100         bind $top <Visibility> "grab $top; focus $top"
1101         bind $top <Key-Return> "destroy $top"
1102         wm title $w "$appname ([lindex [file split \
1103                 [file normalize [file dirname $gitdir]]] \
1104                 end]): error"
1105         tkwait window $top
1106 }
1107
1108 proc hook_failed_popup {hook msg} {
1109         global gitdir mainfont difffont appname
1110
1111         set w .hookfail
1112         toplevel $w
1113         wm transient $w .
1114
1115         frame $w.m
1116         label $w.m.l1 -text "$hook hook failed:" \
1117                 -anchor w \
1118                 -justify left \
1119                 -font [concat $mainfont bold]
1120         text $w.m.t \
1121                 -background white -borderwidth 1 \
1122                 -relief sunken \
1123                 -width 80 -height 10 \
1124                 -font $difffont \
1125                 -yscrollcommand [list $w.m.sby set]
1126         label $w.m.l2 \
1127                 -text {You must correct the above errors before committing.} \
1128                 -anchor w \
1129                 -justify left \
1130                 -font [concat $mainfont bold]
1131         scrollbar $w.m.sby -command [list $w.m.t yview]
1132         pack $w.m.l1 -side top -fill x
1133         pack $w.m.l2 -side bottom -fill x
1134         pack $w.m.sby -side right -fill y
1135         pack $w.m.t -side left -fill both -expand 1
1136         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1137
1138         $w.m.t insert 1.0 $msg
1139         $w.m.t conf -state disabled
1140
1141         button $w.ok -text OK \
1142                 -width 15 \
1143                 -font $mainfont \
1144                 -command "destroy $w"
1145         pack $w.ok -side bottom
1146
1147         bind $w <Visibility> "grab $w; focus $w"
1148         bind $w <Key-Return> "destroy $w"
1149         wm title $w "$appname ([lindex [file split \
1150                 [file normalize [file dirname $gitdir]]] \
1151                 end]): error"
1152         tkwait window $w
1153 }
1154
1155 set next_console_id 0
1156
1157 proc new_console {short_title long_title} {
1158         global next_console_id console_data
1159         set w .console[incr next_console_id]
1160         set console_data($w) [list $short_title $long_title]
1161         return [console_init $w]
1162 }
1163
1164 proc console_init {w} {
1165         global console_cr console_data
1166         global gitdir appname mainfont difffont
1167
1168         set console_cr($w) 1.0
1169         toplevel $w
1170         frame $w.m
1171         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1172                 -anchor w \
1173                 -justify left \
1174                 -font [concat $mainfont bold]
1175         text $w.m.t \
1176                 -background white -borderwidth 1 \
1177                 -relief sunken \
1178                 -width 80 -height 10 \
1179                 -font $difffont \
1180                 -state disabled \
1181                 -yscrollcommand [list $w.m.sby set]
1182         label $w.m.s -anchor w \
1183                 -justify left \
1184                 -font [concat $mainfont bold]
1185         scrollbar $w.m.sby -command [list $w.m.t yview]
1186         pack $w.m.l1 -side top -fill x
1187         pack $w.m.s -side bottom -fill x
1188         pack $w.m.sby -side right -fill y
1189         pack $w.m.t -side left -fill both -expand 1
1190         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1191
1192         button $w.ok -text {Running...} \
1193                 -width 15 \
1194                 -font $mainfont \
1195                 -state disabled \
1196                 -command "destroy $w"
1197         pack $w.ok -side bottom
1198
1199         bind $w <Visibility> "focus $w"
1200         wm title $w "$appname ([lindex [file split \
1201                 [file normalize [file dirname $gitdir]]] \
1202                 end]): [lindex $console_data($w) 0]"
1203         return $w
1204 }
1205
1206 proc console_exec {w cmd {after {}}} {
1207         global tcl_platform
1208
1209         # -- Windows tosses the enviroment when we exec our child.
1210         #    But most users need that so we have to relogin. :-(
1211         #
1212         if {$tcl_platform(platform) == {windows}} {
1213                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1214         }
1215
1216         # -- Tcl won't let us redirect both stdout and stderr to
1217         #    the same pipe.  So pass it through cat...
1218         #
1219         set cmd [concat | $cmd |& cat]
1220
1221         set fd_f [open $cmd r]
1222         fconfigure $fd_f -blocking 0 -translation binary
1223         fileevent $fd_f readable [list console_read $w $fd_f $after]
1224 }
1225
1226 proc console_read {w fd after} {
1227         global console_cr console_data
1228
1229         set buf [read $fd]
1230         if {$buf != {}} {
1231                 if {![winfo exists $w]} {console_init $w}
1232                 $w.m.t conf -state normal
1233                 set c 0
1234                 set n [string length $buf]
1235                 while {$c < $n} {
1236                         set cr [string first "\r" $buf $c]
1237                         set lf [string first "\n" $buf $c]
1238                         if {$cr < 0} {set cr [expr $n + 1]}
1239                         if {$lf < 0} {set lf [expr $n + 1]}
1240
1241                         if {$lf < $cr} {
1242                                 $w.m.t insert end [string range $buf $c $lf]
1243                                 set console_cr($w) [$w.m.t index {end -1c}]
1244                                 set c $lf
1245                                 incr c
1246                         } else {
1247                                 $w.m.t delete $console_cr($w) end
1248                                 $w.m.t insert end "\n"
1249                                 $w.m.t insert end [string range $buf $c $cr]
1250                                 set c $cr
1251                                 incr c
1252                         }
1253                 }
1254                 $w.m.t conf -state disabled
1255                 $w.m.t see end
1256         }
1257
1258         fconfigure $fd -blocking 1
1259         if {[eof $fd]} {
1260                 if {[catch {close $fd}]} {
1261                         if {![winfo exists $w]} {console_init $w}
1262                         $w.m.s conf -background red -text {Error: Command Failed}
1263                         $w.ok conf -text Close
1264                         $w.ok conf -state normal
1265                         set ok 0
1266                 } elseif {[winfo exists $w]} {
1267                         $w.m.s conf -background green -text {Success}
1268                         $w.ok conf -text Close
1269                         $w.ok conf -state normal
1270                         set ok 1
1271                 }
1272                 array unset console_cr $w
1273                 array unset console_data $w
1274                 if {$after != {}} {
1275                         uplevel #0 $after $ok
1276                 }
1277                 return
1278         }
1279         fconfigure $fd -blocking 0
1280 }
1281
1282 ######################################################################
1283 ##
1284 ## ui commands
1285
1286 set starting_gitk_msg {Please wait... Starting gitk...}
1287
1288 proc do_gitk {} {
1289         global tcl_platform ui_status_value starting_gitk_msg
1290
1291         set ui_status_value $starting_gitk_msg
1292         after 10000 {
1293                 if {$ui_status_value == $starting_gitk_msg} {
1294                         set ui_status_value {Ready.}
1295                 }
1296         }
1297
1298         if {$tcl_platform(platform) == {windows}} {
1299                 exec sh -c gitk &
1300         } else {
1301                 exec gitk &
1302         }
1303 }
1304
1305 proc do_repack {} {
1306         set w [new_console "repack" "Repacking the object database"]
1307         set cmd [list git repack]
1308         lappend cmd -a
1309         lappend cmd -d
1310         console_exec $w $cmd
1311 }
1312
1313 proc do_quit {} {
1314         global gitdir ui_comm
1315
1316         set save [file join $gitdir GITGUI_MSG]
1317         set msg [string trim [$ui_comm get 0.0 end]]
1318         if {[$ui_comm edit modified] && $msg != {}} {
1319                 catch {
1320                         set fd [open $save w]
1321                         puts $fd [string trim [$ui_comm get 0.0 end]]
1322                         close $fd
1323                 }
1324         } elseif {$msg == {} && [file exists $save]} {
1325                 file delete $save
1326         }
1327
1328         save_my_config
1329         destroy .
1330 }
1331
1332 proc do_rescan {} {
1333         update_status
1334 }
1335
1336 proc do_checkin_all {} {
1337         global checkin_active ui_status_value
1338
1339         if {$checkin_active || ![lock_index begin-update]} return
1340
1341         set checkin_active 1
1342         set ui_status_value {Checking in all files...}
1343         after 1 {
1344                 with_update_index {
1345                         foreach path [array names file_states] {
1346                                 set s $file_states($path)
1347                                 set m [lindex $s 0]
1348                                 switch -- $m {
1349                                 AM -
1350                                 MM -
1351                                 _M -
1352                                 _D {toggle_mode $path}
1353                                 }
1354                         }
1355                 }
1356                 set checkin_active 0
1357                 set ui_status_value {Ready.}
1358         }
1359 }
1360
1361 proc do_signoff {} {
1362         global ui_comm
1363
1364         catch {
1365                 set me [exec git var GIT_COMMITTER_IDENT]
1366                 if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
1367                         set str "Signed-off-by: $name"
1368                         if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1369                                 $ui_comm insert end "\n"
1370                                 $ui_comm insert end $str
1371                                 $ui_comm see end
1372                         }
1373                 }
1374         }
1375 }
1376
1377 proc do_amend_last {} {
1378         load_last_commit
1379 }
1380
1381 proc do_commit {} {
1382         commit_tree
1383 }
1384
1385 # shift == 1: left click
1386 #          3: right click
1387 proc click {w x y shift wx wy} {
1388         global ui_index ui_other
1389
1390         set pos [split [$w index @$x,$y] .]
1391         set lno [lindex $pos 0]
1392         set col [lindex $pos 1]
1393         set path [$w get $lno.1 $lno.end]
1394         if {$path == {}} return
1395
1396         if {$col > 0 && $shift == 1} {
1397                 $ui_index tag remove in_diff 0.0 end
1398                 $ui_other tag remove in_diff 0.0 end
1399                 $w tag add in_diff $lno.0 [expr $lno + 1].0
1400                 show_diff $path
1401         }
1402 }
1403
1404 proc unclick {w x y} {
1405         set pos [split [$w index @$x,$y] .]
1406         set lno [lindex $pos 0]
1407         set col [lindex $pos 1]
1408         set path [$w get $lno.1 $lno.end]
1409         if {$path == {}} return
1410
1411         if {$col == 0} {
1412                 toggle_mode $path
1413         }
1414 }
1415
1416 ######################################################################
1417 ##
1418 ## ui init
1419
1420 set mainfont {Helvetica 10}
1421 set difffont {Courier 10}
1422 set maincursor [. cget -cursor]
1423
1424 switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1425 windows,*   {set M1B Control; set M1T Ctrl}
1426 unix,Darwin {set M1B M1; set M1T Cmd}
1427 default     {set M1B M1; set M1T M1}
1428 }
1429
1430 # -- Menu Bar
1431 menu .mbar -tearoff 0
1432 .mbar add cascade -label Project -menu .mbar.project
1433 .mbar add cascade -label Commit -menu .mbar.commit
1434 .mbar add cascade -label Fetch -menu .mbar.fetch
1435 .mbar add cascade -label Pull -menu .mbar.pull
1436 .mbar add cascade -label Push -menu .mbar.push
1437 .mbar add cascade -label Options -menu .mbar.options
1438 . configure -menu .mbar
1439
1440 # -- Project Menu
1441 menu .mbar.project
1442 .mbar.project add command -label Visualize \
1443         -command do_gitk \
1444         -font $mainfont
1445 .mbar.project add command -label {Repack Database} \
1446         -command do_repack \
1447         -font $mainfont
1448 .mbar.project add command -label Quit \
1449         -command do_quit \
1450         -accelerator $M1T-Q \
1451         -font $mainfont
1452
1453 # -- Commit Menu
1454 menu .mbar.commit
1455 .mbar.commit add command -label Rescan \
1456         -command do_rescan \
1457         -accelerator F5 \
1458         -font $mainfont
1459 lappend disable_on_lock \
1460         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1461 .mbar.commit add command -label {Amend Last Commit} \
1462         -command do_amend_last \
1463         -font $mainfont
1464 lappend disable_on_lock \
1465         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1466 .mbar.commit add command -label {Check-in All Files} \
1467         -command do_checkin_all \
1468         -accelerator $M1T-U \
1469         -font $mainfont
1470 lappend disable_on_lock \
1471         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1472 .mbar.commit add command -label {Sign Off} \
1473         -command do_signoff \
1474         -accelerator $M1T-S \
1475         -font $mainfont
1476 .mbar.commit add command -label Commit \
1477         -command do_commit \
1478         -accelerator $M1T-Return \
1479         -font $mainfont
1480 lappend disable_on_lock \
1481         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1482
1483 # -- Fetch Menu
1484 menu .mbar.fetch
1485
1486 # -- Pull Menu
1487 menu .mbar.pull
1488
1489 # -- Push Menu
1490 menu .mbar.push
1491
1492 # -- Options Menu
1493 menu .mbar.options
1494 .mbar.options add checkbutton -label {Trust File Modification Timestamps} \
1495         -offvalue false \
1496         -onvalue true \
1497         -variable cfg_trust_mtime
1498
1499 # -- Main Window Layout
1500 panedwindow .vpane -orient vertical
1501 panedwindow .vpane.files -orient horizontal
1502 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1503 pack .vpane -anchor n -side top -fill both -expand 1
1504
1505 # -- Index File List
1506 frame .vpane.files.index -height 100 -width 400
1507 label .vpane.files.index.title -text {Modified Files} \
1508         -background green \
1509         -font $mainfont
1510 text $ui_index -background white -borderwidth 0 \
1511         -width 40 -height 10 \
1512         -font $mainfont \
1513         -yscrollcommand {.vpane.files.index.sb set} \
1514         -cursor $maincursor \
1515         -state disabled
1516 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1517 pack .vpane.files.index.title -side top -fill x
1518 pack .vpane.files.index.sb -side right -fill y
1519 pack $ui_index -side left -fill both -expand 1
1520 .vpane.files add .vpane.files.index -sticky nsew
1521
1522 # -- Other (Add) File List
1523 frame .vpane.files.other -height 100 -width 100
1524 label .vpane.files.other.title -text {Untracked Files} \
1525         -background red \
1526         -font $mainfont
1527 text $ui_other -background white -borderwidth 0 \
1528         -width 40 -height 10 \
1529         -font $mainfont \
1530         -yscrollcommand {.vpane.files.other.sb set} \
1531         -cursor $maincursor \
1532         -state disabled
1533 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1534 pack .vpane.files.other.title -side top -fill x
1535 pack .vpane.files.other.sb -side right -fill y
1536 pack $ui_other -side left -fill both -expand 1
1537 .vpane.files add .vpane.files.other -sticky nsew
1538
1539 $ui_index tag conf in_diff -font [concat $mainfont bold]
1540 $ui_other tag conf in_diff -font [concat $mainfont bold]
1541
1542 # -- Diff and Commit Area
1543 frame .vpane.lower -height 400 -width 400
1544 frame .vpane.lower.commarea
1545 frame .vpane.lower.diff -relief sunken -borderwidth 1
1546 pack .vpane.lower.commarea -side top -fill x
1547 pack .vpane.lower.diff -side bottom -fill both -expand 1
1548 .vpane add .vpane.lower -stick nsew
1549
1550 # -- Commit Area Buttons
1551 frame .vpane.lower.commarea.buttons
1552 label .vpane.lower.commarea.buttons.l -text {} \
1553         -anchor w \
1554         -justify left \
1555         -font $mainfont
1556 pack .vpane.lower.commarea.buttons.l -side top -fill x
1557 pack .vpane.lower.commarea.buttons -side left -fill y
1558
1559 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1560         -command do_rescan \
1561         -font $mainfont
1562 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1563 lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
1564
1565 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1566         -command do_amend_last \
1567         -font $mainfont
1568 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1569 lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
1570
1571 button .vpane.lower.commarea.buttons.ciall -text {Check-in All} \
1572         -command do_checkin_all \
1573         -font $mainfont
1574 pack .vpane.lower.commarea.buttons.ciall -side top -fill x
1575 lappend disable_on_lock {.vpane.lower.commarea.buttons.ciall conf -state}
1576
1577 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1578         -command do_signoff \
1579         -font $mainfont
1580 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1581
1582 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1583         -command do_commit \
1584         -font $mainfont
1585 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1586 lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
1587
1588 # -- Commit Message Buffer
1589 frame .vpane.lower.commarea.buffer
1590 set ui_comm .vpane.lower.commarea.buffer.t
1591 set ui_coml .vpane.lower.commarea.buffer.l
1592 label $ui_coml -text {Commit Message:} \
1593         -anchor w \
1594         -justify left \
1595         -font $mainfont
1596 trace add variable commit_type write {uplevel #0 {
1597         switch -glob $commit_type \
1598         initial {$ui_coml conf -text {Initial Commit Message:}} \
1599         amend   {$ui_coml conf -text {Amended Commit Message:}} \
1600         merge   {$ui_coml conf -text {Merge Commit Message:}} \
1601         *       {$ui_coml conf -text {Commit Message:}}
1602 }}
1603 text $ui_comm -background white -borderwidth 1 \
1604         -relief sunken \
1605         -width 75 -height 9 -wrap none \
1606         -font $difffont \
1607         -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1608         -cursor $maincursor
1609 scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
1610 pack $ui_coml -side top -fill x
1611 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1612 pack $ui_comm -side left -fill y
1613 pack .vpane.lower.commarea.buffer -side left -fill y
1614
1615 # -- Diff Header
1616 set ui_fname_value {}
1617 set ui_fstatus_value {}
1618 frame .vpane.lower.diff.header -background orange
1619 label .vpane.lower.diff.header.l1 -text {File:} \
1620         -background orange \
1621         -font $mainfont
1622 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1623         -background orange \
1624         -anchor w \
1625         -justify left \
1626         -font $mainfont
1627 label .vpane.lower.diff.header.l3 -text {Status:} \
1628         -background orange \
1629         -font $mainfont
1630 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1631         -background orange \
1632         -width $max_status_desc \
1633         -anchor w \
1634         -justify left \
1635         -font $mainfont
1636 pack .vpane.lower.diff.header.l1 -side left
1637 pack .vpane.lower.diff.header.l2 -side left -fill x
1638 pack .vpane.lower.diff.header.l4 -side right
1639 pack .vpane.lower.diff.header.l3 -side right
1640
1641 # -- Diff Body
1642 frame .vpane.lower.diff.body
1643 set ui_diff .vpane.lower.diff.body.t
1644 text $ui_diff -background white -borderwidth 0 \
1645         -width 80 -height 15 -wrap none \
1646         -font $difffont \
1647         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1648         -yscrollcommand {.vpane.lower.diff.body.sby set} \
1649         -cursor $maincursor \
1650         -state disabled
1651 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1652         -command [list $ui_diff xview]
1653 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1654         -command [list $ui_diff yview]
1655 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1656 pack .vpane.lower.diff.body.sby -side right -fill y
1657 pack $ui_diff -side left -fill both -expand 1
1658 pack .vpane.lower.diff.header -side top -fill x
1659 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1660
1661 $ui_diff tag conf dm -foreground red
1662 $ui_diff tag conf dp -foreground blue
1663 $ui_diff tag conf da -font [concat $difffont bold]
1664 $ui_diff tag conf di -foreground "#00a000"
1665 $ui_diff tag conf dni -foreground "#a000a0"
1666 $ui_diff tag conf bold -font [concat $difffont bold]
1667
1668 # -- Status Bar
1669 set ui_status_value {Initializing...}
1670 label .status -textvariable ui_status_value \
1671         -anchor w \
1672         -justify left \
1673         -borderwidth 1 \
1674         -relief sunken \
1675         -font $mainfont
1676 pack .status -anchor w -side bottom -fill x
1677
1678 # -- Key Bindings
1679 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1680 bind .   <Destroy> do_quit
1681 bind all <Key-F5> do_rescan
1682 bind all <$M1B-Key-r> do_rescan
1683 bind all <$M1B-Key-R> do_rescan
1684 bind .   <$M1B-Key-s> do_signoff
1685 bind .   <$M1B-Key-S> do_signoff
1686 bind .   <$M1B-Key-u> do_checkin_all
1687 bind .   <$M1B-Key-U> do_checkin_all
1688 bind .   <$M1B-Key-Return> do_commit
1689 bind all <$M1B-Key-q> do_quit
1690 bind all <$M1B-Key-Q> do_quit
1691 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1692 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1693 foreach i [list $ui_index $ui_other] {
1694         bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1695         bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1696         bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1697 }
1698 unset i M1B M1T
1699
1700 ######################################################################
1701 ##
1702 ## main
1703
1704 set appname [lindex [file split $argv0] end]
1705 set gitdir {}
1706
1707 if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
1708         show_msg {} . "Cannot find the git directory: $err"
1709         exit 1
1710 }
1711 if {$cdup != ""} {
1712         cd $cdup
1713 }
1714 unset cdup
1715
1716 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1717         show_msg {} . "Cannot find the git directory: $err"
1718         exit 1
1719 }
1720
1721 if {$appname == {git-citool}} {
1722         set single_commit 1
1723 }
1724
1725 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1726 focus -force $ui_comm
1727 load_repo_config
1728 load_all_remotes
1729 populate_remote_menu .mbar.fetch From fetch_from
1730 populate_remote_menu .mbar.push To push_to
1731 populate_pull_menu .mbar.pull
1732 update_status