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