git-gui: Offer quick access to the HTML formatted documentation.
[git] / git-gui.sh
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
4
5 set appvers {@@GIT_VERSION@@}
6 set copyright {
7 Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
8
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
13
14 This program is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 GNU General Public License for more details.
18
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
22
23 ######################################################################
24 ##
25 ## read only globals
26
27 set _appname [lindex [file split $argv0] end]
28 set _gitdir {}
29 set _reponame {}
30
31 proc appname {} {
32         global _appname
33         return $_appname
34 }
35
36 proc gitdir {args} {
37         global _gitdir
38         if {$args eq {}} {
39                 return $_gitdir
40         }
41         return [eval [concat [list file join $_gitdir] $args]]
42 }
43
44 proc reponame {} {
45         global _reponame
46         return $_reponame
47 }
48
49 ######################################################################
50 ##
51 ## config
52
53 proc is_many_config {name} {
54         switch -glob -- $name {
55         remote.*.fetch -
56         remote.*.push
57                 {return 1}
58         *
59                 {return 0}
60         }
61 }
62
63 proc is_config_true {name} {
64         global repo_config
65         if {[catch {set v $repo_config($name)}]} {
66                 return 0
67         } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
68                 return 1
69         } else {
70                 return 0
71         }
72 }
73
74 proc load_config {include_global} {
75         global repo_config global_config default_config
76
77         array unset global_config
78         if {$include_global} {
79                 catch {
80                         set fd_rc [open "| git repo-config --global --list" r]
81                         while {[gets $fd_rc line] >= 0} {
82                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
83                                         if {[is_many_config $name]} {
84                                                 lappend global_config($name) $value
85                                         } else {
86                                                 set global_config($name) $value
87                                         }
88                                 }
89                         }
90                         close $fd_rc
91                 }
92         }
93
94         array unset repo_config
95         catch {
96                 set fd_rc [open "| git repo-config --list" r]
97                 while {[gets $fd_rc line] >= 0} {
98                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
99                                 if {[is_many_config $name]} {
100                                         lappend repo_config($name) $value
101                                 } else {
102                                         set repo_config($name) $value
103                                 }
104                         }
105                 }
106                 close $fd_rc
107         }
108
109         foreach name [array names default_config] {
110                 if {[catch {set v $global_config($name)}]} {
111                         set global_config($name) $default_config($name)
112                 }
113                 if {[catch {set v $repo_config($name)}]} {
114                         set repo_config($name) $default_config($name)
115                 }
116         }
117 }
118
119 proc save_config {} {
120         global default_config font_descs
121         global repo_config global_config
122         global repo_config_new global_config_new
123
124         foreach option $font_descs {
125                 set name [lindex $option 0]
126                 set font [lindex $option 1]
127                 font configure $font \
128                         -family $global_config_new(gui.$font^^family) \
129                         -size $global_config_new(gui.$font^^size)
130                 font configure ${font}bold \
131                         -family $global_config_new(gui.$font^^family) \
132                         -size $global_config_new(gui.$font^^size)
133                 set global_config_new(gui.$name) [font configure $font]
134                 unset global_config_new(gui.$font^^family)
135                 unset global_config_new(gui.$font^^size)
136         }
137
138         foreach name [array names default_config] {
139                 set value $global_config_new($name)
140                 if {$value ne $global_config($name)} {
141                         if {$value eq $default_config($name)} {
142                                 catch {exec git repo-config --global --unset $name}
143                         } else {
144                                 regsub -all "\[{}\]" $value {"} value
145                                 exec git repo-config --global $name $value
146                         }
147                         set global_config($name) $value
148                         if {$value eq $repo_config($name)} {
149                                 catch {exec git repo-config --unset $name}
150                                 set repo_config($name) $value
151                         }
152                 }
153         }
154
155         foreach name [array names default_config] {
156                 set value $repo_config_new($name)
157                 if {$value ne $repo_config($name)} {
158                         if {$value eq $global_config($name)} {
159                                 catch {exec git repo-config --unset $name}
160                         } else {
161                                 regsub -all "\[{}\]" $value {"} value
162                                 exec git repo-config $name $value
163                         }
164                         set repo_config($name) $value
165                 }
166         }
167 }
168
169 proc error_popup {msg} {
170         set title [appname]
171         if {[reponame] ne {}} {
172                 append title " ([reponame])"
173         }
174         set cmd [list tk_messageBox \
175                 -icon error \
176                 -type ok \
177                 -title "$title: error" \
178                 -message $msg]
179         if {[winfo ismapped .]} {
180                 lappend cmd -parent .
181         }
182         eval $cmd
183 }
184
185 proc warn_popup {msg} {
186         set title [appname]
187         if {[reponame] ne {}} {
188                 append title " ([reponame])"
189         }
190         set cmd [list tk_messageBox \
191                 -icon warning \
192                 -type ok \
193                 -title "$title: warning" \
194                 -message $msg]
195         if {[winfo ismapped .]} {
196                 lappend cmd -parent .
197         }
198         eval $cmd
199 }
200
201 proc info_popup {msg {parent .}} {
202         set title [appname]
203         if {[reponame] ne {}} {
204                 append title " ([reponame])"
205         }
206         tk_messageBox \
207                 -parent $parent \
208                 -icon info \
209                 -type ok \
210                 -title $title \
211                 -message $msg
212 }
213
214 proc ask_popup {msg} {
215         set title [appname]
216         if {[reponame] ne {}} {
217                 append title " ([reponame])"
218         }
219         return [tk_messageBox \
220                 -parent . \
221                 -icon question \
222                 -type yesno \
223                 -title $title \
224                 -message $msg]
225 }
226
227 ######################################################################
228 ##
229 ## repository setup
230
231 if {   [catch {set _gitdir $env(GIT_DIR)}]
232         && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
233         catch {wm withdraw .}
234         error_popup "Cannot find the git directory:\n\n$err"
235         exit 1
236 }
237 if {![file isdirectory $_gitdir]} {
238         catch {wm withdraw .}
239         error_popup "Git directory not found:\n\n$_gitdir"
240         exit 1
241 }
242 if {[lindex [file split $_gitdir] end] ne {.git}} {
243         catch {wm withdraw .}
244         error_popup "Cannot use funny .git directory:\n\n$gitdir"
245         exit 1
246 }
247 if {[catch {cd [file dirname $_gitdir]} err]} {
248         catch {wm withdraw .}
249         error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
250         exit 1
251 }
252 set _reponame [lindex [file split \
253         [file normalize [file dirname $_gitdir]]] \
254         end]
255
256 set single_commit 0
257 if {[appname] eq {git-citool}} {
258         set single_commit 1
259 }
260
261 ######################################################################
262 ##
263 ## task management
264
265 set rescan_active 0
266 set diff_active 0
267 set last_clicked {}
268
269 set disable_on_lock [list]
270 set index_lock_type none
271
272 proc lock_index {type} {
273         global index_lock_type disable_on_lock
274
275         if {$index_lock_type eq {none}} {
276                 set index_lock_type $type
277                 foreach w $disable_on_lock {
278                         uplevel #0 $w disabled
279                 }
280                 return 1
281         } elseif {$index_lock_type eq "begin-$type"} {
282                 set index_lock_type $type
283                 return 1
284         }
285         return 0
286 }
287
288 proc unlock_index {} {
289         global index_lock_type disable_on_lock
290
291         set index_lock_type none
292         foreach w $disable_on_lock {
293                 uplevel #0 $w normal
294         }
295 }
296
297 ######################################################################
298 ##
299 ## status
300
301 proc repository_state {ctvar hdvar mhvar} {
302         global current_branch
303         upvar $ctvar ct $hdvar hd $mhvar mh
304
305         set mh [list]
306
307         if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
308                 set current_branch {}
309         } else {
310                 regsub ^refs/((heads|tags|remotes)/)? \
311                         $current_branch \
312                         {} \
313                         current_branch
314         }
315
316         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
317                 set hd {}
318                 set ct initial
319                 return
320         }
321
322         set merge_head [gitdir MERGE_HEAD]
323         if {[file exists $merge_head]} {
324                 set ct merge
325                 set fd_mh [open $merge_head r]
326                 while {[gets $fd_mh line] >= 0} {
327                         lappend mh $line
328                 }
329                 close $fd_mh
330                 return
331         }
332
333         set ct normal
334 }
335
336 proc PARENT {} {
337         global PARENT empty_tree
338
339         set p [lindex $PARENT 0]
340         if {$p ne {}} {
341                 return $p
342         }
343         if {$empty_tree eq {}} {
344                 set empty_tree [exec git mktree << {}]
345         }
346         return $empty_tree
347 }
348
349 proc rescan {after {honor_trustmtime 1}} {
350         global HEAD PARENT MERGE_HEAD commit_type
351         global ui_index ui_workdir ui_status_value ui_comm
352         global rescan_active file_states
353         global repo_config
354
355         if {$rescan_active > 0 || ![lock_index read]} return
356
357         repository_state newType newHEAD newMERGE_HEAD
358         if {[string match amend* $commit_type]
359                 && $newType eq {normal}
360                 && $newHEAD eq $HEAD} {
361         } else {
362                 set HEAD $newHEAD
363                 set PARENT $newHEAD
364                 set MERGE_HEAD $newMERGE_HEAD
365                 set commit_type $newType
366         }
367
368         array unset file_states
369
370         if {![$ui_comm edit modified]
371                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
372                 if {[load_message GITGUI_MSG]} {
373                 } elseif {[load_message MERGE_MSG]} {
374                 } elseif {[load_message SQUASH_MSG]} {
375                 }
376                 $ui_comm edit reset
377                 $ui_comm edit modified false
378         }
379
380         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
381                 rescan_stage2 {} $after
382         } else {
383                 set rescan_active 1
384                 set ui_status_value {Refreshing file status...}
385                 set cmd [list git update-index]
386                 lappend cmd -q
387                 lappend cmd --unmerged
388                 lappend cmd --ignore-missing
389                 lappend cmd --refresh
390                 set fd_rf [open "| $cmd" r]
391                 fconfigure $fd_rf -blocking 0 -translation binary
392                 fileevent $fd_rf readable \
393                         [list rescan_stage2 $fd_rf $after]
394         }
395 }
396
397 proc rescan_stage2 {fd after} {
398         global ui_status_value
399         global rescan_active buf_rdi buf_rdf buf_rlo
400
401         if {$fd ne {}} {
402                 read $fd
403                 if {![eof $fd]} return
404                 close $fd
405         }
406
407         set ls_others [list | git ls-files --others -z \
408                 --exclude-per-directory=.gitignore]
409         set info_exclude [gitdir info exclude]
410         if {[file readable $info_exclude]} {
411                 lappend ls_others "--exclude-from=$info_exclude"
412         }
413
414         set buf_rdi {}
415         set buf_rdf {}
416         set buf_rlo {}
417
418         set rescan_active 3
419         set ui_status_value {Scanning for modified files ...}
420         set fd_di [open "| git diff-index --cached -z [PARENT]" r]
421         set fd_df [open "| git diff-files -z" r]
422         set fd_lo [open $ls_others r]
423
424         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
425         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
426         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
427         fileevent $fd_di readable [list read_diff_index $fd_di $after]
428         fileevent $fd_df readable [list read_diff_files $fd_df $after]
429         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
430 }
431
432 proc load_message {file} {
433         global ui_comm
434
435         set f [gitdir $file]
436         if {[file isfile $f]} {
437                 if {[catch {set fd [open $f r]}]} {
438                         return 0
439                 }
440                 set content [string trim [read $fd]]
441                 close $fd
442                 regsub -all -line {[ \r\t]+$} $content {} content
443                 $ui_comm delete 0.0 end
444                 $ui_comm insert end $content
445                 return 1
446         }
447         return 0
448 }
449
450 proc read_diff_index {fd after} {
451         global buf_rdi
452
453         append buf_rdi [read $fd]
454         set c 0
455         set n [string length $buf_rdi]
456         while {$c < $n} {
457                 set z1 [string first "\0" $buf_rdi $c]
458                 if {$z1 == -1} break
459                 incr z1
460                 set z2 [string first "\0" $buf_rdi $z1]
461                 if {$z2 == -1} break
462
463                 incr c
464                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
465                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
466                 merge_state \
467                         [encoding convertfrom $p] \
468                         [lindex $i 4]? \
469                         [list [lindex $i 0] [lindex $i 2]] \
470                         [list]
471                 set c $z2
472                 incr c
473         }
474         if {$c < $n} {
475                 set buf_rdi [string range $buf_rdi $c end]
476         } else {
477                 set buf_rdi {}
478         }
479
480         rescan_done $fd buf_rdi $after
481 }
482
483 proc read_diff_files {fd after} {
484         global buf_rdf
485
486         append buf_rdf [read $fd]
487         set c 0
488         set n [string length $buf_rdf]
489         while {$c < $n} {
490                 set z1 [string first "\0" $buf_rdf $c]
491                 if {$z1 == -1} break
492                 incr z1
493                 set z2 [string first "\0" $buf_rdf $z1]
494                 if {$z2 == -1} break
495
496                 incr c
497                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
498                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
499                 merge_state \
500                         [encoding convertfrom $p] \
501                         ?[lindex $i 4] \
502                         [list] \
503                         [list [lindex $i 0] [lindex $i 2]]
504                 set c $z2
505                 incr c
506         }
507         if {$c < $n} {
508                 set buf_rdf [string range $buf_rdf $c end]
509         } else {
510                 set buf_rdf {}
511         }
512
513         rescan_done $fd buf_rdf $after
514 }
515
516 proc read_ls_others {fd after} {
517         global buf_rlo
518
519         append buf_rlo [read $fd]
520         set pck [split $buf_rlo "\0"]
521         set buf_rlo [lindex $pck end]
522         foreach p [lrange $pck 0 end-1] {
523                 merge_state [encoding convertfrom $p] ?O
524         }
525         rescan_done $fd buf_rlo $after
526 }
527
528 proc rescan_done {fd buf after} {
529         global rescan_active
530         global file_states repo_config
531         upvar $buf to_clear
532
533         if {![eof $fd]} return
534         set to_clear {}
535         close $fd
536         if {[incr rescan_active -1] > 0} return
537
538         prune_selection
539         unlock_index
540         display_all_files
541         reshow_diff
542         uplevel #0 $after
543 }
544
545 proc prune_selection {} {
546         global file_states selected_paths
547
548         foreach path [array names selected_paths] {
549                 if {[catch {set still_here $file_states($path)}]} {
550                         unset selected_paths($path)
551                 }
552         }
553 }
554
555 ######################################################################
556 ##
557 ## diff
558
559 proc clear_diff {} {
560         global ui_diff current_diff_path current_diff_header
561         global ui_index ui_workdir
562
563         $ui_diff conf -state normal
564         $ui_diff delete 0.0 end
565         $ui_diff conf -state disabled
566
567         set current_diff_path {}
568         set current_diff_header {}
569
570         $ui_index tag remove in_diff 0.0 end
571         $ui_workdir tag remove in_diff 0.0 end
572 }
573
574 proc reshow_diff {} {
575         global ui_status_value file_states file_lists
576         global current_diff_path current_diff_side
577
578         set p $current_diff_path
579         if {$p eq {}
580                 || $current_diff_side eq {}
581                 || [catch {set s $file_states($p)}]
582                 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
583                 clear_diff
584         } else {
585                 show_diff $p $current_diff_side
586         }
587 }
588
589 proc handle_empty_diff {} {
590         global current_diff_path file_states file_lists
591
592         set path $current_diff_path
593         set s $file_states($path)
594         if {[lindex $s 0] ne {_M}} return
595
596         info_popup "No differences detected.
597
598 [short_path $path] has no changes.
599
600 The modification date of this file was updated
601 by another application, but the content within
602 the file was not changed.
603
604 A rescan will be automatically started to find
605 other files which may have the same state."
606
607         clear_diff
608         display_file $path __
609         rescan {set ui_status_value {Ready.}} 0
610 }
611
612 proc show_diff {path w {lno {}}} {
613         global file_states file_lists
614         global is_3way_diff diff_active repo_config
615         global ui_diff ui_status_value ui_index ui_workdir
616         global current_diff_path current_diff_side current_diff_header
617
618         if {$diff_active || ![lock_index read]} return
619
620         clear_diff
621         if {$lno == {}} {
622                 set lno [lsearch -sorted -exact $file_lists($w) $path]
623                 if {$lno >= 0} {
624                         incr lno
625                 }
626         }
627         if {$lno >= 1} {
628                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
629         }
630
631         set s $file_states($path)
632         set m [lindex $s 0]
633         set is_3way_diff 0
634         set diff_active 1
635         set current_diff_path $path
636         set current_diff_side $w
637         set current_diff_header {}
638         set ui_status_value "Loading diff of [escape_path $path]..."
639
640         # - Git won't give us the diff, there's nothing to compare to!
641         #
642         if {$m eq {_O}} {
643                 set max_sz [expr {128 * 1024}]
644                 if {[catch {
645                                 set fd [open $path r]
646                                 set content [read $fd $max_sz]
647                                 close $fd
648                                 set sz [file size $path]
649                         } err ]} {
650                         set diff_active 0
651                         unlock_index
652                         set ui_status_value "Unable to display [escape_path $path]"
653                         error_popup "Error loading file:\n\n$err"
654                         return
655                 }
656                 $ui_diff conf -state normal
657                 if {![catch {set type [exec file $path]}]} {
658                         set n [string length $path]
659                         if {[string equal -length $n $path $type]} {
660                                 set type [string range $type $n end]
661                                 regsub {^:?\s*} $type {} type
662                         }
663                         $ui_diff insert end "* $type\n" d_@
664                 }
665                 if {[string first "\0" $content] != -1} {
666                         $ui_diff insert end \
667                                 "* Binary file (not showing content)." \
668                                 d_@
669                 } else {
670                         if {$sz > $max_sz} {
671                                 $ui_diff insert end \
672 "* Untracked file is $sz bytes.
673 * Showing only first $max_sz bytes.
674 " d_@
675                         }
676                         $ui_diff insert end $content
677                         if {$sz > $max_sz} {
678                                 $ui_diff insert end "
679 * Untracked file clipped here by [appname].
680 * To see the entire file, use an external editor.
681 " d_@
682                         }
683                 }
684                 $ui_diff conf -state disabled
685                 set diff_active 0
686                 unlock_index
687                 set ui_status_value {Ready.}
688                 return
689         }
690
691         set cmd [list | git]
692         if {$w eq $ui_index} {
693                 lappend cmd diff-index
694                 lappend cmd --cached
695         } elseif {$w eq $ui_workdir} {
696                 if {[string index $m 0] eq {U}} {
697                         lappend cmd diff
698                 } else {
699                         lappend cmd diff-files
700                 }
701         }
702
703         lappend cmd -p
704         lappend cmd --no-color
705         if {$repo_config(gui.diffcontext) > 0} {
706                 lappend cmd "-U$repo_config(gui.diffcontext)"
707         }
708         if {$w eq $ui_index} {
709                 lappend cmd [PARENT]
710         }
711         lappend cmd --
712         lappend cmd $path
713
714         if {[catch {set fd [open $cmd r]} err]} {
715                 set diff_active 0
716                 unlock_index
717                 set ui_status_value "Unable to display [escape_path $path]"
718                 error_popup "Error loading diff:\n\n$err"
719                 return
720         }
721
722         fconfigure $fd \
723                 -blocking 0 \
724                 -encoding binary \
725                 -translation binary
726         fileevent $fd readable [list read_diff $fd]
727 }
728
729 proc read_diff {fd} {
730         global ui_diff ui_status_value diff_active
731         global is_3way_diff current_diff_header
732
733         $ui_diff conf -state normal
734         while {[gets $fd line] >= 0} {
735                 # -- Cleanup uninteresting diff header lines.
736                 #
737                 if {   [string match {diff --git *}      $line]
738                         || [string match {diff --cc *}       $line]
739                         || [string match {diff --combined *} $line]
740                         || [string match {--- *}             $line]
741                         || [string match {+++ *}             $line]} {
742                         append current_diff_header $line "\n"
743                         continue
744                 }
745                 if {[string match {index *} $line]} continue
746                 if {$line eq {deleted file mode 120000}} {
747                         set line "deleted symlink"
748                 }
749
750                 # -- Automatically detect if this is a 3 way diff.
751                 #
752                 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
753
754                 if {[string match {mode *} $line]
755                         || [string match {new file *} $line]
756                         || [string match {deleted file *} $line]
757                         || [string match {Binary files * and * differ} $line]
758                         || $line eq {\ No newline at end of file}
759                         || [regexp {^\* Unmerged path } $line]} {
760                         set tags {}
761                 } elseif {$is_3way_diff} {
762                         set op [string range $line 0 1]
763                         switch -- $op {
764                         {  } {set tags {}}
765                         {@@} {set tags d_@}
766                         { +} {set tags d_s+}
767                         { -} {set tags d_s-}
768                         {+ } {set tags d_+s}
769                         {- } {set tags d_-s}
770                         {--} {set tags d_--}
771                         {++} {
772                                 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
773                                         set line [string replace $line 0 1 {  }]
774                                         set tags d$op
775                                 } else {
776                                         set tags d_++
777                                 }
778                         }
779                         default {
780                                 puts "error: Unhandled 3 way diff marker: {$op}"
781                                 set tags {}
782                         }
783                         }
784                 } else {
785                         set op [string index $line 0]
786                         switch -- $op {
787                         { } {set tags {}}
788                         {@} {set tags d_@}
789                         {-} {set tags d_-}
790                         {+} {
791                                 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
792                                         set line [string replace $line 0 0 { }]
793                                         set tags d$op
794                                 } else {
795                                         set tags d_+
796                                 }
797                         }
798                         default {
799                                 puts "error: Unhandled 2 way diff marker: {$op}"
800                                 set tags {}
801                         }
802                         }
803                 }
804                 $ui_diff insert end $line $tags
805                 if {[string index $line end] eq "\r"} {
806                         $ui_diff tag add d_cr {end - 2c}
807                 }
808                 $ui_diff insert end "\n" $tags
809         }
810         $ui_diff conf -state disabled
811
812         if {[eof $fd]} {
813                 close $fd
814                 set diff_active 0
815                 unlock_index
816                 set ui_status_value {Ready.}
817
818                 if {[$ui_diff index end] eq {2.0}} {
819                         handle_empty_diff
820                 }
821         }
822 }
823
824 proc apply_hunk {x y} {
825         global current_diff_path current_diff_header current_diff_side
826         global ui_diff ui_index file_states
827
828         if {$current_diff_path eq {} || $current_diff_header eq {}} return
829         if {![lock_index apply_hunk]} return
830
831         set apply_cmd {git apply --cached --whitespace=nowarn}
832         set mi [lindex $file_states($current_diff_path) 0]
833         if {$current_diff_side eq $ui_index} {
834                 set mode unstage
835                 lappend apply_cmd --reverse
836                 if {[string index $mi 0] ne {M}} {
837                         unlock_index
838                         return
839                 }
840         } else {
841                 set mode stage
842                 if {[string index $mi 1] ne {M}} {
843                         unlock_index
844                         return
845                 }
846         }
847
848         set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
849         set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
850         if {$s_lno eq {}} {
851                 unlock_index
852                 return
853         }
854
855         set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
856         if {$e_lno eq {}} {
857                 set e_lno end
858         }
859
860         if {[catch {
861                 set p [open "| $apply_cmd" w]
862                 fconfigure $p -translation binary -encoding binary
863                 puts -nonewline $p $current_diff_header
864                 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
865                 close $p} err]} {
866                 error_popup "Failed to $mode selected hunk.\n\n$err"
867                 unlock_index
868                 return
869         }
870
871         $ui_diff conf -state normal
872         $ui_diff delete $s_lno $e_lno
873         $ui_diff conf -state disabled
874
875         if {[$ui_diff get 1.0 end] eq "\n"} {
876                 set o _
877         } else {
878                 set o ?
879         }
880
881         if {$current_diff_side eq $ui_index} {
882                 set mi ${o}M
883         } elseif {[string index $mi 0] eq {_}} {
884                 set mi M$o
885         } else {
886                 set mi ?$o
887         }
888         unlock_index
889         display_file $current_diff_path $mi
890         if {$o eq {_}} {
891                 clear_diff
892         }
893 }
894
895 ######################################################################
896 ##
897 ## commit
898
899 proc load_last_commit {} {
900         global HEAD PARENT MERGE_HEAD commit_type ui_comm
901         global repo_config
902
903         if {[llength $PARENT] == 0} {
904                 error_popup {There is nothing to amend.
905
906 You are about to create the initial commit.
907 There is no commit before this to amend.
908 }
909                 return
910         }
911
912         repository_state curType curHEAD curMERGE_HEAD
913         if {$curType eq {merge}} {
914                 error_popup {Cannot amend while merging.
915
916 You are currently in the middle of a merge that
917 has not been fully completed.  You cannot amend
918 the prior commit unless you first abort the
919 current merge activity.
920 }
921                 return
922         }
923
924         set msg {}
925         set parents [list]
926         if {[catch {
927                         set fd [open "| git cat-file commit $curHEAD" r]
928                         fconfigure $fd -encoding binary -translation lf
929                         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
930                                 set enc utf-8
931                         }
932                         while {[gets $fd line] > 0} {
933                                 if {[string match {parent *} $line]} {
934                                         lappend parents [string range $line 7 end]
935                                 } elseif {[string match {encoding *} $line]} {
936                                         set enc [string tolower [string range $line 9 end]]
937                                 }
938                         }
939                         fconfigure $fd -encoding $enc
940                         set msg [string trim [read $fd]]
941                         close $fd
942                 } err]} {
943                 error_popup "Error loading commit data for amend:\n\n$err"
944                 return
945         }
946
947         set HEAD $curHEAD
948         set PARENT $parents
949         set MERGE_HEAD [list]
950         switch -- [llength $parents] {
951         0       {set commit_type amend-initial}
952         1       {set commit_type amend}
953         default {set commit_type amend-merge}
954         }
955
956         $ui_comm delete 0.0 end
957         $ui_comm insert end $msg
958         $ui_comm edit reset
959         $ui_comm edit modified false
960         rescan {set ui_status_value {Ready.}}
961 }
962
963 proc create_new_commit {} {
964         global commit_type ui_comm
965
966         set commit_type normal
967         $ui_comm delete 0.0 end
968         $ui_comm edit reset
969         $ui_comm edit modified false
970         rescan {set ui_status_value {Ready.}}
971 }
972
973 set GIT_COMMITTER_IDENT {}
974
975 proc committer_ident {} {
976         global GIT_COMMITTER_IDENT
977
978         if {$GIT_COMMITTER_IDENT eq {}} {
979                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
980                         error_popup "Unable to obtain your identity:\n\n$err"
981                         return {}
982                 }
983                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
984                         $me me GIT_COMMITTER_IDENT]} {
985                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
986                         return {}
987                 }
988         }
989
990         return $GIT_COMMITTER_IDENT
991 }
992
993 proc commit_tree {} {
994         global HEAD commit_type file_states ui_comm repo_config
995         global ui_status_value pch_error
996
997         if {[committer_ident] eq {}} return
998         if {![lock_index update]} return
999
1000         # -- Our in memory state should match the repository.
1001         #
1002         repository_state curType curHEAD curMERGE_HEAD
1003         if {[string match amend* $commit_type]
1004                 && $curType eq {normal}
1005                 && $curHEAD eq $HEAD} {
1006         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1007                 info_popup {Last scanned state does not match repository state.
1008
1009 Another Git program has modified this repository
1010 since the last scan.  A rescan must be performed
1011 before another commit can be created.
1012
1013 The rescan will be automatically started now.
1014 }
1015                 unlock_index
1016                 rescan {set ui_status_value {Ready.}}
1017                 return
1018         }
1019
1020         # -- At least one file should differ in the index.
1021         #
1022         set files_ready 0
1023         foreach path [array names file_states] {
1024                 switch -glob -- [lindex $file_states($path) 0] {
1025                 _? {continue}
1026                 A? -
1027                 D? -
1028                 M? {set files_ready 1}
1029                 U? {
1030                         error_popup "Unmerged files cannot be committed.
1031
1032 File [short_path $path] has merge conflicts.
1033 You must resolve them and add the file before committing.
1034 "
1035                         unlock_index
1036                         return
1037                 }
1038                 default {
1039                         error_popup "Unknown file state [lindex $s 0] detected.
1040
1041 File [short_path $path] cannot be committed by this program.
1042 "
1043                 }
1044                 }
1045         }
1046         if {!$files_ready} {
1047                 info_popup {No changes to commit.
1048
1049 You must add at least 1 file before you can commit.
1050 }
1051                 unlock_index
1052                 return
1053         }
1054
1055         # -- A message is required.
1056         #
1057         set msg [string trim [$ui_comm get 1.0 end]]
1058         regsub -all -line {[ \t\r]+$} $msg {} msg
1059         if {$msg eq {}} {
1060                 error_popup {Please supply a commit message.
1061
1062 A good commit message has the following format:
1063
1064 - First line: Describe in one sentance what you did.
1065 - Second line: Blank
1066 - Remaining lines: Describe why this change is good.
1067 }
1068                 unlock_index
1069                 return
1070         }
1071
1072         # -- Run the pre-commit hook.
1073         #
1074         set pchook [gitdir hooks pre-commit]
1075
1076         # On Cygwin [file executable] might lie so we need to ask
1077         # the shell if the hook is executable.  Yes that's annoying.
1078         #
1079         if {[is_Windows] && [file isfile $pchook]} {
1080                 set pchook [list sh -c [concat \
1081                         "if test -x \"$pchook\";" \
1082                         "then exec \"$pchook\" 2>&1;" \
1083                         "fi"]]
1084         } elseif {[file executable $pchook]} {
1085                 set pchook [list $pchook |& cat]
1086         } else {
1087                 commit_writetree $curHEAD $msg
1088                 return
1089         }
1090
1091         set ui_status_value {Calling pre-commit hook...}
1092         set pch_error {}
1093         set fd_ph [open "| $pchook" r]
1094         fconfigure $fd_ph -blocking 0 -translation binary
1095         fileevent $fd_ph readable \
1096                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1097 }
1098
1099 proc commit_prehook_wait {fd_ph curHEAD msg} {
1100         global pch_error ui_status_value
1101
1102         append pch_error [read $fd_ph]
1103         fconfigure $fd_ph -blocking 1
1104         if {[eof $fd_ph]} {
1105                 if {[catch {close $fd_ph}]} {
1106                         set ui_status_value {Commit declined by pre-commit hook.}
1107                         hook_failed_popup pre-commit $pch_error
1108                         unlock_index
1109                 } else {
1110                         commit_writetree $curHEAD $msg
1111                 }
1112                 set pch_error {}
1113                 return
1114         }
1115         fconfigure $fd_ph -blocking 0
1116 }
1117
1118 proc commit_writetree {curHEAD msg} {
1119         global ui_status_value
1120
1121         set ui_status_value {Committing changes...}
1122         set fd_wt [open "| git write-tree" r]
1123         fileevent $fd_wt readable \
1124                 [list commit_committree $fd_wt $curHEAD $msg]
1125 }
1126
1127 proc commit_committree {fd_wt curHEAD msg} {
1128         global HEAD PARENT MERGE_HEAD commit_type
1129         global single_commit all_heads current_branch
1130         global ui_status_value ui_comm selected_commit_type
1131         global file_states selected_paths rescan_active
1132         global repo_config
1133
1134         gets $fd_wt tree_id
1135         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1136                 error_popup "write-tree failed:\n\n$err"
1137                 set ui_status_value {Commit failed.}
1138                 unlock_index
1139                 return
1140         }
1141
1142         # -- Build the message.
1143         #
1144         set msg_p [gitdir COMMIT_EDITMSG]
1145         set msg_wt [open $msg_p w]
1146         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1147                 set enc utf-8
1148         }
1149         fconfigure $msg_wt -encoding $enc -translation binary
1150         puts -nonewline $msg_wt $msg
1151         close $msg_wt
1152
1153         # -- Create the commit.
1154         #
1155         set cmd [list git commit-tree $tree_id]
1156         set parents [concat $PARENT $MERGE_HEAD]
1157         if {[llength $parents] > 0} {
1158                 foreach p $parents {
1159                         lappend cmd -p $p
1160                 }
1161         } else {
1162                 # git commit-tree writes to stderr during initial commit.
1163                 lappend cmd 2>/dev/null
1164         }
1165         lappend cmd <$msg_p
1166         if {[catch {set cmt_id [eval exec $cmd]} err]} {
1167                 error_popup "commit-tree failed:\n\n$err"
1168                 set ui_status_value {Commit failed.}
1169                 unlock_index
1170                 return
1171         }
1172
1173         # -- Update the HEAD ref.
1174         #
1175         set reflogm commit
1176         if {$commit_type ne {normal}} {
1177                 append reflogm " ($commit_type)"
1178         }
1179         set i [string first "\n" $msg]
1180         if {$i >= 0} {
1181                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1182         } else {
1183                 append reflogm {: } $msg
1184         }
1185         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1186         if {[catch {eval exec $cmd} err]} {
1187                 error_popup "update-ref failed:\n\n$err"
1188                 set ui_status_value {Commit failed.}
1189                 unlock_index
1190                 return
1191         }
1192
1193         # -- Make sure our current branch exists.
1194         #
1195         if {$commit_type eq {initial}} {
1196                 lappend all_heads $current_branch
1197                 set all_heads [lsort -unique $all_heads]
1198                 populate_branch_menu
1199         }
1200
1201         # -- Cleanup after ourselves.
1202         #
1203         catch {file delete $msg_p}
1204         catch {file delete [gitdir MERGE_HEAD]}
1205         catch {file delete [gitdir MERGE_MSG]}
1206         catch {file delete [gitdir SQUASH_MSG]}
1207         catch {file delete [gitdir GITGUI_MSG]}
1208
1209         # -- Let rerere do its thing.
1210         #
1211         if {[file isdirectory [gitdir rr-cache]]} {
1212                 catch {exec git rerere}
1213         }
1214
1215         # -- Run the post-commit hook.
1216         #
1217         set pchook [gitdir hooks post-commit]
1218         if {[is_Windows] && [file isfile $pchook]} {
1219                 set pchook [list sh -c [concat \
1220                         "if test -x \"$pchook\";" \
1221                         "then exec \"$pchook\";" \
1222                         "fi"]]
1223         } elseif {![file executable $pchook]} {
1224                 set pchook {}
1225         }
1226         if {$pchook ne {}} {
1227                 catch {exec $pchook &}
1228         }
1229
1230         $ui_comm delete 0.0 end
1231         $ui_comm edit reset
1232         $ui_comm edit modified false
1233
1234         if {$single_commit} do_quit
1235
1236         # -- Update in memory status
1237         #
1238         set selected_commit_type new
1239         set commit_type normal
1240         set HEAD $cmt_id
1241         set PARENT $cmt_id
1242         set MERGE_HEAD [list]
1243
1244         foreach path [array names file_states] {
1245                 set s $file_states($path)
1246                 set m [lindex $s 0]
1247                 switch -glob -- $m {
1248                 _O -
1249                 _M -
1250                 _D {continue}
1251                 __ -
1252                 A_ -
1253                 M_ -
1254                 D_ {
1255                         unset file_states($path)
1256                         catch {unset selected_paths($path)}
1257                 }
1258                 DO {
1259                         set file_states($path) [list _O [lindex $s 1] {} {}]
1260                 }
1261                 AM -
1262                 AD -
1263                 MM -
1264                 MD {
1265                         set file_states($path) [list \
1266                                 _[string index $m 1] \
1267                                 [lindex $s 1] \
1268                                 [lindex $s 3] \
1269                                 {}]
1270                 }
1271                 }
1272         }
1273
1274         display_all_files
1275         unlock_index
1276         reshow_diff
1277         set ui_status_value \
1278                 "Changes committed as [string range $cmt_id 0 7]."
1279 }
1280
1281 ######################################################################
1282 ##
1283 ## fetch push
1284
1285 proc fetch_from {remote} {
1286         set w [new_console \
1287                 "fetch $remote" \
1288                 "Fetching new changes from $remote"]
1289         set cmd [list git fetch]
1290         lappend cmd $remote
1291         console_exec $w $cmd console_done
1292 }
1293
1294 proc push_to {remote} {
1295         set w [new_console \
1296                 "push $remote" \
1297                 "Pushing changes to $remote"]
1298         set cmd [list git push]
1299         lappend cmd -v
1300         lappend cmd $remote
1301         console_exec $w $cmd console_done
1302 }
1303
1304 ######################################################################
1305 ##
1306 ## ui helpers
1307
1308 proc mapicon {w state path} {
1309         global all_icons
1310
1311         if {[catch {set r $all_icons($state$w)}]} {
1312                 puts "error: no icon for $w state={$state} $path"
1313                 return file_plain
1314         }
1315         return $r
1316 }
1317
1318 proc mapdesc {state path} {
1319         global all_descs
1320
1321         if {[catch {set r $all_descs($state)}]} {
1322                 puts "error: no desc for state={$state} $path"
1323                 return $state
1324         }
1325         return $r
1326 }
1327
1328 proc escape_path {path} {
1329         regsub -all "\n" $path "\\n" path
1330         return $path
1331 }
1332
1333 proc short_path {path} {
1334         return [escape_path [lindex [file split $path] end]]
1335 }
1336
1337 set next_icon_id 0
1338 set null_sha1 [string repeat 0 40]
1339
1340 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1341         global file_states next_icon_id null_sha1
1342
1343         set s0 [string index $new_state 0]
1344         set s1 [string index $new_state 1]
1345
1346         if {[catch {set info $file_states($path)}]} {
1347                 set state __
1348                 set icon n[incr next_icon_id]
1349         } else {
1350                 set state [lindex $info 0]
1351                 set icon [lindex $info 1]
1352                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1353                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1354         }
1355
1356         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1357         elseif {$s0 eq {_}} {set s0 _}
1358
1359         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1360         elseif {$s1 eq {_}} {set s1 _}
1361
1362         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1363                 set head_info [list 0 $null_sha1]
1364         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1365                 && $head_info eq {}} {
1366                 set head_info $index_info
1367         }
1368
1369         set file_states($path) [list $s0$s1 $icon \
1370                 $head_info $index_info \
1371                 ]
1372         return $state
1373 }
1374
1375 proc display_file_helper {w path icon_name old_m new_m} {
1376         global file_lists
1377
1378         if {$new_m eq {_}} {
1379                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1380                 if {$lno >= 0} {
1381                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1382                         incr lno
1383                         $w conf -state normal
1384                         $w delete $lno.0 [expr {$lno + 1}].0
1385                         $w conf -state disabled
1386                 }
1387         } elseif {$old_m eq {_} && $new_m ne {_}} {
1388                 lappend file_lists($w) $path
1389                 set file_lists($w) [lsort -unique $file_lists($w)]
1390                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1391                 incr lno
1392                 $w conf -state normal
1393                 $w image create $lno.0 \
1394                         -align center -padx 5 -pady 1 \
1395                         -name $icon_name \
1396                         -image [mapicon $w $new_m $path]
1397                 $w insert $lno.1 "[escape_path $path]\n"
1398                 $w conf -state disabled
1399         } elseif {$old_m ne $new_m} {
1400                 $w conf -state normal
1401                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1402                 $w conf -state disabled
1403         }
1404 }
1405
1406 proc display_file {path state} {
1407         global file_states selected_paths
1408         global ui_index ui_workdir
1409
1410         set old_m [merge_state $path $state]
1411         set s $file_states($path)
1412         set new_m [lindex $s 0]
1413         set icon_name [lindex $s 1]
1414
1415         set o [string index $old_m 0]
1416         set n [string index $new_m 0]
1417         if {$o eq {U}} {
1418                 set o _
1419         }
1420         if {$n eq {U}} {
1421                 set n _
1422         }
1423         display_file_helper     $ui_index $path $icon_name $o $n
1424
1425         if {[string index $old_m 0] eq {U}} {
1426                 set o U
1427         } else {
1428                 set o [string index $old_m 1]
1429         }
1430         if {[string index $new_m 0] eq {U}} {
1431                 set n U
1432         } else {
1433                 set n [string index $new_m 1]
1434         }
1435         display_file_helper     $ui_workdir $path $icon_name $o $n
1436
1437         if {$new_m eq {__}} {
1438                 unset file_states($path)
1439                 catch {unset selected_paths($path)}
1440         }
1441 }
1442
1443 proc display_all_files_helper {w path icon_name m} {
1444         global file_lists
1445
1446         lappend file_lists($w) $path
1447         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1448         $w image create end \
1449                 -align center -padx 5 -pady 1 \
1450                 -name $icon_name \
1451                 -image [mapicon $w $m $path]
1452         $w insert end "[escape_path $path]\n"
1453 }
1454
1455 proc display_all_files {} {
1456         global ui_index ui_workdir
1457         global file_states file_lists
1458         global last_clicked
1459
1460         $ui_index conf -state normal
1461         $ui_workdir conf -state normal
1462
1463         $ui_index delete 0.0 end
1464         $ui_workdir delete 0.0 end
1465         set last_clicked {}
1466
1467         set file_lists($ui_index) [list]
1468         set file_lists($ui_workdir) [list]
1469
1470         foreach path [lsort [array names file_states]] {
1471                 set s $file_states($path)
1472                 set m [lindex $s 0]
1473                 set icon_name [lindex $s 1]
1474
1475                 set s [string index $m 0]
1476                 if {$s ne {U} && $s ne {_}} {
1477                         display_all_files_helper $ui_index $path \
1478                                 $icon_name $s
1479                 }
1480
1481                 if {[string index $m 0] eq {U}} {
1482                         set s U
1483                 } else {
1484                         set s [string index $m 1]
1485                 }
1486                 if {$s ne {_}} {
1487                         display_all_files_helper $ui_workdir $path \
1488                                 $icon_name $s
1489                 }
1490         }
1491
1492         $ui_index conf -state disabled
1493         $ui_workdir conf -state disabled
1494 }
1495
1496 proc update_indexinfo {msg pathList after} {
1497         global update_index_cp ui_status_value
1498
1499         if {![lock_index update]} return
1500
1501         set update_index_cp 0
1502         set pathList [lsort $pathList]
1503         set totalCnt [llength $pathList]
1504         set batch [expr {int($totalCnt * .01) + 1}]
1505         if {$batch > 25} {set batch 25}
1506
1507         set ui_status_value [format \
1508                 "$msg... %i/%i files (%.2f%%)" \
1509                 $update_index_cp \
1510                 $totalCnt \
1511                 0.0]
1512         set fd [open "| git update-index -z --index-info" w]
1513         fconfigure $fd \
1514                 -blocking 0 \
1515                 -buffering full \
1516                 -buffersize 512 \
1517                 -encoding binary \
1518                 -translation binary
1519         fileevent $fd writable [list \
1520                 write_update_indexinfo \
1521                 $fd \
1522                 $pathList \
1523                 $totalCnt \
1524                 $batch \
1525                 $msg \
1526                 $after \
1527                 ]
1528 }
1529
1530 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1531         global update_index_cp ui_status_value
1532         global file_states current_diff_path
1533
1534         if {$update_index_cp >= $totalCnt} {
1535                 close $fd
1536                 unlock_index
1537                 uplevel #0 $after
1538                 return
1539         }
1540
1541         for {set i $batch} \
1542                 {$update_index_cp < $totalCnt && $i > 0} \
1543                 {incr i -1} {
1544                 set path [lindex $pathList $update_index_cp]
1545                 incr update_index_cp
1546
1547                 set s $file_states($path)
1548                 switch -glob -- [lindex $s 0] {
1549                 A? {set new _O}
1550                 M? {set new _M}
1551                 D_ {set new _D}
1552                 D? {set new _?}
1553                 ?? {continue}
1554                 }
1555                 set info [lindex $s 2]
1556                 if {$info eq {}} continue
1557
1558                 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1559                 display_file $path $new
1560         }
1561
1562         set ui_status_value [format \
1563                 "$msg... %i/%i files (%.2f%%)" \
1564                 $update_index_cp \
1565                 $totalCnt \
1566                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1567 }
1568
1569 proc update_index {msg pathList after} {
1570         global update_index_cp ui_status_value
1571
1572         if {![lock_index update]} return
1573
1574         set update_index_cp 0
1575         set pathList [lsort $pathList]
1576         set totalCnt [llength $pathList]
1577         set batch [expr {int($totalCnt * .01) + 1}]
1578         if {$batch > 25} {set batch 25}
1579
1580         set ui_status_value [format \
1581                 "$msg... %i/%i files (%.2f%%)" \
1582                 $update_index_cp \
1583                 $totalCnt \
1584                 0.0]
1585         set fd [open "| git update-index --add --remove -z --stdin" w]
1586         fconfigure $fd \
1587                 -blocking 0 \
1588                 -buffering full \
1589                 -buffersize 512 \
1590                 -encoding binary \
1591                 -translation binary
1592         fileevent $fd writable [list \
1593                 write_update_index \
1594                 $fd \
1595                 $pathList \
1596                 $totalCnt \
1597                 $batch \
1598                 $msg \
1599                 $after \
1600                 ]
1601 }
1602
1603 proc write_update_index {fd pathList totalCnt batch msg after} {
1604         global update_index_cp ui_status_value
1605         global file_states current_diff_path
1606
1607         if {$update_index_cp >= $totalCnt} {
1608                 close $fd
1609                 unlock_index
1610                 uplevel #0 $after
1611                 return
1612         }
1613
1614         for {set i $batch} \
1615                 {$update_index_cp < $totalCnt && $i > 0} \
1616                 {incr i -1} {
1617                 set path [lindex $pathList $update_index_cp]
1618                 incr update_index_cp
1619
1620                 switch -glob -- [lindex $file_states($path) 0] {
1621                 AD {set new __}
1622                 ?D {set new D_}
1623                 _O -
1624                 AM {set new A_}
1625                 U? {
1626                         if {[file exists $path]} {
1627                                 set new M_
1628                         } else {
1629                                 set new D_
1630                         }
1631                 }
1632                 ?M {set new M_}
1633                 ?? {continue}
1634                 }
1635                 puts -nonewline $fd "[encoding convertto $path]\0"
1636                 display_file $path $new
1637         }
1638
1639         set ui_status_value [format \
1640                 "$msg... %i/%i files (%.2f%%)" \
1641                 $update_index_cp \
1642                 $totalCnt \
1643                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1644 }
1645
1646 proc checkout_index {msg pathList after} {
1647         global update_index_cp ui_status_value
1648
1649         if {![lock_index update]} return
1650
1651         set update_index_cp 0
1652         set pathList [lsort $pathList]
1653         set totalCnt [llength $pathList]
1654         set batch [expr {int($totalCnt * .01) + 1}]
1655         if {$batch > 25} {set batch 25}
1656
1657         set ui_status_value [format \
1658                 "$msg... %i/%i files (%.2f%%)" \
1659                 $update_index_cp \
1660                 $totalCnt \
1661                 0.0]
1662         set cmd [list git checkout-index]
1663         lappend cmd --index
1664         lappend cmd --quiet
1665         lappend cmd --force
1666         lappend cmd -z
1667         lappend cmd --stdin
1668         set fd [open "| $cmd " w]
1669         fconfigure $fd \
1670                 -blocking 0 \
1671                 -buffering full \
1672                 -buffersize 512 \
1673                 -encoding binary \
1674                 -translation binary
1675         fileevent $fd writable [list \
1676                 write_checkout_index \
1677                 $fd \
1678                 $pathList \
1679                 $totalCnt \
1680                 $batch \
1681                 $msg \
1682                 $after \
1683                 ]
1684 }
1685
1686 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1687         global update_index_cp ui_status_value
1688         global file_states current_diff_path
1689
1690         if {$update_index_cp >= $totalCnt} {
1691                 close $fd
1692                 unlock_index
1693                 uplevel #0 $after
1694                 return
1695         }
1696
1697         for {set i $batch} \
1698                 {$update_index_cp < $totalCnt && $i > 0} \
1699                 {incr i -1} {
1700                 set path [lindex $pathList $update_index_cp]
1701                 incr update_index_cp
1702                 switch -glob -- [lindex $file_states($path) 0] {
1703                 U? {continue}
1704                 ?M -
1705                 ?D {
1706                         puts -nonewline $fd "[encoding convertto $path]\0"
1707                         display_file $path ?_
1708                 }
1709                 }
1710         }
1711
1712         set ui_status_value [format \
1713                 "$msg... %i/%i files (%.2f%%)" \
1714                 $update_index_cp \
1715                 $totalCnt \
1716                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1717 }
1718
1719 ######################################################################
1720 ##
1721 ## branch management
1722
1723 proc is_tracking_branch {name} {
1724         global tracking_branches
1725
1726         if {![catch {set info $tracking_branches($name)}]} {
1727                 return 1
1728         }
1729         foreach t [array names tracking_branches] {
1730                 if {[string match {*/\*} $t] && [string match $t $name]} {
1731                         return 1
1732                 }
1733         }
1734         return 0
1735 }
1736
1737 proc load_all_heads {} {
1738         global all_heads
1739
1740         set all_heads [list]
1741         set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1742         while {[gets $fd line] > 0} {
1743                 if {[is_tracking_branch $line]} continue
1744                 if {![regsub ^refs/heads/ $line {} name]} continue
1745                 lappend all_heads $name
1746         }
1747         close $fd
1748
1749         set all_heads [lsort $all_heads]
1750 }
1751
1752 proc populate_branch_menu {} {
1753         global all_heads disable_on_lock
1754
1755         set m .mbar.branch
1756         set last [$m index last]
1757         for {set i 0} {$i <= $last} {incr i} {
1758                 if {[$m type $i] eq {separator}} {
1759                         $m delete $i last
1760                         set new_dol [list]
1761                         foreach a $disable_on_lock {
1762                                 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1763                                         lappend new_dol $a
1764                                 }
1765                         }
1766                         set disable_on_lock $new_dol
1767                         break
1768                 }
1769         }
1770
1771         if {$all_heads ne {}} {
1772                 $m add separator
1773         }
1774         foreach b $all_heads {
1775                 $m add radiobutton \
1776                         -label $b \
1777                         -command [list switch_branch $b] \
1778                         -variable current_branch \
1779                         -value $b \
1780                         -font font_ui
1781                 lappend disable_on_lock \
1782                         [list $m entryconf [$m index last] -state]
1783         }
1784 }
1785
1786 proc all_tracking_branches {} {
1787         global tracking_branches
1788
1789         set all_trackings {}
1790         set cmd {}
1791         foreach name [array names tracking_branches] {
1792                 if {[regsub {/\*$} $name {} name]} {
1793                         lappend cmd $name
1794                 } else {
1795                         regsub ^refs/(heads|remotes)/ $name {} name
1796                         lappend all_trackings $name
1797                 }
1798         }
1799
1800         if {$cmd ne {}} {
1801                 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1802                 while {[gets $fd name] > 0} {
1803                         regsub ^refs/(heads|remotes)/ $name {} name
1804                         lappend all_trackings $name
1805                 }
1806                 close $fd
1807         }
1808
1809         return [lsort -unique $all_trackings]
1810 }
1811
1812 proc do_create_branch_action {w} {
1813         global all_heads null_sha1 repo_config
1814         global create_branch_checkout create_branch_revtype
1815         global create_branch_head create_branch_trackinghead
1816         global create_branch_name create_branch_revexp
1817
1818         set newbranch $create_branch_name
1819         if {$newbranch eq {}
1820                 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1821                 tk_messageBox \
1822                         -icon error \
1823                         -type ok \
1824                         -title [wm title $w] \
1825                         -parent $w \
1826                         -message "Please supply a branch name."
1827                 focus $w.desc.name_t
1828                 return
1829         }
1830         if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1831                 tk_messageBox \
1832                         -icon error \
1833                         -type ok \
1834                         -title [wm title $w] \
1835                         -parent $w \
1836                         -message "Branch '$newbranch' already exists."
1837                 focus $w.desc.name_t
1838                 return
1839         }
1840         if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1841                 tk_messageBox \
1842                         -icon error \
1843                         -type ok \
1844                         -title [wm title $w] \
1845                         -parent $w \
1846                         -message "We do not like '$newbranch' as a branch name."
1847                 focus $w.desc.name_t
1848                 return
1849         }
1850
1851         set rev {}
1852         switch -- $create_branch_revtype {
1853         head {set rev $create_branch_head}
1854         tracking {set rev $create_branch_trackinghead}
1855         expression {set rev $create_branch_revexp}
1856         }
1857         if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1858                 tk_messageBox \
1859                         -icon error \
1860                         -type ok \
1861                         -title [wm title $w] \
1862                         -parent $w \
1863                         -message "Invalid starting revision: $rev"
1864                 return
1865         }
1866         set cmd [list git update-ref]
1867         lappend cmd -m
1868         lappend cmd "branch: Created from $rev"
1869         lappend cmd "refs/heads/$newbranch"
1870         lappend cmd $cmt
1871         lappend cmd $null_sha1
1872         if {[catch {eval exec $cmd} err]} {
1873                 tk_messageBox \
1874                         -icon error \
1875                         -type ok \
1876                         -title [wm title $w] \
1877                         -parent $w \
1878                         -message "Failed to create '$newbranch'.\n\n$err"
1879                 return
1880         }
1881
1882         lappend all_heads $newbranch
1883         set all_heads [lsort $all_heads]
1884         populate_branch_menu
1885         destroy $w
1886         if {$create_branch_checkout} {
1887                 switch_branch $newbranch
1888         }
1889 }
1890
1891 proc radio_selector {varname value args} {
1892         upvar #0 $varname var
1893         set var $value
1894 }
1895
1896 trace add variable create_branch_head write \
1897         [list radio_selector create_branch_revtype head]
1898 trace add variable create_branch_trackinghead write \
1899         [list radio_selector create_branch_revtype tracking]
1900
1901 trace add variable delete_branch_head write \
1902         [list radio_selector delete_branch_checktype head]
1903 trace add variable delete_branch_trackinghead write \
1904         [list radio_selector delete_branch_checktype tracking]
1905
1906 proc do_create_branch {} {
1907         global all_heads current_branch repo_config
1908         global create_branch_checkout create_branch_revtype
1909         global create_branch_head create_branch_trackinghead
1910         global create_branch_name create_branch_revexp
1911
1912         set w .branch_editor
1913         toplevel $w
1914         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1915
1916         label $w.header -text {Create New Branch} \
1917                 -font font_uibold
1918         pack $w.header -side top -fill x
1919
1920         frame $w.buttons
1921         button $w.buttons.create -text Create \
1922                 -font font_ui \
1923                 -default active \
1924                 -command [list do_create_branch_action $w]
1925         pack $w.buttons.create -side right
1926         button $w.buttons.cancel -text {Cancel} \
1927                 -font font_ui \
1928                 -command [list destroy $w]
1929         pack $w.buttons.cancel -side right -padx 5
1930         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1931
1932         labelframe $w.desc \
1933                 -text {Branch Description} \
1934                 -font font_ui
1935         label $w.desc.name_l -text {Name:} -font font_ui
1936         entry $w.desc.name_t \
1937                 -borderwidth 1 \
1938                 -relief sunken \
1939                 -width 40 \
1940                 -textvariable create_branch_name \
1941                 -font font_ui \
1942                 -validate key \
1943                 -validatecommand {
1944                         if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
1945                         return 1
1946                 }
1947         grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
1948         grid columnconfigure $w.desc 1 -weight 1
1949         pack $w.desc -anchor nw -fill x -pady 5 -padx 5
1950
1951         labelframe $w.from \
1952                 -text {Starting Revision} \
1953                 -font font_ui
1954         radiobutton $w.from.head_r \
1955                 -text {Local Branch:} \
1956                 -value head \
1957                 -variable create_branch_revtype \
1958                 -font font_ui
1959         eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
1960         grid $w.from.head_r $w.from.head_m -sticky w
1961         set all_trackings [all_tracking_branches]
1962         if {$all_trackings ne {}} {
1963                 set create_branch_trackinghead [lindex $all_trackings 0]
1964                 radiobutton $w.from.tracking_r \
1965                         -text {Tracking Branch:} \
1966                         -value tracking \
1967                         -variable create_branch_revtype \
1968                         -font font_ui
1969                 eval tk_optionMenu $w.from.tracking_m \
1970                         create_branch_trackinghead \
1971                         $all_trackings
1972                 grid $w.from.tracking_r $w.from.tracking_m -sticky w
1973         }
1974         radiobutton $w.from.exp_r \
1975                 -text {Revision Expression:} \
1976                 -value expression \
1977                 -variable create_branch_revtype \
1978                 -font font_ui
1979         entry $w.from.exp_t \
1980                 -borderwidth 1 \
1981                 -relief sunken \
1982                 -width 50 \
1983                 -textvariable create_branch_revexp \
1984                 -font font_ui \
1985                 -validate key \
1986                 -validatecommand {
1987                         if {%d == 1 && [regexp {\s} %S]} {return 0}
1988                         if {%d == 1 && [string length %S] > 0} {
1989                                 set create_branch_revtype expression
1990                         }
1991                         return 1
1992                 }
1993         grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
1994         grid columnconfigure $w.from 1 -weight 1
1995         pack $w.from -anchor nw -fill x -pady 5 -padx 5
1996
1997         labelframe $w.postActions \
1998                 -text {Post Creation Actions} \
1999                 -font font_ui
2000         checkbutton $w.postActions.checkout \
2001                 -text {Checkout after creation} \
2002                 -variable create_branch_checkout \
2003                 -font font_ui
2004         pack $w.postActions.checkout -anchor nw
2005         pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2006
2007         set create_branch_checkout 1
2008         set create_branch_head $current_branch
2009         set create_branch_revtype head
2010         set create_branch_name $repo_config(gui.newbranchtemplate)
2011         set create_branch_revexp {}
2012
2013         bind $w <Visibility> "
2014                 grab $w
2015                 $w.desc.name_t icursor end
2016                 focus $w.desc.name_t
2017         "
2018         bind $w <Key-Escape> "destroy $w"
2019         bind $w <Key-Return> "do_create_branch_action $w;break"
2020         wm title $w "[appname] ([reponame]): Create Branch"
2021         tkwait window $w
2022 }
2023
2024 proc do_delete_branch_action {w} {
2025         global all_heads
2026         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2027
2028         set check_rev {}
2029         switch -- $delete_branch_checktype {
2030         head {set check_rev $delete_branch_head}
2031         tracking {set check_rev $delete_branch_trackinghead}
2032         always {set check_rev {:none}}
2033         }
2034         if {$check_rev eq {:none}} {
2035                 set check_cmt {}
2036         } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2037                 tk_messageBox \
2038                         -icon error \
2039                         -type ok \
2040                         -title [wm title $w] \
2041                         -parent $w \
2042                         -message "Invalid check revision: $check_rev"
2043                 return
2044         }
2045
2046         set to_delete [list]
2047         set not_merged [list]
2048         foreach i [$w.list.l curselection] {
2049                 set b [$w.list.l get $i]
2050                 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2051                 if {$check_cmt ne {}} {
2052                         if {$b eq $check_rev} continue
2053                         if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2054                         if {$o ne $m} {
2055                                 lappend not_merged $b
2056                                 continue
2057                         }
2058                 }
2059                 lappend to_delete [list $b $o]
2060         }
2061         if {$not_merged ne {}} {
2062                 set msg "The following branches are not completely merged into $check_rev:
2063
2064  - [join $not_merged "\n - "]"
2065                 tk_messageBox \
2066                         -icon info \
2067                         -type ok \
2068                         -title [wm title $w] \
2069                         -parent $w \
2070                         -message $msg
2071         }
2072         if {$to_delete eq {}} return
2073         if {$delete_branch_checktype eq {always}} {
2074                 set msg {Recovering deleted branches is difficult.
2075
2076 Delete the selected branches?}
2077                 if {[tk_messageBox \
2078                         -icon warning \
2079                         -type yesno \
2080                         -title [wm title $w] \
2081                         -parent $w \
2082                         -message $msg] ne yes} {
2083                         return
2084                 }
2085         }
2086
2087         set failed {}
2088         foreach i $to_delete {
2089                 set b [lindex $i 0]
2090                 set o [lindex $i 1]
2091                 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2092                         append failed " - $b: $err\n"
2093                 } else {
2094                         set x [lsearch -sorted -exact $all_heads $b]
2095                         if {$x >= 0} {
2096                                 set all_heads [lreplace $all_heads $x $x]
2097                         }
2098                 }
2099         }
2100
2101         if {$failed ne {}} {
2102                 tk_messageBox \
2103                         -icon error \
2104                         -type ok \
2105                         -title [wm title $w] \
2106                         -parent $w \
2107                         -message "Failed to delete branches:\n$failed"
2108         }
2109
2110         set all_heads [lsort $all_heads]
2111         populate_branch_menu
2112         destroy $w
2113 }
2114
2115 proc do_delete_branch {} {
2116         global all_heads tracking_branches current_branch
2117         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2118
2119         set w .branch_editor
2120         toplevel $w
2121         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2122
2123         label $w.header -text {Delete Local Branch} \
2124                 -font font_uibold
2125         pack $w.header -side top -fill x
2126
2127         frame $w.buttons
2128         button $w.buttons.create -text Delete \
2129                 -font font_ui \
2130                 -command [list do_delete_branch_action $w]
2131         pack $w.buttons.create -side right
2132         button $w.buttons.cancel -text {Cancel} \
2133                 -font font_ui \
2134                 -command [list destroy $w]
2135         pack $w.buttons.cancel -side right -padx 5
2136         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2137
2138         labelframe $w.list \
2139                 -text {Local Branches} \
2140                 -font font_ui
2141         listbox $w.list.l \
2142                 -height 10 \
2143                 -width 70 \
2144                 -selectmode extended \
2145                 -yscrollcommand [list $w.list.sby set] \
2146                 -font font_ui
2147         foreach h $all_heads {
2148                 if {$h ne $current_branch} {
2149                         $w.list.l insert end $h
2150                 }
2151         }
2152         scrollbar $w.list.sby -command [list $w.list.l yview]
2153         pack $w.list.sby -side right -fill y
2154         pack $w.list.l -side left -fill both -expand 1
2155         pack $w.list -fill both -expand 1 -pady 5 -padx 5
2156
2157         labelframe $w.validate \
2158                 -text {Delete Only If} \
2159                 -font font_ui
2160         radiobutton $w.validate.head_r \
2161                 -text {Merged Into Local Branch:} \
2162                 -value head \
2163                 -variable delete_branch_checktype \
2164                 -font font_ui
2165         eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2166         grid $w.validate.head_r $w.validate.head_m -sticky w
2167         set all_trackings [all_tracking_branches]
2168         if {$all_trackings ne {}} {
2169                 set delete_branch_trackinghead [lindex $all_trackings 0]
2170                 radiobutton $w.validate.tracking_r \
2171                         -text {Merged Into Tracking Branch:} \
2172                         -value tracking \
2173                         -variable delete_branch_checktype \
2174                         -font font_ui
2175                 eval tk_optionMenu $w.validate.tracking_m \
2176                         delete_branch_trackinghead \
2177                         $all_trackings
2178                 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2179         }
2180         radiobutton $w.validate.always_r \
2181                 -text {Always (Do not perform merge checks)} \
2182                 -value always \
2183                 -variable delete_branch_checktype \
2184                 -font font_ui
2185         grid $w.validate.always_r -columnspan 2 -sticky w
2186         grid columnconfigure $w.validate 1 -weight 1
2187         pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2188
2189         set delete_branch_head $current_branch
2190         set delete_branch_checktype head
2191
2192         bind $w <Visibility> "grab $w; focus $w"
2193         bind $w <Key-Escape> "destroy $w"
2194         wm title $w "[appname] ([reponame]): Delete Branch"
2195         tkwait window $w
2196 }
2197
2198 proc switch_branch {new_branch} {
2199         global HEAD commit_type current_branch repo_config
2200
2201         if {![lock_index switch]} return
2202
2203         # -- Our in memory state should match the repository.
2204         #
2205         repository_state curType curHEAD curMERGE_HEAD
2206         if {[string match amend* $commit_type]
2207                 && $curType eq {normal}
2208                 && $curHEAD eq $HEAD} {
2209         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2210                 info_popup {Last scanned state does not match repository state.
2211
2212 Another Git program has modified this repository
2213 since the last scan.  A rescan must be performed
2214 before the current branch can be changed.
2215
2216 The rescan will be automatically started now.
2217 }
2218                 unlock_index
2219                 rescan {set ui_status_value {Ready.}}
2220                 return
2221         }
2222
2223         # -- Don't do a pointless switch.
2224         #
2225         if {$current_branch eq $new_branch} {
2226                 unlock_index
2227                 return
2228         }
2229
2230         if {$repo_config(gui.trustmtime) eq {true}} {
2231                 switch_branch_stage2 {} $new_branch
2232         } else {
2233                 set ui_status_value {Refreshing file status...}
2234                 set cmd [list git update-index]
2235                 lappend cmd -q
2236                 lappend cmd --unmerged
2237                 lappend cmd --ignore-missing
2238                 lappend cmd --refresh
2239                 set fd_rf [open "| $cmd" r]
2240                 fconfigure $fd_rf -blocking 0 -translation binary
2241                 fileevent $fd_rf readable \
2242                         [list switch_branch_stage2 $fd_rf $new_branch]
2243         }
2244 }
2245
2246 proc switch_branch_stage2 {fd_rf new_branch} {
2247         global ui_status_value HEAD
2248
2249         if {$fd_rf ne {}} {
2250                 read $fd_rf
2251                 if {![eof $fd_rf]} return
2252                 close $fd_rf
2253         }
2254
2255         set ui_status_value "Updating working directory to '$new_branch'..."
2256         set cmd [list git read-tree]
2257         lappend cmd -m
2258         lappend cmd -u
2259         lappend cmd --exclude-per-directory=.gitignore
2260         lappend cmd $HEAD
2261         lappend cmd $new_branch
2262         set fd_rt [open "| $cmd" r]
2263         fconfigure $fd_rt -blocking 0 -translation binary
2264         fileevent $fd_rt readable \
2265                 [list switch_branch_readtree_wait $fd_rt $new_branch]
2266 }
2267
2268 proc switch_branch_readtree_wait {fd_rt new_branch} {
2269         global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2270         global current_branch
2271         global ui_comm ui_status_value
2272
2273         # -- We never get interesting output on stdout; only stderr.
2274         #
2275         read $fd_rt
2276         fconfigure $fd_rt -blocking 1
2277         if {![eof $fd_rt]} {
2278                 fconfigure $fd_rt -blocking 0
2279                 return
2280         }
2281
2282         # -- The working directory wasn't in sync with the index and
2283         #    we'd have to overwrite something to make the switch. A
2284         #    merge is required.
2285         #
2286         if {[catch {close $fd_rt} err]} {
2287                 regsub {^fatal: } $err {} err
2288                 warn_popup "File level merge required.
2289
2290 $err
2291
2292 Staying on branch '$current_branch'."
2293                 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2294                 unlock_index
2295                 return
2296         }
2297
2298         # -- Update the symbolic ref.  Core git doesn't even check for failure
2299         #    here, it Just Works(tm).  If it doesn't we are in some really ugly
2300         #    state that is difficult to recover from within git-gui.
2301         #
2302         if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2303                 error_popup "Failed to set current branch.
2304
2305 This working directory is only partially switched.
2306 We successfully updated your files, but failed to
2307 update an internal Git file.
2308
2309 This should not have occurred.  [appname] will now
2310 close and give up.
2311
2312 $err"
2313                 do_quit
2314                 return
2315         }
2316
2317         # -- Update our repository state.  If we were previously in amend mode
2318         #    we need to toss the current buffer and do a full rescan to update
2319         #    our file lists.  If we weren't in amend mode our file lists are
2320         #    accurate and we can avoid the rescan.
2321         #
2322         unlock_index
2323         set selected_commit_type new
2324         if {[string match amend* $commit_type]} {
2325                 $ui_comm delete 0.0 end
2326                 $ui_comm edit reset
2327                 $ui_comm edit modified false
2328                 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2329         } else {
2330                 repository_state commit_type HEAD MERGE_HEAD
2331                 set PARENT $HEAD
2332                 set ui_status_value "Checked out branch '$current_branch'."
2333         }
2334 }
2335
2336 ######################################################################
2337 ##
2338 ## remote management
2339
2340 proc load_all_remotes {} {
2341         global repo_config
2342         global all_remotes tracking_branches
2343
2344         set all_remotes [list]
2345         array unset tracking_branches
2346
2347         set rm_dir [gitdir remotes]
2348         if {[file isdirectory $rm_dir]} {
2349                 set all_remotes [glob \
2350                         -types f \
2351                         -tails \
2352                         -nocomplain \
2353                         -directory $rm_dir *]
2354
2355                 foreach name $all_remotes {
2356                         catch {
2357                                 set fd [open [file join $rm_dir $name] r]
2358                                 while {[gets $fd line] >= 0} {
2359                                         if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2360                                                 $line line src dst]} continue
2361                                         if {![regexp ^refs/ $dst]} {
2362                                                 set dst "refs/heads/$dst"
2363                                         }
2364                                         set tracking_branches($dst) [list $name $src]
2365                                 }
2366                                 close $fd
2367                         }
2368                 }
2369         }
2370
2371         foreach line [array names repo_config remote.*.url] {
2372                 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2373                 lappend all_remotes $name
2374
2375                 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2376                         set fl {}
2377                 }
2378                 foreach line $fl {
2379                         if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2380                         if {![regexp ^refs/ $dst]} {
2381                                 set dst "refs/heads/$dst"
2382                         }
2383                         set tracking_branches($dst) [list $name $src]
2384                 }
2385         }
2386
2387         set all_remotes [lsort -unique $all_remotes]
2388 }
2389
2390 proc populate_fetch_menu {} {
2391         global all_remotes repo_config
2392
2393         set m .mbar.fetch
2394         foreach r $all_remotes {
2395                 set enable 0
2396                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2397                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2398                                 set enable 1
2399                         }
2400                 } else {
2401                         catch {
2402                                 set fd [open [gitdir remotes $r] r]
2403                                 while {[gets $fd n] >= 0} {
2404                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2405                                                 set enable 1
2406                                                 break
2407                                         }
2408                                 }
2409                                 close $fd
2410                         }
2411                 }
2412
2413                 if {$enable} {
2414                         $m add command \
2415                                 -label "Fetch from $r..." \
2416                                 -command [list fetch_from $r] \
2417                                 -font font_ui
2418                 }
2419         }
2420 }
2421
2422 proc populate_push_menu {} {
2423         global all_remotes repo_config
2424
2425         set m .mbar.push
2426         set fast_count 0
2427         foreach r $all_remotes {
2428                 set enable 0
2429                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2430                         if {![catch {set a $repo_config(remote.$r.push)}]} {
2431                                 set enable 1
2432                         }
2433                 } else {
2434                         catch {
2435                                 set fd [open [gitdir remotes $r] r]
2436                                 while {[gets $fd n] >= 0} {
2437                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2438                                                 set enable 1
2439                                                 break
2440                                         }
2441                                 }
2442                                 close $fd
2443                         }
2444                 }
2445
2446                 if {$enable} {
2447                         if {!$fast_count} {
2448                                 $m add separator
2449                         }
2450                         $m add command \
2451                                 -label "Push to $r..." \
2452                                 -command [list push_to $r] \
2453                                 -font font_ui
2454                         incr fast_count
2455                 }
2456         }
2457 }
2458
2459 proc start_push_anywhere_action {w} {
2460         global push_urltype push_remote push_url push_thin push_tags
2461
2462         set r_url {}
2463         switch -- $push_urltype {
2464         remote {set r_url $push_remote}
2465         url {set r_url $push_url}
2466         }
2467         if {$r_url eq {}} return
2468
2469         set cmd [list git push]
2470         lappend cmd -v
2471         if {$push_thin} {
2472                 lappend cmd --thin
2473         }
2474         if {$push_tags} {
2475                 lappend cmd --tags
2476         }
2477         lappend cmd $r_url
2478         set cnt 0
2479         foreach i [$w.source.l curselection] {
2480                 set b [$w.source.l get $i]
2481                 lappend cmd "refs/heads/$b:refs/heads/$b"
2482                 incr cnt
2483         }
2484         if {$cnt == 0} {
2485                 return
2486         } elseif {$cnt == 1} {
2487                 set unit branch
2488         } else {
2489                 set unit branches
2490         }
2491
2492         set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2493         console_exec $cons $cmd console_done
2494         destroy $w
2495 }
2496
2497 trace add variable push_remote write \
2498         [list radio_selector push_urltype remote]
2499
2500 proc do_push_anywhere {} {
2501         global all_heads all_remotes current_branch
2502         global push_urltype push_remote push_url push_thin push_tags
2503
2504         set w .push_setup
2505         toplevel $w
2506         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2507
2508         label $w.header -text {Push Branches} -font font_uibold
2509         pack $w.header -side top -fill x
2510
2511         frame $w.buttons
2512         button $w.buttons.create -text Push \
2513                 -font font_ui \
2514                 -command [list start_push_anywhere_action $w]
2515         pack $w.buttons.create -side right
2516         button $w.buttons.cancel -text {Cancel} \
2517                 -font font_ui \
2518                 -command [list destroy $w]
2519         pack $w.buttons.cancel -side right -padx 5
2520         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2521
2522         labelframe $w.source \
2523                 -text {Source Branches} \
2524                 -font font_ui
2525         listbox $w.source.l \
2526                 -height 10 \
2527                 -width 70 \
2528                 -selectmode extended \
2529                 -yscrollcommand [list $w.source.sby set] \
2530                 -font font_ui
2531         foreach h $all_heads {
2532                 $w.source.l insert end $h
2533                 if {$h eq $current_branch} {
2534                         $w.source.l select set end
2535                 }
2536         }
2537         scrollbar $w.source.sby -command [list $w.source.l yview]
2538         pack $w.source.sby -side right -fill y
2539         pack $w.source.l -side left -fill both -expand 1
2540         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2541
2542         labelframe $w.dest \
2543                 -text {Destination Repository} \
2544                 -font font_ui
2545         if {$all_remotes ne {}} {
2546                 radiobutton $w.dest.remote_r \
2547                         -text {Remote:} \
2548                         -value remote \
2549                         -variable push_urltype \
2550                         -font font_ui
2551                 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2552                 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2553                 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2554                         set push_remote origin
2555                 } else {
2556                         set push_remote [lindex $all_remotes 0]
2557                 }
2558                 set push_urltype remote
2559         } else {
2560                 set push_urltype url
2561         }
2562         radiobutton $w.dest.url_r \
2563                 -text {Arbitrary URL:} \
2564                 -value url \
2565                 -variable push_urltype \
2566                 -font font_ui
2567         entry $w.dest.url_t \
2568                 -borderwidth 1 \
2569                 -relief sunken \
2570                 -width 50 \
2571                 -textvariable push_url \
2572                 -font font_ui \
2573                 -validate key \
2574                 -validatecommand {
2575                         if {%d == 1 && [regexp {\s} %S]} {return 0}
2576                         if {%d == 1 && [string length %S] > 0} {
2577                                 set push_urltype url
2578                         }
2579                         return 1
2580                 }
2581         grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2582         grid columnconfigure $w.dest 1 -weight 1
2583         pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2584
2585         labelframe $w.options \
2586                 -text {Transfer Options} \
2587                 -font font_ui
2588         checkbutton $w.options.thin \
2589                 -text {Use thin pack (for slow network connections)} \
2590                 -variable push_thin \
2591                 -font font_ui
2592         grid $w.options.thin -columnspan 2 -sticky w
2593         checkbutton $w.options.tags \
2594                 -text {Include tags} \
2595                 -variable push_tags \
2596                 -font font_ui
2597         grid $w.options.tags -columnspan 2 -sticky w
2598         grid columnconfigure $w.options 1 -weight 1
2599         pack $w.options -anchor nw -fill x -pady 5 -padx 5
2600
2601         set push_url {}
2602         set push_thin 0
2603         set push_tags 0
2604
2605         bind $w <Visibility> "grab $w"
2606         bind $w <Key-Escape> "destroy $w"
2607         wm title $w "[appname] ([reponame]): Push"
2608         tkwait window $w
2609 }
2610
2611 ######################################################################
2612 ##
2613 ## merge
2614
2615 proc can_merge {} {
2616         global HEAD commit_type file_states
2617
2618         if {[string match amend* $commit_type]} {
2619                 info_popup {Cannot merge while amending.
2620
2621 You must finish amending this commit before
2622 starting any type of merge.
2623 }
2624                 return 0
2625         }
2626
2627         if {[committer_ident] eq {}} {return 0}
2628         if {![lock_index merge]} {return 0}
2629
2630         # -- Our in memory state should match the repository.
2631         #
2632         repository_state curType curHEAD curMERGE_HEAD
2633         if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2634                 info_popup {Last scanned state does not match repository state.
2635
2636 Another Git program has modified this repository
2637 since the last scan.  A rescan must be performed
2638 before a merge can be performed.
2639
2640 The rescan will be automatically started now.
2641 }
2642                 unlock_index
2643                 rescan {set ui_status_value {Ready.}}
2644                 return 0
2645         }
2646
2647         foreach path [array names file_states] {
2648                 switch -glob -- [lindex $file_states($path) 0] {
2649                 _O {
2650                         continue; # and pray it works!
2651                 }
2652                 U? {
2653                         error_popup "You are in the middle of a conflicted merge.
2654
2655 File [short_path $path] has merge conflicts.
2656
2657 You must resolve them, add the file, and commit to
2658 complete the current merge.  Only then can you
2659 begin another merge.
2660 "
2661                         unlock_index
2662                         return 0
2663                 }
2664                 ?? {
2665                         error_popup "You are in the middle of a change.
2666
2667 File [short_path $path] is modified.
2668
2669 You should complete the current commit before
2670 starting a merge.  Doing so will help you abort
2671 a failed merge, should the need arise.
2672 "
2673                         unlock_index
2674                         return 0
2675                 }
2676                 }
2677         }
2678
2679         return 1
2680 }
2681
2682 proc visualize_local_merge {w} {
2683         set revs {}
2684         foreach i [$w.source.l curselection] {
2685                 lappend revs [$w.source.l get $i]
2686         }
2687         if {$revs eq {}} return
2688         lappend revs --not HEAD
2689         do_gitk $revs
2690 }
2691
2692 proc start_local_merge_action {w} {
2693         global HEAD ui_status_value current_branch
2694
2695         set cmd [list git merge]
2696         set names {}
2697         set revcnt 0
2698         foreach i [$w.source.l curselection] {
2699                 set b [$w.source.l get $i]
2700                 lappend cmd $b
2701                 lappend names $b
2702                 incr revcnt
2703         }
2704
2705         if {$revcnt == 0} {
2706                 return
2707         } elseif {$revcnt == 1} {
2708                 set unit branch
2709         } elseif {$revcnt <= 15} {
2710                 set unit branches
2711         } else {
2712                 tk_messageBox \
2713                         -icon error \
2714                         -type ok \
2715                         -title [wm title $w] \
2716                         -parent $w \
2717                         -message "Too many branches selected.
2718
2719 You have requested to merge $revcnt branches
2720 in an octopus merge.  This exceeds Git's
2721 internal limit of 15 branches per merge.
2722
2723 Please select fewer branches.  To merge more
2724 than 15 branches, merge the branches in batches.
2725 "
2726                 return
2727         }
2728
2729         set msg "Merging $current_branch, [join $names {, }]"
2730         set ui_status_value "$msg..."
2731         set cons [new_console "Merge" $msg]
2732         console_exec $cons $cmd [list finish_merge $revcnt]
2733         bind $w <Destroy> {}
2734         destroy $w
2735 }
2736
2737 proc finish_merge {revcnt w ok} {
2738         console_done $w $ok
2739         if {$ok} {
2740                 set msg {Merge completed successfully.}
2741         } else {
2742                 if {$revcnt != 1} {
2743                         info_popup "Octopus merge failed.
2744
2745 Your merge of $revcnt branches has failed.
2746
2747 There are file-level conflicts between the
2748 branches which must be resolved manually.
2749
2750 The working directory will now be reset.
2751
2752 You can attempt this merge again
2753 by merging only one branch at a time." $w
2754
2755                         set fd [open "| git read-tree --reset -u HEAD" r]
2756                         fconfigure $fd -blocking 0 -translation binary
2757                         fileevent $fd readable [list reset_hard_wait $fd]
2758                         set ui_status_value {Aborting... please wait...}
2759                         return
2760                 }
2761
2762                 set msg {Merge failed.  Conflict resolution is required.}
2763         }
2764         unlock_index
2765         rescan [list set ui_status_value $msg]
2766 }
2767
2768 proc do_local_merge {} {
2769         global current_branch
2770
2771         if {![can_merge]} return
2772
2773         set w .merge_setup
2774         toplevel $w
2775         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2776
2777         label $w.header \
2778                 -text "Merge Into $current_branch" \
2779                 -font font_uibold
2780         pack $w.header -side top -fill x
2781
2782         frame $w.buttons
2783         button $w.buttons.visualize -text Visualize \
2784                 -font font_ui \
2785                 -command [list visualize_local_merge $w]
2786         pack $w.buttons.visualize -side left
2787         button $w.buttons.create -text Merge \
2788                 -font font_ui \
2789                 -command [list start_local_merge_action $w]
2790         pack $w.buttons.create -side right
2791         button $w.buttons.cancel -text {Cancel} \
2792                 -font font_ui \
2793                 -command [list destroy $w]
2794         pack $w.buttons.cancel -side right -padx 5
2795         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2796
2797         labelframe $w.source \
2798                 -text {Source Branches} \
2799                 -font font_ui
2800         listbox $w.source.l \
2801                 -height 10 \
2802                 -width 70 \
2803                 -selectmode extended \
2804                 -yscrollcommand [list $w.source.sby set] \
2805                 -font font_ui
2806         scrollbar $w.source.sby -command [list $w.source.l yview]
2807         pack $w.source.sby -side right -fill y
2808         pack $w.source.l -side left -fill both -expand 1
2809         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2810
2811         set cmd [list git for-each-ref]
2812         lappend cmd {--format=%(objectname) %(refname)}
2813         lappend cmd refs/heads
2814         lappend cmd refs/remotes
2815         set fr_fd [open "| $cmd" r]
2816         fconfigure $fr_fd -translation binary
2817         while {[gets $fr_fd line] > 0} {
2818                 set line [split $line { }]
2819                 set sha1([lindex $line 0]) [lindex $line 1]
2820         }
2821         close $fr_fd
2822
2823         set to_show {}
2824         set fr_fd [open "| git rev-list --all --not HEAD"]
2825         while {[gets $fr_fd line] > 0} {
2826                 if {[catch {set ref $sha1($line)}]} continue
2827                 regsub ^refs/(heads|remotes)/ $ref {} ref
2828                 lappend to_show $ref
2829         }
2830         close $fr_fd
2831
2832         foreach ref [lsort -unique $to_show] {
2833                 $w.source.l insert end $ref
2834         }
2835
2836         bind $w <Visibility> "grab $w"
2837         bind $w <Key-Escape> "unlock_index;destroy $w"
2838         bind $w <Destroy> unlock_index
2839         wm title $w "[appname] ([reponame]): Merge"
2840         tkwait window $w
2841 }
2842
2843 proc do_reset_hard {} {
2844         global HEAD commit_type file_states
2845
2846         if {[string match amend* $commit_type]} {
2847                 info_popup {Cannot abort while amending.
2848
2849 You must finish amending this commit.
2850 }
2851                 return
2852         }
2853
2854         if {![lock_index abort]} return
2855
2856         if {[string match *merge* $commit_type]} {
2857                 set op merge
2858         } else {
2859                 set op commit
2860         }
2861
2862         if {[ask_popup "Abort $op?
2863
2864 Aborting the current $op will cause
2865 *ALL* uncommitted changes to be lost.
2866
2867 Continue with aborting the current $op?"] eq {yes}} {
2868                 set fd [open "| git read-tree --reset -u HEAD" r]
2869                 fconfigure $fd -blocking 0 -translation binary
2870                 fileevent $fd readable [list reset_hard_wait $fd]
2871                 set ui_status_value {Aborting... please wait...}
2872         } else {
2873                 unlock_index
2874         }
2875 }
2876
2877 proc reset_hard_wait {fd} {
2878         global ui_comm
2879
2880         read $fd
2881         if {[eof $fd]} {
2882                 close $fd
2883                 unlock_index
2884
2885                 $ui_comm delete 0.0 end
2886                 $ui_comm edit modified false
2887
2888                 catch {file delete [gitdir MERGE_HEAD]}
2889                 catch {file delete [gitdir rr-cache MERGE_RR]}
2890                 catch {file delete [gitdir SQUASH_MSG]}
2891                 catch {file delete [gitdir MERGE_MSG]}
2892                 catch {file delete [gitdir GITGUI_MSG]}
2893
2894                 rescan {set ui_status_value {Abort completed.  Ready.}}
2895         }
2896 }
2897
2898 ######################################################################
2899 ##
2900 ## icons
2901
2902 set filemask {
2903 #define mask_width 14
2904 #define mask_height 15
2905 static unsigned char mask_bits[] = {
2906    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2907    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2908    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2909 }
2910
2911 image create bitmap file_plain -background white -foreground black -data {
2912 #define plain_width 14
2913 #define plain_height 15
2914 static unsigned char plain_bits[] = {
2915    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2916    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2917    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2918 } -maskdata $filemask
2919
2920 image create bitmap file_mod -background white -foreground blue -data {
2921 #define mod_width 14
2922 #define mod_height 15
2923 static unsigned char mod_bits[] = {
2924    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2925    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2926    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2927 } -maskdata $filemask
2928
2929 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2930 #define file_fulltick_width 14
2931 #define file_fulltick_height 15
2932 static unsigned char file_fulltick_bits[] = {
2933    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2934    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2935    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2936 } -maskdata $filemask
2937
2938 image create bitmap file_parttick -background white -foreground "#005050" -data {
2939 #define parttick_width 14
2940 #define parttick_height 15
2941 static unsigned char parttick_bits[] = {
2942    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2943    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2944    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2945 } -maskdata $filemask
2946
2947 image create bitmap file_question -background white -foreground black -data {
2948 #define file_question_width 14
2949 #define file_question_height 15
2950 static unsigned char file_question_bits[] = {
2951    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2952    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2953    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2954 } -maskdata $filemask
2955
2956 image create bitmap file_removed -background white -foreground red -data {
2957 #define file_removed_width 14
2958 #define file_removed_height 15
2959 static unsigned char file_removed_bits[] = {
2960    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2961    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2962    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2963 } -maskdata $filemask
2964
2965 image create bitmap file_merge -background white -foreground blue -data {
2966 #define file_merge_width 14
2967 #define file_merge_height 15
2968 static unsigned char file_merge_bits[] = {
2969    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2970    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2971    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2972 } -maskdata $filemask
2973
2974 set ui_index .vpane.files.index.list
2975 set ui_workdir .vpane.files.workdir.list
2976
2977 set all_icons(_$ui_index)   file_plain
2978 set all_icons(A$ui_index)   file_fulltick
2979 set all_icons(M$ui_index)   file_fulltick
2980 set all_icons(D$ui_index)   file_removed
2981 set all_icons(U$ui_index)   file_merge
2982
2983 set all_icons(_$ui_workdir) file_plain
2984 set all_icons(M$ui_workdir) file_mod
2985 set all_icons(D$ui_workdir) file_question
2986 set all_icons(U$ui_workdir) file_merge
2987 set all_icons(O$ui_workdir) file_plain
2988
2989 set max_status_desc 0
2990 foreach i {
2991                 {__ "Unmodified"}
2992
2993                 {_M "Modified, not staged"}
2994                 {M_ "Staged for commit"}
2995                 {MM "Portions staged for commit"}
2996                 {MD "Staged for commit, missing"}
2997
2998                 {_O "Untracked, not staged"}
2999                 {A_ "Staged for commit"}
3000                 {AM "Portions staged for commit"}
3001                 {AD "Staged for commit, missing"}
3002
3003                 {_D "Missing"}
3004                 {D_ "Staged for removal"}
3005                 {DO "Staged for removal, still present"}
3006
3007                 {U_ "Requires merge resolution"}
3008                 {UU "Requires merge resolution"}
3009                 {UM "Requires merge resolution"}
3010                 {UD "Requires merge resolution"}
3011         } {
3012         if {$max_status_desc < [string length [lindex $i 1]]} {
3013                 set max_status_desc [string length [lindex $i 1]]
3014         }
3015         set all_descs([lindex $i 0]) [lindex $i 1]
3016 }
3017 unset i
3018
3019 ######################################################################
3020 ##
3021 ## util
3022
3023 proc is_MacOSX {} {
3024         global tcl_platform tk_library
3025         if {[tk windowingsystem] eq {aqua}} {
3026                 return 1
3027         }
3028         return 0
3029 }
3030
3031 proc is_Windows {} {
3032         global tcl_platform
3033         if {$tcl_platform(platform) eq {windows}} {
3034                 return 1
3035         }
3036         return 0
3037 }
3038
3039 proc bind_button3 {w cmd} {
3040         bind $w <Any-Button-3> $cmd
3041         if {[is_MacOSX]} {
3042                 bind $w <Control-Button-1> $cmd
3043         }
3044 }
3045
3046 proc incr_font_size {font {amt 1}} {
3047         set sz [font configure $font -size]
3048         incr sz $amt
3049         font configure $font -size $sz
3050         font configure ${font}bold -size $sz
3051 }
3052
3053 proc hook_failed_popup {hook msg} {
3054         set w .hookfail
3055         toplevel $w
3056
3057         frame $w.m
3058         label $w.m.l1 -text "$hook hook failed:" \
3059                 -anchor w \
3060                 -justify left \
3061                 -font font_uibold
3062         text $w.m.t \
3063                 -background white -borderwidth 1 \
3064                 -relief sunken \
3065                 -width 80 -height 10 \
3066                 -font font_diff \
3067                 -yscrollcommand [list $w.m.sby set]
3068         label $w.m.l2 \
3069                 -text {You must correct the above errors before committing.} \
3070                 -anchor w \
3071                 -justify left \
3072                 -font font_uibold
3073         scrollbar $w.m.sby -command [list $w.m.t yview]
3074         pack $w.m.l1 -side top -fill x
3075         pack $w.m.l2 -side bottom -fill x
3076         pack $w.m.sby -side right -fill y
3077         pack $w.m.t -side left -fill both -expand 1
3078         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3079
3080         $w.m.t insert 1.0 $msg
3081         $w.m.t conf -state disabled
3082
3083         button $w.ok -text OK \
3084                 -width 15 \
3085                 -font font_ui \
3086                 -command "destroy $w"
3087         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3088
3089         bind $w <Visibility> "grab $w; focus $w"
3090         bind $w <Key-Return> "destroy $w"
3091         wm title $w "[appname] ([reponame]): error"
3092         tkwait window $w
3093 }
3094
3095 set next_console_id 0
3096
3097 proc new_console {short_title long_title} {
3098         global next_console_id console_data
3099         set w .console[incr next_console_id]
3100         set console_data($w) [list $short_title $long_title]
3101         return [console_init $w]
3102 }
3103
3104 proc console_init {w} {
3105         global console_cr console_data M1B
3106
3107         set console_cr($w) 1.0
3108         toplevel $w
3109         frame $w.m
3110         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3111                 -anchor w \
3112                 -justify left \
3113                 -font font_uibold
3114         text $w.m.t \
3115                 -background white -borderwidth 1 \
3116                 -relief sunken \
3117                 -width 80 -height 10 \
3118                 -font font_diff \
3119                 -state disabled \
3120                 -yscrollcommand [list $w.m.sby set]
3121         label $w.m.s -text {Working... please wait...} \
3122                 -anchor w \
3123                 -justify left \
3124                 -font font_uibold
3125         scrollbar $w.m.sby -command [list $w.m.t yview]
3126         pack $w.m.l1 -side top -fill x
3127         pack $w.m.s -side bottom -fill x
3128         pack $w.m.sby -side right -fill y
3129         pack $w.m.t -side left -fill both -expand 1
3130         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3131
3132         menu $w.ctxm -tearoff 0
3133         $w.ctxm add command -label "Copy" \
3134                 -font font_ui \
3135                 -command "tk_textCopy $w.m.t"
3136         $w.ctxm add command -label "Select All" \
3137                 -font font_ui \
3138                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3139         $w.ctxm add command -label "Copy All" \
3140                 -font font_ui \
3141                 -command "
3142                         $w.m.t tag add sel 0.0 end
3143                         tk_textCopy $w.m.t
3144                         $w.m.t tag remove sel 0.0 end
3145                 "
3146
3147         button $w.ok -text {Close} \
3148                 -font font_ui \
3149                 -state disabled \
3150                 -command "destroy $w"
3151         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3152
3153         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3154         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3155         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3156         bind $w <Visibility> "focus $w"
3157         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3158         return $w
3159 }
3160
3161 proc console_exec {w cmd after} {
3162         # -- Windows tosses the enviroment when we exec our child.
3163         #    But most users need that so we have to relogin. :-(
3164         #
3165         if {[is_Windows]} {
3166                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3167         }
3168
3169         # -- Tcl won't let us redirect both stdout and stderr to
3170         #    the same pipe.  So pass it through cat...
3171         #
3172         set cmd [concat | $cmd |& cat]
3173
3174         set fd_f [open $cmd r]
3175         fconfigure $fd_f -blocking 0 -translation binary
3176         fileevent $fd_f readable [list console_read $w $fd_f $after]
3177 }
3178
3179 proc console_read {w fd after} {
3180         global console_cr
3181
3182         set buf [read $fd]
3183         if {$buf ne {}} {
3184                 if {![winfo exists $w]} {console_init $w}
3185                 $w.m.t conf -state normal
3186                 set c 0
3187                 set n [string length $buf]
3188                 while {$c < $n} {
3189                         set cr [string first "\r" $buf $c]
3190                         set lf [string first "\n" $buf $c]
3191                         if {$cr < 0} {set cr [expr {$n + 1}]}
3192                         if {$lf < 0} {set lf [expr {$n + 1}]}
3193
3194                         if {$lf < $cr} {
3195                                 $w.m.t insert end [string range $buf $c $lf]
3196                                 set console_cr($w) [$w.m.t index {end -1c}]
3197                                 set c $lf
3198                                 incr c
3199                         } else {
3200                                 $w.m.t delete $console_cr($w) end
3201                                 $w.m.t insert end "\n"
3202                                 $w.m.t insert end [string range $buf $c $cr]
3203                                 set c $cr
3204                                 incr c
3205                         }
3206                 }
3207                 $w.m.t conf -state disabled
3208                 $w.m.t see end
3209         }
3210
3211         fconfigure $fd -blocking 1
3212         if {[eof $fd]} {
3213                 if {[catch {close $fd}]} {
3214                         set ok 0
3215                 } else {
3216                         set ok 1
3217                 }
3218                 uplevel #0 $after $w $ok
3219                 return
3220         }
3221         fconfigure $fd -blocking 0
3222 }
3223
3224 proc console_chain {cmdlist w {ok 1}} {
3225         if {$ok} {
3226                 if {[llength $cmdlist] == 0} {
3227                         console_done $w $ok
3228                         return
3229                 }
3230
3231                 set cmd [lindex $cmdlist 0]
3232                 set cmdlist [lrange $cmdlist 1 end]
3233
3234                 if {[lindex $cmd 0] eq {console_exec}} {
3235                         console_exec $w \
3236                                 [lindex $cmd 1] \
3237                                 [list console_chain $cmdlist]
3238                 } else {
3239                         uplevel #0 $cmd $cmdlist $w $ok
3240                 }
3241         } else {
3242                 console_done $w $ok
3243         }
3244 }
3245
3246 proc console_done {args} {
3247         global console_cr console_data
3248
3249         switch -- [llength $args] {
3250         2 {
3251                 set w [lindex $args 0]
3252                 set ok [lindex $args 1]
3253         }
3254         3 {
3255                 set w [lindex $args 1]
3256                 set ok [lindex $args 2]
3257         }
3258         default {
3259                 error "wrong number of args: console_done ?ignored? w ok"
3260         }
3261         }
3262
3263         if {$ok} {
3264                 if {[winfo exists $w]} {
3265                         $w.m.s conf -background green -text {Success}
3266                         $w.ok conf -state normal
3267                 }
3268         } else {
3269                 if {![winfo exists $w]} {
3270                         console_init $w
3271                 }
3272                 $w.m.s conf -background red -text {Error: Command Failed}
3273                 $w.ok conf -state normal
3274         }
3275
3276         array unset console_cr $w
3277         array unset console_data $w
3278 }
3279
3280 ######################################################################
3281 ##
3282 ## ui commands
3283
3284 set starting_gitk_msg {Starting gitk... please wait...}
3285
3286 proc do_gitk {revs} {
3287         global ui_status_value starting_gitk_msg
3288
3289         set cmd gitk
3290         if {$revs ne {}} {
3291                 append cmd { }
3292                 append cmd $revs
3293         }
3294         if {[is_Windows]} {
3295                 set cmd "sh -c \"exec $cmd\""
3296         }
3297         append cmd { &}
3298
3299         if {[catch {eval exec $cmd} err]} {
3300                 error_popup "Failed to start gitk:\n\n$err"
3301         } else {
3302                 set ui_status_value $starting_gitk_msg
3303                 after 10000 {
3304                         if {$ui_status_value eq $starting_gitk_msg} {
3305                                 set ui_status_value {Ready.}
3306                         }
3307                 }
3308         }
3309 }
3310
3311 proc do_stats {} {
3312         set fd [open "| git count-objects -v" r]
3313         while {[gets $fd line] > 0} {
3314                 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
3315                         set stats($name) $value
3316                 }
3317         }
3318         close $fd
3319
3320         set packed_sz 0
3321         foreach p [glob -directory [gitdir objects pack] \
3322                 -type f \
3323                 -nocomplain -- *] {
3324                 incr packed_sz [file size $p]
3325         }
3326         if {$packed_sz > 0} {
3327                 set stats(size-pack) [expr {$packed_sz / 1024}]
3328         }
3329
3330         set w .stats_view
3331         toplevel $w
3332         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3333
3334         label $w.header -text {Database Statistics} \
3335                 -font font_uibold
3336         pack $w.header -side top -fill x
3337
3338         frame $w.buttons -border 1
3339         button $w.buttons.close -text Close \
3340                 -font font_ui \
3341                 -command [list destroy $w]
3342         button $w.buttons.gc -text {Compress Database} \
3343                 -font font_ui \
3344                 -command "destroy $w;do_gc"
3345         pack $w.buttons.close -side right
3346         pack $w.buttons.gc -side left
3347         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3348
3349         frame $w.stat -borderwidth 1 -relief solid
3350         foreach s {
3351                 {count           {Number of loose objects}}
3352                 {size            {Disk space used by loose objects} { KiB}}
3353                 {in-pack         {Number of packed objects}}
3354                 {packs           {Number of packs}}
3355                 {size-pack       {Disk space used by packed objects} { KiB}}
3356                 {prune-packable  {Packed objects waiting for pruning}}
3357                 {garbage         {Garbage files}}
3358                 } {
3359                 set name [lindex $s 0]
3360                 set label [lindex $s 1]
3361                 if {[catch {set value $stats($name)}]} continue
3362                 if {[llength $s] > 2} {
3363                         set value "$value[lindex $s 2]"
3364                 }
3365
3366                 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
3367                 label $w.stat.v_$name -text $value -anchor w -font font_ui
3368                 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
3369         }
3370         pack $w.stat -pady 10 -padx 10
3371
3372         bind $w <Visibility> "grab $w; focus $w"
3373         bind $w <Key-Escape> [list destroy $w]
3374         bind $w <Key-Return> [list destroy $w]
3375         wm title $w "[appname] ([reponame]): Database Statistics"
3376         tkwait window $w
3377 }
3378
3379 proc do_gc {} {
3380         set w [new_console {gc} {Compressing the object database}]
3381         console_chain {
3382                 {console_exec {git pack-refs --prune}}
3383                 {console_exec {git reflog expire --all}}
3384                 {console_exec {git repack -a -d -l}}
3385                 {console_exec {git rerere gc}}
3386         } $w
3387 }
3388
3389 proc do_fsck_objects {} {
3390         set w [new_console {fsck-objects} \
3391                 {Verifying the object database with fsck-objects}]
3392         set cmd [list git fsck-objects]
3393         lappend cmd --full
3394         lappend cmd --cache
3395         lappend cmd --strict
3396         console_exec $w $cmd console_done
3397 }
3398
3399 set is_quitting 0
3400
3401 proc do_quit {} {
3402         global ui_comm is_quitting repo_config commit_type
3403
3404         if {$is_quitting} return
3405         set is_quitting 1
3406
3407         # -- Stash our current commit buffer.
3408         #
3409         set save [gitdir GITGUI_MSG]
3410         set msg [string trim [$ui_comm get 0.0 end]]
3411         regsub -all -line {[ \r\t]+$} $msg {} msg
3412         if {(![string match amend* $commit_type]
3413                 || [$ui_comm edit modified])
3414                 && $msg ne {}} {
3415                 catch {
3416                         set fd [open $save w]
3417                         puts -nonewline $fd $msg
3418                         close $fd
3419                 }
3420         } else {
3421                 catch {file delete $save}
3422         }
3423
3424         # -- Stash our current window geometry into this repository.
3425         #
3426         set cfg_geometry [list]
3427         lappend cfg_geometry [wm geometry .]
3428         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
3429         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
3430         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
3431                 set rc_geometry {}
3432         }
3433         if {$cfg_geometry ne $rc_geometry} {
3434                 catch {exec git repo-config gui.geometry $cfg_geometry}
3435         }
3436
3437         destroy .
3438 }
3439
3440 proc do_rescan {} {
3441         rescan {set ui_status_value {Ready.}}
3442 }
3443
3444 proc unstage_helper {txt paths} {
3445         global file_states current_diff_path
3446
3447         if {![lock_index begin-update]} return
3448
3449         set pathList [list]
3450         set after {}
3451         foreach path $paths {
3452                 switch -glob -- [lindex $file_states($path) 0] {
3453                 A? -
3454                 M? -
3455                 D? {
3456                         lappend pathList $path
3457                         if {$path eq $current_diff_path} {
3458                                 set after {reshow_diff;}
3459                         }
3460                 }
3461                 }
3462         }
3463         if {$pathList eq {}} {
3464                 unlock_index
3465         } else {
3466                 update_indexinfo \
3467                         $txt \
3468                         $pathList \
3469                         [concat $after {set ui_status_value {Ready.}}]
3470         }
3471 }
3472
3473 proc do_unstage_selection {} {
3474         global current_diff_path selected_paths
3475
3476         if {[array size selected_paths] > 0} {
3477                 unstage_helper \
3478                         {Unstaging selected files from commit} \
3479                         [array names selected_paths]
3480         } elseif {$current_diff_path ne {}} {
3481                 unstage_helper \
3482                         "Unstaging [short_path $current_diff_path] from commit" \
3483                         [list $current_diff_path]
3484         }
3485 }
3486
3487 proc add_helper {txt paths} {
3488         global file_states current_diff_path
3489
3490         if {![lock_index begin-update]} return
3491
3492         set pathList [list]
3493         set after {}
3494         foreach path $paths {
3495                 switch -glob -- [lindex $file_states($path) 0] {
3496                 _O -
3497                 ?M -
3498                 ?D -
3499                 U? {
3500                         lappend pathList $path
3501                         if {$path eq $current_diff_path} {
3502                                 set after {reshow_diff;}
3503                         }
3504                 }
3505                 }
3506         }
3507         if {$pathList eq {}} {
3508                 unlock_index
3509         } else {
3510                 update_index \
3511                         $txt \
3512                         $pathList \
3513                         [concat $after {set ui_status_value {Ready to commit.}}]
3514         }
3515 }
3516
3517 proc do_add_selection {} {
3518         global current_diff_path selected_paths
3519
3520         if {[array size selected_paths] > 0} {
3521                 add_helper \
3522                         {Adding selected files} \
3523                         [array names selected_paths]
3524         } elseif {$current_diff_path ne {}} {
3525                 add_helper \
3526                         "Adding [short_path $current_diff_path]" \
3527                         [list $current_diff_path]
3528         }
3529 }
3530
3531 proc do_add_all {} {
3532         global file_states
3533
3534         set paths [list]
3535         foreach path [array names file_states] {
3536                 switch -glob -- [lindex $file_states($path) 0] {
3537                 U? {continue}
3538                 ?M -
3539                 ?D {lappend paths $path}
3540                 }
3541         }
3542         add_helper {Adding all changed files} $paths
3543 }
3544
3545 proc revert_helper {txt paths} {
3546         global file_states current_diff_path
3547
3548         if {![lock_index begin-update]} return
3549
3550         set pathList [list]
3551         set after {}
3552         foreach path $paths {
3553                 switch -glob -- [lindex $file_states($path) 0] {
3554                 U? {continue}
3555                 ?M -
3556                 ?D {
3557                         lappend pathList $path
3558                         if {$path eq $current_diff_path} {
3559                                 set after {reshow_diff;}
3560                         }
3561                 }
3562                 }
3563         }
3564
3565         set n [llength $pathList]
3566         if {$n == 0} {
3567                 unlock_index
3568                 return
3569         } elseif {$n == 1} {
3570                 set s "[short_path [lindex $pathList]]"
3571         } else {
3572                 set s "these $n files"
3573         }
3574
3575         set reply [tk_dialog \
3576                 .confirm_revert \
3577                 "[appname] ([reponame])" \
3578                 "Revert changes in $s?
3579
3580 Any unadded changes will be permanently lost by the revert." \
3581                 question \
3582                 1 \
3583                 {Do Nothing} \
3584                 {Revert Changes} \
3585                 ]
3586         if {$reply == 1} {
3587                 checkout_index \
3588                         $txt \
3589                         $pathList \
3590                         [concat $after {set ui_status_value {Ready.}}]
3591         } else {
3592                 unlock_index
3593         }
3594 }
3595
3596 proc do_revert_selection {} {
3597         global current_diff_path selected_paths
3598
3599         if {[array size selected_paths] > 0} {
3600                 revert_helper \
3601                         {Reverting selected files} \
3602                         [array names selected_paths]
3603         } elseif {$current_diff_path ne {}} {
3604                 revert_helper \
3605                         "Reverting [short_path $current_diff_path]" \
3606                         [list $current_diff_path]
3607         }
3608 }
3609
3610 proc do_signoff {} {
3611         global ui_comm
3612
3613         set me [committer_ident]
3614         if {$me eq {}} return
3615
3616         set sob "Signed-off-by: $me"
3617         set last [$ui_comm get {end -1c linestart} {end -1c}]
3618         if {$last ne $sob} {
3619                 $ui_comm edit separator
3620                 if {$last ne {}
3621                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
3622                         $ui_comm insert end "\n"
3623                 }
3624                 $ui_comm insert end "\n$sob"
3625                 $ui_comm edit separator
3626                 $ui_comm see end
3627         }
3628 }
3629
3630 proc do_select_commit_type {} {
3631         global commit_type selected_commit_type
3632
3633         if {$selected_commit_type eq {new}
3634                 && [string match amend* $commit_type]} {
3635                 create_new_commit
3636         } elseif {$selected_commit_type eq {amend}
3637                 && ![string match amend* $commit_type]} {
3638                 load_last_commit
3639
3640                 # The amend request was rejected...
3641                 #
3642                 if {![string match amend* $commit_type]} {
3643                         set selected_commit_type new
3644                 }
3645         }
3646 }
3647
3648 proc do_commit {} {
3649         commit_tree
3650 }
3651
3652 proc do_about {} {
3653         global appvers copyright
3654         global tcl_patchLevel tk_patchLevel
3655
3656         set w .about_dialog
3657         toplevel $w
3658         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3659
3660         label $w.header -text "About [appname]" \
3661                 -font font_uibold
3662         pack $w.header -side top -fill x
3663
3664         frame $w.buttons
3665         button $w.buttons.close -text {Close} \
3666                 -font font_ui \
3667                 -command [list destroy $w]
3668         pack $w.buttons.close -side right
3669         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3670
3671         label $w.desc \
3672                 -text "[appname] - a commit creation tool for Git.
3673 $copyright" \
3674                 -padx 5 -pady 5 \
3675                 -justify left \
3676                 -anchor w \
3677                 -borderwidth 1 \
3678                 -relief solid \
3679                 -font font_ui
3680         pack $w.desc -side top -fill x -padx 5 -pady 5
3681
3682         set v {}
3683         append v "[appname] version $appvers\n"
3684         append v "[exec git version]\n"
3685         append v "\n"
3686         if {$tcl_patchLevel eq $tk_patchLevel} {
3687                 append v "Tcl/Tk version $tcl_patchLevel"
3688         } else {
3689                 append v "Tcl version $tcl_patchLevel"
3690                 append v ", Tk version $tk_patchLevel"
3691         }
3692
3693         label $w.vers \
3694                 -text $v \
3695                 -padx 5 -pady 5 \
3696                 -justify left \
3697                 -anchor w \
3698                 -borderwidth 1 \
3699                 -relief solid \
3700                 -font font_ui
3701         pack $w.vers -side top -fill x -padx 5 -pady 5
3702
3703         menu $w.ctxm -tearoff 0
3704         $w.ctxm add command \
3705                 -label {Copy} \
3706                 -font font_ui \
3707                 -command "
3708                 clipboard clear
3709                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3710         "
3711
3712         bind $w <Visibility> "grab $w; focus $w"
3713         bind $w <Key-Escape> "destroy $w"
3714         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3715         wm title $w "About [appname]"
3716         tkwait window $w
3717 }
3718
3719 proc do_options {} {
3720         global repo_config global_config font_descs
3721         global repo_config_new global_config_new
3722
3723         array unset repo_config_new
3724         array unset global_config_new
3725         foreach name [array names repo_config] {
3726                 set repo_config_new($name) $repo_config($name)
3727         }
3728         load_config 1
3729         foreach name [array names repo_config] {
3730                 switch -- $name {
3731                 gui.diffcontext {continue}
3732                 }
3733                 set repo_config_new($name) $repo_config($name)
3734         }
3735         foreach name [array names global_config] {
3736                 set global_config_new($name) $global_config($name)
3737         }
3738
3739         set w .options_editor
3740         toplevel $w
3741         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3742
3743         label $w.header -text "[appname] Options" \
3744                 -font font_uibold
3745         pack $w.header -side top -fill x
3746
3747         frame $w.buttons
3748         button $w.buttons.restore -text {Restore Defaults} \
3749                 -font font_ui \
3750                 -command do_restore_defaults
3751         pack $w.buttons.restore -side left
3752         button $w.buttons.save -text Save \
3753                 -font font_ui \
3754                 -command [list do_save_config $w]
3755         pack $w.buttons.save -side right
3756         button $w.buttons.cancel -text {Cancel} \
3757                 -font font_ui \
3758                 -command [list destroy $w]
3759         pack $w.buttons.cancel -side right -padx 5
3760         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3761
3762         labelframe $w.repo -text "[reponame] Repository" \
3763                 -font font_ui
3764         labelframe $w.global -text {Global (All Repositories)} \
3765                 -font font_ui
3766         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
3767         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
3768
3769         set optid 0
3770         foreach option {
3771                 {b merge.summary {Summarize Merge Commits}}
3772                 {i-1..5 merge.verbosity {Merge Verbosity}}
3773
3774                 {b gui.trustmtime  {Trust File Modification Timestamps}}
3775                 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
3776                 {t gui.newbranchtemplate {New Branch Name Template}}
3777                 } {
3778                 set type [lindex $option 0]
3779                 set name [lindex $option 1]
3780                 set text [lindex $option 2]
3781                 incr optid
3782                 foreach f {repo global} {
3783                         switch -glob -- $type {
3784                         b {
3785                                 checkbutton $w.$f.$optid -text $text \
3786                                         -variable ${f}_config_new($name) \
3787                                         -onvalue true \
3788                                         -offvalue false \
3789                                         -font font_ui
3790                                 pack $w.$f.$optid -side top -anchor w
3791                         }
3792                         i-* {
3793                                 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
3794                                 frame $w.$f.$optid
3795                                 label $w.$f.$optid.l -text "$text:" -font font_ui
3796                                 pack $w.$f.$optid.l -side left -anchor w -fill x
3797                                 spinbox $w.$f.$optid.v \
3798                                         -textvariable ${f}_config_new($name) \
3799                                         -from $min \
3800                                         -to $max \
3801                                         -increment 1 \
3802                                         -width [expr {1 + [string length $max]}] \
3803                                         -font font_ui
3804                                 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
3805                                 pack $w.$f.$optid.v -side right -anchor e -padx 5
3806                                 pack $w.$f.$optid -side top -anchor w -fill x
3807                         }
3808                         t {
3809                                 frame $w.$f.$optid
3810                                 label $w.$f.$optid.l -text "$text:" -font font_ui
3811                                 entry $w.$f.$optid.v \
3812                                         -borderwidth 1 \
3813                                         -relief sunken \
3814                                         -width 20 \
3815                                         -textvariable ${f}_config_new($name) \
3816                                         -font font_ui
3817                                 pack $w.$f.$optid.l -side left -anchor w
3818                                 pack $w.$f.$optid.v -side left -anchor w \
3819                                         -fill x -expand 1 \
3820                                         -padx 5
3821                                 pack $w.$f.$optid -side top -anchor w -fill x
3822                         }
3823                         }
3824                 }
3825         }
3826
3827         set all_fonts [lsort [font families]]
3828         foreach option $font_descs {
3829                 set name [lindex $option 0]
3830                 set font [lindex $option 1]
3831                 set text [lindex $option 2]
3832
3833                 set global_config_new(gui.$font^^family) \
3834                         [font configure $font -family]
3835                 set global_config_new(gui.$font^^size) \
3836                         [font configure $font -size]
3837
3838                 frame $w.global.$name
3839                 label $w.global.$name.l -text "$text:" -font font_ui
3840                 pack $w.global.$name.l -side left -anchor w -fill x
3841                 eval tk_optionMenu $w.global.$name.family \
3842                         global_config_new(gui.$font^^family) \
3843                         $all_fonts
3844                 spinbox $w.global.$name.size \
3845                         -textvariable global_config_new(gui.$font^^size) \
3846                         -from 2 -to 80 -increment 1 \
3847                         -width 3 \
3848                         -font font_ui
3849                 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3850                 pack $w.global.$name.size -side right -anchor e
3851                 pack $w.global.$name.family -side right -anchor e
3852                 pack $w.global.$name -side top -anchor w -fill x
3853         }
3854
3855         bind $w <Visibility> "grab $w; focus $w"
3856         bind $w <Key-Escape> "destroy $w"
3857         wm title $w "[appname] ([reponame]): Options"
3858         tkwait window $w
3859 }
3860
3861 proc do_restore_defaults {} {
3862         global font_descs default_config repo_config
3863         global repo_config_new global_config_new
3864
3865         foreach name [array names default_config] {
3866                 set repo_config_new($name) $default_config($name)
3867                 set global_config_new($name) $default_config($name)
3868         }
3869
3870         foreach option $font_descs {
3871                 set name [lindex $option 0]
3872                 set repo_config(gui.$name) $default_config(gui.$name)
3873         }
3874         apply_config
3875
3876         foreach option $font_descs {
3877                 set name [lindex $option 0]
3878                 set font [lindex $option 1]
3879                 set global_config_new(gui.$font^^family) \
3880                         [font configure $font -family]
3881                 set global_config_new(gui.$font^^size) \
3882                         [font configure $font -size]
3883         }
3884 }
3885
3886 proc do_save_config {w} {
3887         if {[catch {save_config} err]} {
3888                 error_popup "Failed to completely save options:\n\n$err"
3889         }
3890         reshow_diff
3891         destroy $w
3892 }
3893
3894 proc do_windows_shortcut {} {
3895         global argv0
3896
3897         if {[catch {
3898                 set desktop [exec cygpath \
3899                         --windows \
3900                         --absolute \
3901                         --long-name \
3902                         --desktop]
3903                 }]} {
3904                         set desktop .
3905         }
3906         set fn [tk_getSaveFile \
3907                 -parent . \
3908                 -title "[appname] ([reponame]): Create Desktop Icon" \
3909                 -initialdir $desktop \
3910                 -initialfile "Git [reponame].bat"]
3911         if {$fn != {}} {
3912                 if {[catch {
3913                                 set fd [open $fn w]
3914                                 set sh [exec cygpath \
3915                                         --windows \
3916                                         --absolute \
3917                                         /bin/sh]
3918                                 set me [exec cygpath \
3919                                         --unix \
3920                                         --absolute \
3921                                         $argv0]
3922                                 set gd [exec cygpath \
3923                                         --unix \
3924                                         --absolute \
3925                                         [gitdir]]
3926                                 set gw [exec cygpath \
3927                                         --windows \
3928                                         --absolute \
3929                                         [file dirname [gitdir]]]
3930                                 regsub -all ' $me "'\\''" me
3931                                 regsub -all ' $gd "'\\''" gd
3932                                 puts $fd "@ECHO Entering $gw"
3933                                 puts $fd "@ECHO Starting git-gui... please wait..."
3934                                 puts -nonewline $fd "@\"$sh\" --login -c \""
3935                                 puts -nonewline $fd "GIT_DIR='$gd'"
3936                                 puts -nonewline $fd " '$me'"
3937                                 puts $fd "&\""
3938                                 close $fd
3939                         } err]} {
3940                         error_popup "Cannot write script:\n\n$err"
3941                 }
3942         }
3943 }
3944
3945 proc do_macosx_app {} {
3946         global argv0 env
3947
3948         set fn [tk_getSaveFile \
3949                 -parent . \
3950                 -title "[appname] ([reponame]): Create Desktop Icon" \
3951                 -initialdir [file join $env(HOME) Desktop] \
3952                 -initialfile "Git [reponame].app"]
3953         if {$fn != {}} {
3954                 if {[catch {
3955                                 set Contents [file join $fn Contents]
3956                                 set MacOS [file join $Contents MacOS]
3957                                 set exe [file join $MacOS git-gui]
3958
3959                                 file mkdir $MacOS
3960
3961                                 set fd [open [file join $Contents Info.plist] w]
3962                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3963 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3964 <plist version="1.0">
3965 <dict>
3966         <key>CFBundleDevelopmentRegion</key>
3967         <string>English</string>
3968         <key>CFBundleExecutable</key>
3969         <string>git-gui</string>
3970         <key>CFBundleIdentifier</key>
3971         <string>org.spearce.git-gui</string>
3972         <key>CFBundleInfoDictionaryVersion</key>
3973         <string>6.0</string>
3974         <key>CFBundlePackageType</key>
3975         <string>APPL</string>
3976         <key>CFBundleSignature</key>
3977         <string>????</string>
3978         <key>CFBundleVersion</key>
3979         <string>1.0</string>
3980         <key>NSPrincipalClass</key>
3981         <string>NSApplication</string>
3982 </dict>
3983 </plist>}
3984                                 close $fd
3985
3986                                 set fd [open $exe w]
3987                                 set gd [file normalize [gitdir]]
3988                                 set ep [file normalize [exec git --exec-path]]
3989                                 regsub -all ' $gd "'\\''" gd
3990                                 regsub -all ' $ep "'\\''" ep
3991                                 puts $fd "#!/bin/sh"
3992                                 foreach name [array names env] {
3993                                         if {[string match GIT_* $name]} {
3994                                                 regsub -all ' $env($name) "'\\''" v
3995                                                 puts $fd "export $name='$v'"
3996                                         }
3997                                 }
3998                                 puts $fd "export PATH='$ep':\$PATH"
3999                                 puts $fd "export GIT_DIR='$gd'"
4000                                 puts $fd "exec [file normalize $argv0]"
4001                                 close $fd
4002
4003                                 file attributes $exe -permissions u+x,g+x,o+x
4004                         } err]} {
4005                         error_popup "Cannot write icon:\n\n$err"
4006                 }
4007         }
4008 }
4009
4010 proc toggle_or_diff {w x y} {
4011         global file_states file_lists current_diff_path ui_index ui_workdir
4012         global last_clicked selected_paths
4013
4014         set pos [split [$w index @$x,$y] .]
4015         set lno [lindex $pos 0]
4016         set col [lindex $pos 1]
4017         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4018         if {$path eq {}} {
4019                 set last_clicked {}
4020                 return
4021         }
4022
4023         set last_clicked [list $w $lno]
4024         array unset selected_paths
4025         $ui_index tag remove in_sel 0.0 end
4026         $ui_workdir tag remove in_sel 0.0 end
4027
4028         if {$col == 0} {
4029                 if {$current_diff_path eq $path} {
4030                         set after {reshow_diff;}
4031                 } else {
4032                         set after {}
4033                 }
4034                 if {$w eq $ui_index} {
4035                         update_indexinfo \
4036                                 "Unstaging [short_path $path] from commit" \
4037                                 [list $path] \
4038                                 [concat $after {set ui_status_value {Ready.}}]
4039                 } elseif {$w eq $ui_workdir} {
4040                         update_index \
4041                                 "Adding [short_path $path]" \
4042                                 [list $path] \
4043                                 [concat $after {set ui_status_value {Ready.}}]
4044                 }
4045         } else {
4046                 show_diff $path $w $lno
4047         }
4048 }
4049
4050 proc add_one_to_selection {w x y} {
4051         global file_lists last_clicked selected_paths
4052
4053         set lno [lindex [split [$w index @$x,$y] .] 0]
4054         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4055         if {$path eq {}} {
4056                 set last_clicked {}
4057                 return
4058         }
4059
4060         if {$last_clicked ne {}
4061                 && [lindex $last_clicked 0] ne $w} {
4062                 array unset selected_paths
4063                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4064         }
4065
4066         set last_clicked [list $w $lno]
4067         if {[catch {set in_sel $selected_paths($path)}]} {
4068                 set in_sel 0
4069         }
4070         if {$in_sel} {
4071                 unset selected_paths($path)
4072                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4073         } else {
4074                 set selected_paths($path) 1
4075                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4076         }
4077 }
4078
4079 proc add_range_to_selection {w x y} {
4080         global file_lists last_clicked selected_paths
4081
4082         if {[lindex $last_clicked 0] ne $w} {
4083                 toggle_or_diff $w $x $y
4084                 return
4085         }
4086
4087         set lno [lindex [split [$w index @$x,$y] .] 0]
4088         set lc [lindex $last_clicked 1]
4089         if {$lc < $lno} {
4090                 set begin $lc
4091                 set end $lno
4092         } else {
4093                 set begin $lno
4094                 set end $lc
4095         }
4096
4097         foreach path [lrange $file_lists($w) \
4098                 [expr {$begin - 1}] \
4099                 [expr {$end - 1}]] {
4100                 set selected_paths($path) 1
4101         }
4102         $w tag add in_sel $begin.0 [expr {$end + 1}].0
4103 }
4104
4105 ######################################################################
4106 ##
4107 ## config defaults
4108
4109 set cursor_ptr arrow
4110 font create font_diff -family Courier -size 10
4111 font create font_ui
4112 catch {
4113         label .dummy
4114         eval font configure font_ui [font actual [.dummy cget -font]]
4115         destroy .dummy
4116 }
4117
4118 font create font_uibold
4119 font create font_diffbold
4120
4121 if {[is_Windows]} {
4122         set M1B Control
4123         set M1T Ctrl
4124 } elseif {[is_MacOSX]} {
4125         set M1B M1
4126         set M1T Cmd
4127 } else {
4128         set M1B M1
4129         set M1T M1
4130 }
4131
4132 proc apply_config {} {
4133         global repo_config font_descs
4134
4135         foreach option $font_descs {
4136                 set name [lindex $option 0]
4137                 set font [lindex $option 1]
4138                 if {[catch {
4139                         foreach {cn cv} $repo_config(gui.$name) {
4140                                 font configure $font $cn $cv
4141                         }
4142                         } err]} {
4143                         error_popup "Invalid font specified in gui.$name:\n\n$err"
4144                 }
4145                 foreach {cn cv} [font configure $font] {
4146                         font configure ${font}bold $cn $cv
4147                 }
4148                 font configure ${font}bold -weight bold
4149         }
4150 }
4151
4152 set default_config(merge.summary) false
4153 set default_config(merge.verbosity) 2
4154 set default_config(gui.trustmtime) false
4155 set default_config(gui.diffcontext) 5
4156 set default_config(gui.newbranchtemplate) {}
4157 set default_config(gui.fontui) [font configure font_ui]
4158 set default_config(gui.fontdiff) [font configure font_diff]
4159 set font_descs {
4160         {fontui   font_ui   {Main Font}}
4161         {fontdiff font_diff {Diff/Console Font}}
4162 }
4163 load_config 0
4164 apply_config
4165
4166 ######################################################################
4167 ##
4168 ## ui construction
4169
4170 # -- Menu Bar
4171 #
4172 menu .mbar -tearoff 0
4173 .mbar add cascade -label Repository -menu .mbar.repository
4174 .mbar add cascade -label Edit -menu .mbar.edit
4175 if {!$single_commit} {
4176         .mbar add cascade -label Branch -menu .mbar.branch
4177 }
4178 .mbar add cascade -label Commit -menu .mbar.commit
4179 if {!$single_commit} {
4180         .mbar add cascade -label Merge -menu .mbar.merge
4181         .mbar add cascade -label Fetch -menu .mbar.fetch
4182         .mbar add cascade -label Push -menu .mbar.push
4183 }
4184 . configure -menu .mbar
4185
4186 # -- Repository Menu
4187 #
4188 menu .mbar.repository
4189 .mbar.repository add command \
4190         -label {Visualize Current Branch} \
4191         -command {do_gitk {}} \
4192         -font font_ui
4193 .mbar.repository add command \
4194         -label {Visualize All Branches} \
4195         -command {do_gitk {--all}} \
4196         -font font_ui
4197 .mbar.repository add separator
4198
4199 if {!$single_commit} {
4200         .mbar.repository add command -label {Database Statistics} \
4201                 -command do_stats \
4202                 -font font_ui
4203
4204         .mbar.repository add command -label {Compress Database} \
4205                 -command do_gc \
4206                 -font font_ui
4207
4208         .mbar.repository add command -label {Verify Database} \
4209                 -command do_fsck_objects \
4210                 -font font_ui
4211
4212         .mbar.repository add separator
4213
4214         if {[is_Windows]} {
4215                 .mbar.repository add command \
4216                         -label {Create Desktop Icon} \
4217                         -command do_windows_shortcut \
4218                         -font font_ui
4219         } elseif {[is_MacOSX]} {
4220                 .mbar.repository add command \
4221                         -label {Create Desktop Icon} \
4222                         -command do_macosx_app \
4223                         -font font_ui
4224         }
4225 }
4226
4227 .mbar.repository add command -label Quit \
4228         -command do_quit \
4229         -accelerator $M1T-Q \
4230         -font font_ui
4231
4232 # -- Edit Menu
4233 #
4234 menu .mbar.edit
4235 .mbar.edit add command -label Undo \
4236         -command {catch {[focus] edit undo}} \
4237         -accelerator $M1T-Z \
4238         -font font_ui
4239 .mbar.edit add command -label Redo \
4240         -command {catch {[focus] edit redo}} \
4241         -accelerator $M1T-Y \
4242         -font font_ui
4243 .mbar.edit add separator
4244 .mbar.edit add command -label Cut \
4245         -command {catch {tk_textCut [focus]}} \
4246         -accelerator $M1T-X \
4247         -font font_ui
4248 .mbar.edit add command -label Copy \
4249         -command {catch {tk_textCopy [focus]}} \
4250         -accelerator $M1T-C \
4251         -font font_ui
4252 .mbar.edit add command -label Paste \
4253         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4254         -accelerator $M1T-V \
4255         -font font_ui
4256 .mbar.edit add command -label Delete \
4257         -command {catch {[focus] delete sel.first sel.last}} \
4258         -accelerator Del \
4259         -font font_ui
4260 .mbar.edit add separator
4261 .mbar.edit add command -label {Select All} \
4262         -command {catch {[focus] tag add sel 0.0 end}} \
4263         -accelerator $M1T-A \
4264         -font font_ui
4265
4266 # -- Branch Menu
4267 #
4268 if {!$single_commit} {
4269         menu .mbar.branch
4270
4271         .mbar.branch add command -label {Create...} \
4272                 -command do_create_branch \
4273                 -accelerator $M1T-N \
4274                 -font font_ui
4275         lappend disable_on_lock [list .mbar.branch entryconf \
4276                 [.mbar.branch index last] -state]
4277
4278         .mbar.branch add command -label {Delete...} \
4279                 -command do_delete_branch \
4280                 -font font_ui
4281         lappend disable_on_lock [list .mbar.branch entryconf \
4282                 [.mbar.branch index last] -state]
4283 }
4284
4285 # -- Commit Menu
4286 #
4287 menu .mbar.commit
4288
4289 .mbar.commit add radiobutton \
4290         -label {New Commit} \
4291         -command do_select_commit_type \
4292         -variable selected_commit_type \
4293         -value new \
4294         -font font_ui
4295 lappend disable_on_lock \
4296         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4297
4298 .mbar.commit add radiobutton \
4299         -label {Amend Last Commit} \
4300         -command do_select_commit_type \
4301         -variable selected_commit_type \
4302         -value amend \
4303         -font font_ui
4304 lappend disable_on_lock \
4305         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4306
4307 .mbar.commit add separator
4308
4309 .mbar.commit add command -label Rescan \
4310         -command do_rescan \
4311         -accelerator F5 \
4312         -font font_ui
4313 lappend disable_on_lock \
4314         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4315
4316 .mbar.commit add command -label {Add To Commit} \
4317         -command do_add_selection \
4318         -font font_ui
4319 lappend disable_on_lock \
4320         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4321
4322 .mbar.commit add command -label {Add All To Commit} \
4323         -command do_add_all \
4324         -accelerator $M1T-I \
4325         -font font_ui
4326 lappend disable_on_lock \
4327         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4328
4329 .mbar.commit add command -label {Unstage From Commit} \
4330         -command do_unstage_selection \
4331         -font font_ui
4332 lappend disable_on_lock \
4333         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4334
4335 .mbar.commit add command -label {Revert Changes} \
4336         -command do_revert_selection \
4337         -font font_ui
4338 lappend disable_on_lock \
4339         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4340
4341 .mbar.commit add separator
4342
4343 .mbar.commit add command -label {Sign Off} \
4344         -command do_signoff \
4345         -accelerator $M1T-S \
4346         -font font_ui
4347
4348 .mbar.commit add command -label Commit \
4349         -command do_commit \
4350         -accelerator $M1T-Return \
4351         -font font_ui
4352 lappend disable_on_lock \
4353         [list .mbar.commit entryconf [.mbar.commit index last] -state]
4354
4355 if {[is_MacOSX]} {
4356         # -- Apple Menu (Mac OS X only)
4357         #
4358         .mbar add cascade -label Apple -menu .mbar.apple
4359         menu .mbar.apple
4360
4361         .mbar.apple add command -label "About [appname]" \
4362                 -command do_about \
4363                 -font font_ui
4364         .mbar.apple add command -label "[appname] Options..." \
4365                 -command do_options \
4366                 -font font_ui
4367 } else {
4368         # -- Edit Menu
4369         #
4370         .mbar.edit add separator
4371         .mbar.edit add command -label {Options...} \
4372                 -command do_options \
4373                 -font font_ui
4374
4375         # -- Tools Menu
4376         #
4377         if {[file exists /usr/local/miga/lib/gui-miga]
4378                 && [file exists .pvcsrc]} {
4379         proc do_miga {} {
4380                 global ui_status_value
4381                 if {![lock_index update]} return
4382                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
4383                 set miga_fd [open "|$cmd" r]
4384                 fconfigure $miga_fd -blocking 0
4385                 fileevent $miga_fd readable [list miga_done $miga_fd]
4386                 set ui_status_value {Running miga...}
4387         }
4388         proc miga_done {fd} {
4389                 read $fd 512
4390                 if {[eof $fd]} {
4391                         close $fd
4392                         unlock_index
4393                         rescan [list set ui_status_value {Ready.}]
4394                 }
4395         }
4396         .mbar add cascade -label Tools -menu .mbar.tools
4397         menu .mbar.tools
4398         .mbar.tools add command -label "Migrate" \
4399                 -command do_miga \
4400                 -font font_ui
4401         lappend disable_on_lock \
4402                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
4403         }
4404 }
4405
4406 # -- Help Menu
4407 #
4408 .mbar add cascade -label Help -menu .mbar.help
4409 menu .mbar.help
4410
4411 if {![is_MacOSX]} {
4412         .mbar.help add command -label "About [appname]" \
4413                 -command do_about \
4414                 -font font_ui
4415 }
4416
4417 set browser {}
4418 catch {set browser $repo_config(instaweb.browser)}
4419 set doc_path [file dirname [exec git --exec-path]]
4420 set doc_path [file join $doc_path Documentation index.html]
4421
4422 if {[is_Windows]} {
4423         set doc_path [exec cygpath --windows $doc_path]
4424 }
4425
4426 if {$browser eq {}} {
4427         if {[is_MacOSX]} {
4428                 set browser open
4429         } elseif {[is_Windows]} {
4430                 set program_files [file dirname [exec cygpath --windir]]
4431                 set program_files [file join $program_files {Program Files}]
4432                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
4433                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
4434                 if {[file exists $firefox]} {
4435                         set browser $firefox
4436                 } elseif {[file exists $ie]} {
4437                         set browser $ie
4438                 }
4439                 unset program_files firefox ie
4440         }
4441 }
4442
4443 if {[file isfile $doc_path]} {
4444         set doc_url "file:$doc_path"
4445 } else {
4446         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
4447 }
4448
4449 if {$browser ne {}} {
4450         .mbar.help add command -label {Online Documentation} \
4451                 -command [list exec $browser $doc_url &] \
4452                 -font font_ui
4453 }
4454 unset browser doc_path doc_url
4455
4456 # -- Branch Control
4457 #
4458 frame .branch \
4459         -borderwidth 1 \
4460         -relief sunken
4461 label .branch.l1 \
4462         -text {Current Branch:} \
4463         -anchor w \
4464         -justify left \
4465         -font font_ui
4466 label .branch.cb \
4467         -textvariable current_branch \
4468         -anchor w \
4469         -justify left \
4470         -font font_ui
4471 pack .branch.l1 -side left
4472 pack .branch.cb -side left -fill x
4473 pack .branch -side top -fill x
4474
4475 if {!$single_commit} {
4476         menu .mbar.merge
4477         .mbar.merge add command -label {Local Merge...} \
4478                 -command do_local_merge \
4479                 -font font_ui
4480         lappend disable_on_lock \
4481                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
4482         .mbar.merge add command -label {Abort Merge...} \
4483                 -command do_reset_hard \
4484                 -font font_ui
4485         lappend disable_on_lock \
4486                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
4487
4488
4489         menu .mbar.fetch
4490
4491         menu .mbar.push
4492         .mbar.push add command -label {Push...} \
4493                 -command do_push_anywhere \
4494                 -font font_ui
4495 }
4496
4497 # -- Main Window Layout
4498 #
4499 panedwindow .vpane -orient vertical
4500 panedwindow .vpane.files -orient horizontal
4501 .vpane add .vpane.files -sticky nsew -height 100 -width 200
4502 pack .vpane -anchor n -side top -fill both -expand 1
4503
4504 # -- Index File List
4505 #
4506 frame .vpane.files.index -height 100 -width 200
4507 label .vpane.files.index.title -text {Changes To Be Committed} \
4508         -background green \
4509         -font font_ui
4510 text $ui_index -background white -borderwidth 0 \
4511         -width 20 -height 10 \
4512         -wrap none \
4513         -font font_ui \
4514         -cursor $cursor_ptr \
4515         -xscrollcommand {.vpane.files.index.sx set} \
4516         -yscrollcommand {.vpane.files.index.sy set} \
4517         -state disabled
4518 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4519 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4520 pack .vpane.files.index.title -side top -fill x
4521 pack .vpane.files.index.sx -side bottom -fill x
4522 pack .vpane.files.index.sy -side right -fill y
4523 pack $ui_index -side left -fill both -expand 1
4524 .vpane.files add .vpane.files.index -sticky nsew
4525
4526 # -- Working Directory File List
4527 #
4528 frame .vpane.files.workdir -height 100 -width 200
4529 label .vpane.files.workdir.title -text {Changed But Not Updated} \
4530         -background red \
4531         -font font_ui
4532 text $ui_workdir -background white -borderwidth 0 \
4533         -width 20 -height 10 \
4534         -wrap none \
4535         -font font_ui \
4536         -cursor $cursor_ptr \
4537         -xscrollcommand {.vpane.files.workdir.sx set} \
4538         -yscrollcommand {.vpane.files.workdir.sy set} \
4539         -state disabled
4540 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4541 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4542 pack .vpane.files.workdir.title -side top -fill x
4543 pack .vpane.files.workdir.sx -side bottom -fill x
4544 pack .vpane.files.workdir.sy -side right -fill y
4545 pack $ui_workdir -side left -fill both -expand 1
4546 .vpane.files add .vpane.files.workdir -sticky nsew
4547
4548 foreach i [list $ui_index $ui_workdir] {
4549         $i tag conf in_diff -font font_uibold
4550         $i tag conf in_sel \
4551                 -background [$i cget -foreground] \
4552                 -foreground [$i cget -background]
4553 }
4554 unset i
4555
4556 # -- Diff and Commit Area
4557 #
4558 frame .vpane.lower -height 300 -width 400
4559 frame .vpane.lower.commarea
4560 frame .vpane.lower.diff -relief sunken -borderwidth 1
4561 pack .vpane.lower.commarea -side top -fill x
4562 pack .vpane.lower.diff -side bottom -fill both -expand 1
4563 .vpane add .vpane.lower -sticky nsew
4564
4565 # -- Commit Area Buttons
4566 #
4567 frame .vpane.lower.commarea.buttons
4568 label .vpane.lower.commarea.buttons.l -text {} \
4569         -anchor w \
4570         -justify left \
4571         -font font_ui
4572 pack .vpane.lower.commarea.buttons.l -side top -fill x
4573 pack .vpane.lower.commarea.buttons -side left -fill y
4574
4575 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4576         -command do_rescan \
4577         -font font_ui
4578 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4579 lappend disable_on_lock \
4580         {.vpane.lower.commarea.buttons.rescan conf -state}
4581
4582 button .vpane.lower.commarea.buttons.incall -text {Add All} \
4583         -command do_add_all \
4584         -font font_ui
4585 pack .vpane.lower.commarea.buttons.incall -side top -fill x
4586 lappend disable_on_lock \
4587         {.vpane.lower.commarea.buttons.incall conf -state}
4588
4589 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4590         -command do_signoff \
4591         -font font_ui
4592 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4593
4594 button .vpane.lower.commarea.buttons.commit -text {Commit} \
4595         -command do_commit \
4596         -font font_ui
4597 pack .vpane.lower.commarea.buttons.commit -side top -fill x
4598 lappend disable_on_lock \
4599         {.vpane.lower.commarea.buttons.commit conf -state}
4600
4601 # -- Commit Message Buffer
4602 #
4603 frame .vpane.lower.commarea.buffer
4604 frame .vpane.lower.commarea.buffer.header
4605 set ui_comm .vpane.lower.commarea.buffer.t
4606 set ui_coml .vpane.lower.commarea.buffer.header.l
4607 radiobutton .vpane.lower.commarea.buffer.header.new \
4608         -text {New Commit} \
4609         -command do_select_commit_type \
4610         -variable selected_commit_type \
4611         -value new \
4612         -font font_ui
4613 lappend disable_on_lock \
4614         [list .vpane.lower.commarea.buffer.header.new conf -state]
4615 radiobutton .vpane.lower.commarea.buffer.header.amend \
4616         -text {Amend Last Commit} \
4617         -command do_select_commit_type \
4618         -variable selected_commit_type \
4619         -value amend \
4620         -font font_ui
4621 lappend disable_on_lock \
4622         [list .vpane.lower.commarea.buffer.header.amend conf -state]
4623 label $ui_coml \
4624         -anchor w \
4625         -justify left \
4626         -font font_ui
4627 proc trace_commit_type {varname args} {
4628         global ui_coml commit_type
4629         switch -glob -- $commit_type {
4630         initial       {set txt {Initial Commit Message:}}
4631         amend         {set txt {Amended Commit Message:}}
4632         amend-initial {set txt {Amended Initial Commit Message:}}
4633         amend-merge   {set txt {Amended Merge Commit Message:}}
4634         merge         {set txt {Merge Commit Message:}}
4635         *             {set txt {Commit Message:}}
4636         }
4637         $ui_coml conf -text $txt
4638 }
4639 trace add variable commit_type write trace_commit_type
4640 pack $ui_coml -side left -fill x
4641 pack .vpane.lower.commarea.buffer.header.amend -side right
4642 pack .vpane.lower.commarea.buffer.header.new -side right
4643
4644 text $ui_comm -background white -borderwidth 1 \
4645         -undo true \
4646         -maxundo 20 \
4647         -autoseparators true \
4648         -relief sunken \
4649         -width 75 -height 9 -wrap none \
4650         -font font_diff \
4651         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4652 scrollbar .vpane.lower.commarea.buffer.sby \
4653         -command [list $ui_comm yview]
4654 pack .vpane.lower.commarea.buffer.header -side top -fill x
4655 pack .vpane.lower.commarea.buffer.sby -side right -fill y
4656 pack $ui_comm -side left -fill y
4657 pack .vpane.lower.commarea.buffer -side left -fill y
4658
4659 # -- Commit Message Buffer Context Menu
4660 #
4661 set ctxm .vpane.lower.commarea.buffer.ctxm
4662 menu $ctxm -tearoff 0
4663 $ctxm add command \
4664         -label {Cut} \
4665         -font font_ui \
4666         -command {tk_textCut $ui_comm}
4667 $ctxm add command \
4668         -label {Copy} \
4669         -font font_ui \
4670         -command {tk_textCopy $ui_comm}
4671 $ctxm add command \
4672         -label {Paste} \
4673         -font font_ui \
4674         -command {tk_textPaste $ui_comm}
4675 $ctxm add command \
4676         -label {Delete} \
4677         -font font_ui \
4678         -command {$ui_comm delete sel.first sel.last}
4679 $ctxm add separator
4680 $ctxm add command \
4681         -label {Select All} \
4682         -font font_ui \
4683         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4684 $ctxm add command \
4685         -label {Copy All} \
4686         -font font_ui \
4687         -command {
4688                 $ui_comm tag add sel 0.0 end
4689                 tk_textCopy $ui_comm
4690                 $ui_comm tag remove sel 0.0 end
4691         }
4692 $ctxm add separator
4693 $ctxm add command \
4694         -label {Sign Off} \
4695         -font font_ui \
4696         -command do_signoff
4697 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
4698
4699 # -- Diff Header
4700 #
4701 set current_diff_path {}
4702 set current_diff_side {}
4703 set diff_actions [list]
4704 proc trace_current_diff_path {varname args} {
4705         global current_diff_path diff_actions file_states
4706         if {$current_diff_path eq {}} {
4707                 set s {}
4708                 set f {}
4709                 set p {}
4710                 set o disabled
4711         } else {
4712                 set p $current_diff_path
4713                 set s [mapdesc [lindex $file_states($p) 0] $p]
4714                 set f {File:}
4715                 set p [escape_path $p]
4716                 set o normal
4717         }
4718
4719         .vpane.lower.diff.header.status configure -text $s
4720         .vpane.lower.diff.header.file configure -text $f
4721         .vpane.lower.diff.header.path configure -text $p
4722         foreach w $diff_actions {
4723                 uplevel #0 $w $o
4724         }
4725 }
4726 trace add variable current_diff_path write trace_current_diff_path
4727
4728 frame .vpane.lower.diff.header -background orange
4729 label .vpane.lower.diff.header.status \
4730         -background orange \
4731         -width $max_status_desc \
4732         -anchor w \
4733         -justify left \
4734         -font font_ui
4735 label .vpane.lower.diff.header.file \
4736         -background orange \
4737         -anchor w \
4738         -justify left \
4739         -font font_ui
4740 label .vpane.lower.diff.header.path \
4741         -background orange \
4742         -anchor w \
4743         -justify left \
4744         -font font_ui
4745 pack .vpane.lower.diff.header.status -side left
4746 pack .vpane.lower.diff.header.file -side left
4747 pack .vpane.lower.diff.header.path -fill x
4748 set ctxm .vpane.lower.diff.header.ctxm
4749 menu $ctxm -tearoff 0
4750 $ctxm add command \
4751         -label {Copy} \
4752         -font font_ui \
4753         -command {
4754                 clipboard clear
4755                 clipboard append \
4756                         -format STRING \
4757                         -type STRING \
4758                         -- $current_diff_path
4759         }
4760 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4761 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
4762
4763 # -- Diff Body
4764 #
4765 frame .vpane.lower.diff.body
4766 set ui_diff .vpane.lower.diff.body.t
4767 text $ui_diff -background white -borderwidth 0 \
4768         -width 80 -height 15 -wrap none \
4769         -font font_diff \
4770         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4771         -yscrollcommand {.vpane.lower.diff.body.sby set} \
4772         -state disabled
4773 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4774         -command [list $ui_diff xview]
4775 scrollbar .vpane.lower.diff.body.sby -orient vertical \
4776         -command [list $ui_diff yview]
4777 pack .vpane.lower.diff.body.sbx -side bottom -fill x
4778 pack .vpane.lower.diff.body.sby -side right -fill y
4779 pack $ui_diff -side left -fill both -expand 1
4780 pack .vpane.lower.diff.header -side top -fill x
4781 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4782
4783 $ui_diff tag conf d_cr -elide true
4784 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
4785 $ui_diff tag conf d_+ -foreground {#00a000}
4786 $ui_diff tag conf d_- -foreground red
4787
4788 $ui_diff tag conf d_++ -foreground {#00a000}
4789 $ui_diff tag conf d_-- -foreground red
4790 $ui_diff tag conf d_+s \
4791         -foreground {#00a000} \
4792         -background {#e2effa}
4793 $ui_diff tag conf d_-s \
4794         -foreground red \
4795         -background {#e2effa}
4796 $ui_diff tag conf d_s+ \
4797         -foreground {#00a000} \
4798         -background ivory1
4799 $ui_diff tag conf d_s- \
4800         -foreground red \
4801         -background ivory1
4802
4803 $ui_diff tag conf d<<<<<<< \
4804         -foreground orange \
4805         -font font_diffbold
4806 $ui_diff tag conf d======= \
4807         -foreground orange \
4808         -font font_diffbold
4809 $ui_diff tag conf d>>>>>>> \
4810         -foreground orange \
4811         -font font_diffbold
4812
4813 $ui_diff tag raise sel
4814
4815 # -- Diff Body Context Menu
4816 #
4817 set ctxm .vpane.lower.diff.body.ctxm
4818 menu $ctxm -tearoff 0
4819 $ctxm add command \
4820         -label {Refresh} \
4821         -font font_ui \
4822         -command reshow_diff
4823 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4824 $ctxm add command \
4825         -label {Copy} \
4826         -font font_ui \
4827         -command {tk_textCopy $ui_diff}
4828 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4829 $ctxm add command \
4830         -label {Select All} \
4831         -font font_ui \
4832         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4833 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4834 $ctxm add command \
4835         -label {Copy All} \
4836         -font font_ui \
4837         -command {
4838                 $ui_diff tag add sel 0.0 end
4839                 tk_textCopy $ui_diff
4840                 $ui_diff tag remove sel 0.0 end
4841         }
4842 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4843 $ctxm add separator
4844 $ctxm add command \
4845         -label {Apply/Reverse Hunk} \
4846         -font font_ui \
4847         -command {apply_hunk $cursorX $cursorY}
4848 set ui_diff_applyhunk [$ctxm index last]
4849 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4850 $ctxm add separator
4851 $ctxm add command \
4852         -label {Decrease Font Size} \
4853         -font font_ui \
4854         -command {incr_font_size font_diff -1}
4855 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4856 $ctxm add command \
4857         -label {Increase Font Size} \
4858         -font font_ui \
4859         -command {incr_font_size font_diff 1}
4860 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4861 $ctxm add separator
4862 $ctxm add command \
4863         -label {Show Less Context} \
4864         -font font_ui \
4865         -command {if {$repo_config(gui.diffcontext) >= 2} {
4866                 incr repo_config(gui.diffcontext) -1
4867                 reshow_diff
4868         }}
4869 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4870 $ctxm add command \
4871         -label {Show More Context} \
4872         -font font_ui \
4873         -command {
4874                 incr repo_config(gui.diffcontext)
4875                 reshow_diff
4876         }
4877 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4878 $ctxm add separator
4879 $ctxm add command -label {Options...} \
4880         -font font_ui \
4881         -command do_options
4882 bind_button3 $ui_diff "
4883         set cursorX %x
4884         set cursorY %y
4885         if {\$ui_index eq \$current_diff_side} {
4886                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
4887         } else {
4888                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
4889         }
4890         tk_popup $ctxm %X %Y
4891 "
4892 unset ui_diff_applyhunk
4893
4894 # -- Status Bar
4895 #
4896 set ui_status_value {Initializing...}
4897 label .status -textvariable ui_status_value \
4898         -anchor w \
4899         -justify left \
4900         -borderwidth 1 \
4901         -relief sunken \
4902         -font font_ui
4903 pack .status -anchor w -side bottom -fill x
4904
4905 # -- Load geometry
4906 #
4907 catch {
4908 set gm $repo_config(gui.geometry)
4909 wm geometry . [lindex $gm 0]
4910 .vpane sash place 0 \
4911         [lindex [.vpane sash coord 0] 0] \
4912         [lindex $gm 1]
4913 .vpane.files sash place 0 \
4914         [lindex $gm 2] \
4915         [lindex [.vpane.files sash coord 0] 1]
4916 unset gm
4917 }
4918
4919 # -- Key Bindings
4920 #
4921 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4922 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4923 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4924 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4925 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4926 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4927 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4928 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4929 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4930 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4931 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4932
4933 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4934 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4935 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4936 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4937 bind $ui_diff <$M1B-Key-v> {break}
4938 bind $ui_diff <$M1B-Key-V> {break}
4939 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4940 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4941 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
4942 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
4943 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
4944 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
4945 bind $ui_diff <Button-1>   {focus %W}
4946
4947 if {!$single_commit} {
4948         bind . <$M1B-Key-n> do_create_branch
4949         bind . <$M1B-Key-N> do_create_branch
4950 }
4951
4952 bind .   <Destroy> do_quit
4953 bind all <Key-F5> do_rescan
4954 bind all <$M1B-Key-r> do_rescan
4955 bind all <$M1B-Key-R> do_rescan
4956 bind .   <$M1B-Key-s> do_signoff
4957 bind .   <$M1B-Key-S> do_signoff
4958 bind .   <$M1B-Key-i> do_add_all
4959 bind .   <$M1B-Key-I> do_add_all
4960 bind .   <$M1B-Key-Return> do_commit
4961 bind all <$M1B-Key-q> do_quit
4962 bind all <$M1B-Key-Q> do_quit
4963 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4964 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4965 foreach i [list $ui_index $ui_workdir] {
4966         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
4967         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
4968         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4969 }
4970 unset i
4971
4972 set file_lists($ui_index) [list]
4973 set file_lists($ui_workdir) [list]
4974
4975 set HEAD {}
4976 set PARENT {}
4977 set MERGE_HEAD [list]
4978 set commit_type {}
4979 set empty_tree {}
4980 set current_branch {}
4981 set current_diff_path {}
4982 set selected_commit_type new
4983
4984 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
4985 focus -force $ui_comm
4986
4987 # -- Warn the user about environmental problems.  Cygwin's Tcl
4988 #    does *not* pass its env array onto any processes it spawns.
4989 #    This means that git processes get none of our environment.
4990 #
4991 if {[is_Windows]} {
4992         set ignored_env 0
4993         set suggest_user {}
4994         set msg "Possible environment issues exist.
4995
4996 The following environment variables are probably
4997 going to be ignored by any Git subprocess run
4998 by [appname]:
4999
5000 "
5001         foreach name [array names env] {
5002                 switch -regexp -- $name {
5003                 {^GIT_INDEX_FILE$} -
5004                 {^GIT_OBJECT_DIRECTORY$} -
5005                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5006                 {^GIT_DIFF_OPTS$} -
5007                 {^GIT_EXTERNAL_DIFF$} -
5008                 {^GIT_PAGER$} -
5009                 {^GIT_TRACE$} -
5010                 {^GIT_CONFIG$} -
5011                 {^GIT_CONFIG_LOCAL$} -
5012                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5013                         append msg " - $name\n"
5014                         incr ignored_env
5015                 }
5016                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5017                         append msg " - $name\n"
5018                         incr ignored_env
5019                         set suggest_user $name
5020                 }
5021                 }
5022         }
5023         if {$ignored_env > 0} {
5024                 append msg "
5025 This is due to a known issue with the
5026 Tcl binary distributed by Cygwin."
5027
5028                 if {$suggest_user ne {}} {
5029                         append msg "
5030
5031 A good replacement for $suggest_user
5032 is placing values for the user.name and
5033 user.email settings into your personal
5034 ~/.gitconfig file.
5035 "
5036                 }
5037                 warn_popup $msg
5038         }
5039         unset ignored_env msg suggest_user name
5040 }
5041
5042 # -- Only initialize complex UI if we are going to stay running.
5043 #
5044 if {!$single_commit} {
5045         load_all_remotes
5046         load_all_heads
5047
5048         populate_branch_menu
5049         populate_fetch_menu
5050         populate_push_menu
5051 }
5052
5053 # -- Only suggest a gc run if we are going to stay running.
5054 #
5055 if {!$single_commit} {
5056         set object_limit 2000
5057         if {[is_Windows]} {set object_limit 200}
5058         regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5059         if {$objects_current >= $object_limit} {
5060                 if {[ask_popup \
5061                         "This repository currently has $objects_current loose objects.
5062
5063 To maintain optimal performance it is strongly
5064 recommended that you compress the database
5065 when more than $object_limit loose objects exist.
5066
5067 Compress the database now?"] eq yes} {
5068                         do_gc
5069                 }
5070         }
5071         unset object_limit _junk objects_current
5072 }
5073
5074 lock_index begin-read
5075 after 1 do_rescan