[tokkee]

tokkee.org

Code

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