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