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