[tokkee]

tokkee.org

Code

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