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