Code

git-gui: Protect ourselves from funny GIT_DIR/working directory setups.
[git.git] / git-gui
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
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.
10 set appname [lindex [file split $argv0] end]
11 set gitdir {}
13 ######################################################################
14 ##
15 ## config
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 }
27 proc load_config {include_global} {
28         global repo_config global_config default_config
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         }
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         }
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 }
72 proc save_config {} {
73         global default_config font_descs
74         global repo_config global_config
75         global repo_config_new global_config_new
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         }
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         }
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         }
122 proc error_popup {msg} {
123         global gitdir appname
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
141 proc info_popup {msg} {
142         global gitdir appname
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
160 ######################################################################
161 ##
162 ## repository setup
164 if {   [catch {set gitdir $env(GIT_DIR)}]
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
170 if {![file isdirectory $gitdir]} {
171         catch {wm withdraw .}
172         error_popup "Git directory not found:\n\n$gitdir"
173         exit 1
175 if {[lindex [file split $gitdir] end] ne {.git}} {
176         catch {wm withdraw .}
177         error_popup "Cannot use funny .git directory:\n\n$gitdir"
178         exit 1
180 if {[catch {cd [file dirname $gitdir]} err]} {
181         catch {wm withdraw .}
182         error_popup "No working directory [file dirname $gitdir]:\n\n$err"
183         exit 1
186 set single_commit 0
187 if {$appname eq {git-citool}} {
188         set single_commit 1
191 ######################################################################
192 ##
193 ## task management
195 set rescan_active 0
196 set diff_active 0
197 set last_clicked {}
199 set disable_on_lock [list]
200 set index_lock_type none
202 set HEAD {}
203 set PARENT {}
204 set commit_type {}
206 proc lock_index {type} {
207         global index_lock_type disable_on_lock
209         if {$index_lock_type eq {none}} {
210                 set index_lock_type $type
211                 foreach w $disable_on_lock {
212                         uplevel #0 $w disabled
213                 }
214                 return 1
215         } elseif {$index_lock_type eq {begin-update} && $type eq {update}} {
216                 set index_lock_type $type
217                 return 1
218         }
219         return 0
222 proc unlock_index {} {
223         global index_lock_type disable_on_lock
225         set index_lock_type none
226         foreach w $disable_on_lock {
227                 uplevel #0 $w normal
228         }
231 ######################################################################
232 ##
233 ## status
235 proc repository_state {hdvar ctvar} {
236         global gitdir
237         upvar $hdvar hd $ctvar ct
239         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
240                 set ct initial
241         } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
242                 set ct merge
243         } else {
244                 set ct normal
245         }
248 proc rescan {after} {
249         global HEAD PARENT commit_type
250         global ui_index ui_other ui_status_value ui_comm
251         global rescan_active file_states
252         global repo_config
254         if {$rescan_active > 0 || ![lock_index read]} return
256         repository_state new_HEAD new_type
257         if {$commit_type eq {amend}
258                 && $new_type eq {normal}
259                 && $new_HEAD eq $HEAD} {
260         } else {
261                 set HEAD $new_HEAD
262                 set PARENT $new_HEAD
263                 set commit_type $new_type
264         }
266         array unset file_states
268         if {![$ui_comm edit modified]
269                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
270                 if {[load_message GITGUI_MSG]} {
271                 } elseif {[load_message MERGE_MSG]} {
272                 } elseif {[load_message SQUASH_MSG]} {
273                 }
274                 $ui_comm edit modified false
275                 $ui_comm edit reset
276         }
278         if {$repo_config(gui.trustmtime) eq {true}} {
279                 rescan_stage2 {} $after
280         } else {
281                 set rescan_active 1
282                 set ui_status_value {Refreshing file status...}
283                 set cmd [list git update-index]
284                 lappend cmd -q
285                 lappend cmd --unmerged
286                 lappend cmd --ignore-missing
287                 lappend cmd --refresh
288                 set fd_rf [open "| $cmd" r]
289                 fconfigure $fd_rf -blocking 0 -translation binary
290                 fileevent $fd_rf readable \
291                         [list rescan_stage2 $fd_rf $after]
292         }
295 proc rescan_stage2 {fd after} {
296         global gitdir PARENT commit_type
297         global ui_index ui_other ui_status_value ui_comm
298         global rescan_active
299         global buf_rdi buf_rdf buf_rlo
301         if {$fd ne {}} {
302                 read $fd
303                 if {![eof $fd]} return
304                 close $fd
305         }
307         set ls_others [list | git ls-files --others -z \
308                 --exclude-per-directory=.gitignore]
309         set info_exclude [file join $gitdir info exclude]
310         if {[file readable $info_exclude]} {
311                 lappend ls_others "--exclude-from=$info_exclude"
312         }
314         set buf_rdi {}
315         set buf_rdf {}
316         set buf_rlo {}
318         set rescan_active 3
319         set ui_status_value {Scanning for modified files ...}
320         set fd_di [open "| git diff-index --cached -z $PARENT" r]
321         set fd_df [open "| git diff-files -z" r]
322         set fd_lo [open $ls_others r]
324         fconfigure $fd_di -blocking 0 -translation binary
325         fconfigure $fd_df -blocking 0 -translation binary
326         fconfigure $fd_lo -blocking 0 -translation binary
327         fileevent $fd_di readable [list read_diff_index $fd_di $after]
328         fileevent $fd_df readable [list read_diff_files $fd_df $after]
329         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
332 proc load_message {file} {
333         global gitdir ui_comm
335         set f [file join $gitdir $file]
336         if {[file isfile $f]} {
337                 if {[catch {set fd [open $f r]}]} {
338                         return 0
339                 }
340                 set content [string trim [read $fd]]
341                 close $fd
342                 $ui_comm delete 0.0 end
343                 $ui_comm insert end $content
344                 return 1
345         }
346         return 0
349 proc read_diff_index {fd after} {
350         global buf_rdi
352         append buf_rdi [read $fd]
353         set c 0
354         set n [string length $buf_rdi]
355         while {$c < $n} {
356                 set z1 [string first "\0" $buf_rdi $c]
357                 if {$z1 == -1} break
358                 incr z1
359                 set z2 [string first "\0" $buf_rdi $z1]
360                 if {$z2 == -1} break
362                 set c $z2
363                 incr z2 -1
364                 display_file \
365                         [string range $buf_rdi $z1 $z2] \
366                         [string index $buf_rdi [expr {$z1 - 2}]]_
367                 incr c
368         }
369         if {$c < $n} {
370                 set buf_rdi [string range $buf_rdi $c end]
371         } else {
372                 set buf_rdi {}
373         }
375         rescan_done $fd buf_rdi $after
378 proc read_diff_files {fd after} {
379         global buf_rdf
381         append buf_rdf [read $fd]
382         set c 0
383         set n [string length $buf_rdf]
384         while {$c < $n} {
385                 set z1 [string first "\0" $buf_rdf $c]
386                 if {$z1 == -1} break
387                 incr z1
388                 set z2 [string first "\0" $buf_rdf $z1]
389                 if {$z2 == -1} break
391                 set c $z2
392                 incr z2 -1
393                 display_file \
394                         [string range $buf_rdf $z1 $z2] \
395                         _[string index $buf_rdf [expr {$z1 - 2}]]
396                 incr c
397         }
398         if {$c < $n} {
399                 set buf_rdf [string range $buf_rdf $c end]
400         } else {
401                 set buf_rdf {}
402         }
404         rescan_done $fd buf_rdf $after
407 proc read_ls_others {fd after} {
408         global buf_rlo
410         append buf_rlo [read $fd]
411         set pck [split $buf_rlo "\0"]
412         set buf_rlo [lindex $pck end]
413         foreach p [lrange $pck 0 end-1] {
414                 display_file $p _O
415         }
416         rescan_done $fd buf_rlo $after
419 proc rescan_done {fd buf after} {
420         global rescan_active
421         global file_states repo_config
422         upvar $buf to_clear
424         if {![eof $fd]} return
425         set to_clear {}
426         close $fd
427         if {[incr rescan_active -1] > 0} return
429         prune_selection
430         unlock_index
431         display_all_files
433         if {$repo_config(gui.partialinclude) ne {true}} {
434                 set pathList [list]
435                 foreach path [array names file_states] {
436                         switch -- [lindex $file_states($path) 0] {
437                         AM -
438                         MM {lappend pathList $path}
439                         }
440                 }
441                 if {$pathList ne {}} {
442                         update_index \
443                                 "Updating included files" \
444                                 $pathList \
445                                 [concat {reshow_diff;} $after]
446                         return
447                 }
448         }
450         reshow_diff
451         uplevel #0 $after
454 proc prune_selection {} {
455         global file_states selected_paths
457         foreach path [array names selected_paths] {
458                 if {[catch {set still_here $file_states($path)}]} {
459                         unset selected_paths($path)
460                 }
461         }
464 ######################################################################
465 ##
466 ## diff
468 proc clear_diff {} {
469         global ui_diff current_diff ui_index ui_other
471         $ui_diff conf -state normal
472         $ui_diff delete 0.0 end
473         $ui_diff conf -state disabled
475         set current_diff {}
477         $ui_index tag remove in_diff 0.0 end
478         $ui_other tag remove in_diff 0.0 end
481 proc reshow_diff {} {
482         global current_diff ui_status_value file_states
484         if {$current_diff eq {}
485                 || [catch {set s $file_states($current_diff)}]} {
486                 clear_diff
487         } else {
488                 show_diff $current_diff
489         }
492 proc handle_empty_diff {} {
493         global current_diff file_states file_lists
495         set path $current_diff
496         set s $file_states($path)
497         if {[lindex $s 0] ne {_M}} return
499         info_popup "No differences detected.
501 [short_path $path] has no changes.
503 The modification date of this file was updated
504 by another application and you currently have
505 the Trust File Modification Timestamps option
506 enabled, so Git did not automatically detect
507 that there are no content differences in this
508 file.
510 This file will now be removed from the modified
511 files list, to prevent possible confusion.
513         if {[catch {exec git update-index -- $path} err]} {
514                 error_popup "Failed to refresh index:\n\n$err"
515         }
517         clear_diff
518         set old_w [mapcol [lindex $file_states($path) 0] $path]
519         set lno [lsearch -sorted $file_lists($old_w) $path]
520         if {$lno >= 0} {
521                 set file_lists($old_w) \
522                         [lreplace $file_lists($old_w) $lno $lno]
523                 incr lno
524                 $old_w conf -state normal
525                 $old_w delete $lno.0 [expr {$lno + 1}].0
526                 $old_w conf -state disabled
527         }
530 proc show_diff {path {w {}} {lno {}}} {
531         global file_states file_lists
532         global PARENT diff_3way diff_active repo_config
533         global ui_diff current_diff ui_status_value
535         if {$diff_active || ![lock_index read]} return
537         clear_diff
538         if {$w eq {} || $lno == {}} {
539                 foreach w [array names file_lists] {
540                         set lno [lsearch -sorted $file_lists($w) $path]
541                         if {$lno >= 0} {
542                                 incr lno
543                                 break
544                         }
545                 }
546         }
547         if {$w ne {} && $lno >= 1} {
548                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
549         }
551         set s $file_states($path)
552         set m [lindex $s 0]
553         set diff_3way 0
554         set diff_active 1
555         set current_diff $path
556         set ui_status_value "Loading diff of [escape_path $path]..."
558         set cmd [list | git diff-index]
559         lappend cmd --no-color
560         if {$repo_config(gui.diffcontext) > 0} {
561                 lappend cmd "-U$repo_config(gui.diffcontext)"
562         }
563         lappend cmd -p
565         switch $m {
566         MM {
567                 lappend cmd -c
568         }
569         _O {
570                 if {[catch {
571                                 set fd [open $path r]
572                                 set content [read $fd]
573                                 close $fd
574                         } err ]} {
575                         set diff_active 0
576                         unlock_index
577                         set ui_status_value "Unable to display [escape_path $path]"
578                         error_popup "Error loading file:\n\n$err"
579                         return
580                 }
581                 $ui_diff conf -state normal
582                 $ui_diff insert end $content
583                 $ui_diff conf -state disabled
584                 set diff_active 0
585                 unlock_index
586                 set ui_status_value {Ready.}
587                 return
588         }
589         }
591         lappend cmd $PARENT
592         lappend cmd --
593         lappend cmd $path
595         if {[catch {set fd [open $cmd r]} err]} {
596                 set diff_active 0
597                 unlock_index
598                 set ui_status_value "Unable to display [escape_path $path]"
599                 error_popup "Error loading diff:\n\n$err"
600                 return
601         }
603         fconfigure $fd -blocking 0 -translation auto
604         fileevent $fd readable [list read_diff $fd]
607 proc read_diff {fd} {
608         global ui_diff ui_status_value diff_3way diff_active
609         global repo_config
611         while {[gets $fd line] >= 0} {
612                 if {[string match {diff --git *} $line]} continue
613                 if {[string match {diff --combined *} $line]} continue
614                 if {[string match {--- *} $line]} continue
615                 if {[string match {+++ *} $line]} continue
616                 if {[string match index* $line]} {
617                         if {[string first , $line] >= 0} {
618                                 set diff_3way 1
619                         }
620                 }
622                 $ui_diff conf -state normal
623                 if {!$diff_3way} {
624                         set x [string index $line 0]
625                         switch -- $x {
626                         "@" {set tags da}
627                         "+" {set tags dp}
628                         "-" {set tags dm}
629                         default {set tags {}}
630                         }
631                 } else {
632                         set x [string range $line 0 1]
633                         switch -- $x {
634                         default {set tags {}}
635                         "@@" {set tags da}
636                         "++" {set tags dp; set x " +"}
637                         " +" {set tags {di bold}; set x "++"}
638                         "+ " {set tags dni; set x "-+"}
639                         "--" {set tags dm; set x " -"}
640                         " -" {set tags {dm bold}; set x "--"}
641                         "- " {set tags di; set x "+-"}
642                         default {set tags {}}
643                         }
644                         set line [string replace $line 0 1 $x]
645                 }
646                 $ui_diff insert end $line $tags
647                 $ui_diff insert end "\n"
648                 $ui_diff conf -state disabled
649         }
651         if {[eof $fd]} {
652                 close $fd
653                 set diff_active 0
654                 unlock_index
655                 set ui_status_value {Ready.}
657                 if {$repo_config(gui.trustmtime) eq {true}
658                         && [$ui_diff index end] eq {2.0}} {
659                         handle_empty_diff
660                 }
661         }
664 ######################################################################
665 ##
666 ## commit
668 proc load_last_commit {} {
669         global HEAD PARENT commit_type ui_comm
671         if {$commit_type eq {amend}} return
672         if {$commit_type ne {normal}} {
673                 error_popup "Can't amend a $commit_type commit."
674                 return
675         }
677         set msg {}
678         set parent {}
679         set parent_count 0
680         if {[catch {
681                         set fd [open "| git cat-file commit $HEAD" r]
682                         while {[gets $fd line] > 0} {
683                                 if {[string match {parent *} $line]} {
684                                         set parent [string range $line 7 end]
685                                         incr parent_count
686                                 }
687                         }
688                         set msg [string trim [read $fd]]
689                         close $fd
690                 } err]} {
691                 error_popup "Error loading commit data for amend:\n\n$err"
692                 return
693         }
695         if {$parent_count == 0} {
696                 set commit_type amend
697                 set HEAD {}
698                 set PARENT {}
699                 rescan {set ui_status_value {Ready.}}
700         } elseif {$parent_count == 1} {
701                 set commit_type amend
702                 set PARENT $parent
703                 $ui_comm delete 0.0 end
704                 $ui_comm insert end $msg
705                 $ui_comm edit modified false
706                 $ui_comm edit reset
707                 rescan {set ui_status_value {Ready.}}
708         } else {
709                 error_popup {You can't amend a merge commit.}
710                 return
711         }
714 proc commit_tree {} {
715         global HEAD commit_type file_states ui_comm repo_config
717         if {![lock_index update]} return
719         # -- Our in memory state should match the repository.
720         #
721         repository_state curHEAD cur_type
722         if {$commit_type eq {amend}
723                 && $cur_type eq {normal}
724                 && $curHEAD eq $HEAD} {
725         } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
726                 error_popup {Last scanned state does not match repository state.
728 Its highly likely that another Git program modified the
729 repository since the last scan.  A rescan is required
730 before committing.
732 A rescan will be automatically started now.
734                 unlock_index
735                 rescan {set ui_status_value {Ready.}}
736                 return
737         }
739         # -- At least one file should differ in the index.
740         #
741         set files_ready 0
742         foreach path [array names file_states] {
743                 switch -glob -- [lindex $file_states($path) 0] {
744                 _? {continue}
745                 A? -
746                 D? -
747                 M? {set files_ready 1; break}
748                 U? {
749                         error_popup "Unmerged files cannot be committed.
751 File [short_path $path] has merge conflicts.
752 You must resolve them and include the file before committing.
754                         unlock_index
755                         return
756                 }
757                 default {
758                         error_popup "Unknown file state [lindex $s 0] detected.
760 File [short_path $path] cannot be committed by this program.
762                 }
763                 }
764         }
765         if {!$files_ready} {
766                 error_popup {No included files to commit.
768 You must include at least 1 file before you can commit.
770                 unlock_index
771                 return
772         }
774         # -- A message is required.
775         #
776         set msg [string trim [$ui_comm get 1.0 end]]
777         if {$msg eq {}} {
778                 error_popup {Please supply a commit message.
780 A good commit message has the following format:
782 - First line: Describe in one sentance what you did.
783 - Second line: Blank
784 - Remaining lines: Describe why this change is good.
786                 unlock_index
787                 return
788         }
790         # -- Update included files if partialincludes are off.
791         #
792         if {$repo_config(gui.partialinclude) ne {true}} {
793                 set pathList [list]
794                 foreach path [array names file_states] {
795                         switch -glob -- [lindex $file_states($path) 0] {
796                         A? -
797                         M? {lappend pathList $path}
798                         }
799                 }
800                 if {$pathList ne {}} {
801                         unlock_index
802                         update_index \
803                                 "Updating included files" \
804                                 $pathList \
805                                 [concat {lock_index update;} \
806                                         [list commit_prehook $curHEAD $msg]]
807                         return
808                 }
809         }
811         commit_prehook $curHEAD $msg
814 proc commit_prehook {curHEAD msg} {
815         global tcl_platform gitdir ui_status_value pch_error
817         # On Cygwin [file executable] might lie so we need to ask
818         # the shell if the hook is executable.  Yes that's annoying.
820         set pchook [file join $gitdir hooks pre-commit]
821         if {$tcl_platform(platform) eq {windows}
822                 && [file isfile $pchook]} {
823                 set pchook [list sh -c [concat \
824                         "if test -x \"$pchook\";" \
825                         "then exec \"$pchook\" 2>&1;" \
826                         "fi"]]
827         } elseif {[file executable $pchook]} {
828                 set pchook [list $pchook |& cat]
829         } else {
830                 commit_writetree $curHEAD $msg
831                 return
832         }
834         set ui_status_value {Calling pre-commit hook...}
835         set pch_error {}
836         set fd_ph [open "| $pchook" r]
837         fconfigure $fd_ph -blocking 0 -translation binary
838         fileevent $fd_ph readable \
839                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
842 proc commit_prehook_wait {fd_ph curHEAD msg} {
843         global pch_error ui_status_value
845         append pch_error [read $fd_ph]
846         fconfigure $fd_ph -blocking 1
847         if {[eof $fd_ph]} {
848                 if {[catch {close $fd_ph}]} {
849                         set ui_status_value {Commit declined by pre-commit hook.}
850                         hook_failed_popup pre-commit $pch_error
851                         unlock_index
852                 } else {
853                         commit_writetree $curHEAD $msg
854                 }
855                 set pch_error {}
856                 return
857         }
858         fconfigure $fd_ph -blocking 0
861 proc commit_writetree {curHEAD msg} {
862         global ui_status_value
864         set ui_status_value {Committing changes...}
865         set fd_wt [open "| git write-tree" r]
866         fileevent $fd_wt readable \
867                 [list commit_committree $fd_wt $curHEAD $msg]
870 proc commit_committree {fd_wt curHEAD msg} {
871         global single_commit gitdir HEAD PARENT commit_type tcl_platform
872         global ui_status_value ui_comm
873         global file_states selected_paths
875         gets $fd_wt tree_id
876         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
877                 error_popup "write-tree failed:\n\n$err"
878                 set ui_status_value {Commit failed.}
879                 unlock_index
880                 return
881         }
883         # -- Create the commit.
884         #
885         set cmd [list git commit-tree $tree_id]
886         if {$PARENT ne {}} {
887                 lappend cmd -p $PARENT
888         }
889         if {$commit_type eq {merge}} {
890                 if {[catch {
891                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
892                                 while {[gets $fd_mh merge_head] >= 0} {
893                                         lappend cmd -p $merge_head
894                                 }
895                                 close $fd_mh
896                         } err]} {
897                         error_popup "Loading MERGE_HEAD failed:\n\n$err"
898                         set ui_status_value {Commit failed.}
899                         unlock_index
900                         return
901                 }
902         }
903         if {$PARENT eq {}} {
904                 # git commit-tree writes to stderr during initial commit.
905                 lappend cmd 2>/dev/null
906         }
907         lappend cmd << $msg
908         if {[catch {set cmt_id [eval exec $cmd]} err]} {
909                 error_popup "commit-tree failed:\n\n$err"
910                 set ui_status_value {Commit failed.}
911                 unlock_index
912                 return
913         }
915         # -- Update the HEAD ref.
916         #
917         set reflogm commit
918         if {$commit_type ne {normal}} {
919                 append reflogm " ($commit_type)"
920         }
921         set i [string first "\n" $msg]
922         if {$i >= 0} {
923                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
924         } else {
925                 append reflogm {: } $msg
926         }
927         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
928         if {[catch {eval exec $cmd} err]} {
929                 error_popup "update-ref failed:\n\n$err"
930                 set ui_status_value {Commit failed.}
931                 unlock_index
932                 return
933         }
935         # -- Cleanup after ourselves.
936         #
937         catch {file delete [file join $gitdir MERGE_HEAD]}
938         catch {file delete [file join $gitdir MERGE_MSG]}
939         catch {file delete [file join $gitdir SQUASH_MSG]}
940         catch {file delete [file join $gitdir GITGUI_MSG]}
942         # -- Let rerere do its thing.
943         #
944         if {[file isdirectory [file join $gitdir rr-cache]]} {
945                 catch {exec git rerere}
946         }
948         # -- Run the post-commit hook.
949         #
950         set pchook [file join $gitdir hooks post-commit]
951         if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
952                 set pchook [list sh -c [concat \
953                         "if test -x \"$pchook\";" \
954                         "then exec \"$pchook\";" \
955                         "fi"]]
956         } elseif {![file executable $pchook]} {
957                 set pchook {}
958         }
959         if {$pchook ne {}} {
960                 catch {exec $pchook &}
961         }
963         $ui_comm delete 0.0 end
964         $ui_comm edit modified false
965         $ui_comm edit reset
967         if {$single_commit} do_quit
969         # -- Update status without invoking any git commands.
970         #
971         set commit_type normal
972         set HEAD $cmt_id
973         set PARENT $cmt_id
975         foreach path [array names file_states] {
976                 set s $file_states($path)
977                 set m [lindex $s 0]
978                 switch -glob -- $m {
979                 A? -
980                 M? -
981                 D? {set m _[string index $m 1]}
982                 }
984                 if {$m eq {__}} {
985                         unset file_states($path)
986                         catch {unset selected_paths($path)}
987                 } else {
988                         lset file_states($path) 0 $m
989                 }
990         }
992         display_all_files
993         unlock_index
994         reshow_diff
995         set ui_status_value \
996                 "Changes committed as [string range $cmt_id 0 7]."
999 ######################################################################
1000 ##
1001 ## fetch pull push
1003 proc fetch_from {remote} {
1004         set w [new_console "fetch $remote" \
1005                 "Fetching new changes from $remote"]
1006         set cmd [list git fetch]
1007         lappend cmd $remote
1008         console_exec $w $cmd
1011 proc pull_remote {remote branch} {
1012         global HEAD commit_type file_states repo_config
1014         if {![lock_index update]} return
1016         # -- Our in memory state should match the repository.
1017         #
1018         repository_state curHEAD cur_type
1019         if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
1020                 error_popup {Last scanned state does not match repository state.
1022 Its highly likely that another Git program modified the
1023 repository since our last scan.  A rescan is required
1024 before a pull can be started.
1026                 unlock_index
1027                 rescan {set ui_status_value {Ready.}}
1028                 return
1029         }
1031         # -- No differences should exist before a pull.
1032         #
1033         if {[array size file_states] != 0} {
1034                 error_popup {Uncommitted but modified files are present.
1036 You should not perform a pull with unmodified files in your working
1037 directory as Git would be unable to recover from an incorrect merge.
1039 Commit or throw away all changes before starting a pull operation.
1041                 unlock_index
1042                 return
1043         }
1045         set w [new_console "pull $remote $branch" \
1046                 "Pulling new changes from branch $branch in $remote"]
1047         set cmd [list git pull]
1048         if {$repo_config(gui.pullsummary) eq {false}} {
1049                 lappend cmd --no-summary
1050         }
1051         lappend cmd $remote
1052         lappend cmd $branch
1053         console_exec $w $cmd [list post_pull_remote $remote $branch]
1056 proc post_pull_remote {remote branch success} {
1057         global HEAD PARENT commit_type
1058         global ui_status_value
1060         unlock_index
1061         if {$success} {
1062                 repository_state HEAD commit_type
1063                 set PARENT $HEAD
1064                 set $ui_status_value "Pulling $branch from $remote complete."
1065         } else {
1066                 set m "Conflicts detected while pulling $branch from $remote."
1067                 rescan "set ui_status_value {$m}"
1068         }
1071 proc push_to {remote} {
1072         set w [new_console "push $remote" \
1073                 "Pushing changes to $remote"]
1074         set cmd [list git push]
1075         lappend cmd $remote
1076         console_exec $w $cmd
1079 ######################################################################
1080 ##
1081 ## ui helpers
1083 proc mapcol {state path} {
1084         global all_cols ui_other
1086         if {[catch {set r $all_cols($state)}]} {
1087                 puts "error: no column for state={$state} $path"
1088                 return $ui_other
1089         }
1090         return $r
1093 proc mapicon {state path} {
1094         global all_icons
1096         if {[catch {set r $all_icons($state)}]} {
1097                 puts "error: no icon for state={$state} $path"
1098                 return file_plain
1099         }
1100         return $r
1103 proc mapdesc {state path} {
1104         global all_descs
1106         if {[catch {set r $all_descs($state)}]} {
1107                 puts "error: no desc for state={$state} $path"
1108                 return $state
1109         }
1110         return $r
1113 proc escape_path {path} {
1114         regsub -all "\n" $path "\\n" path
1115         return $path
1118 proc short_path {path} {
1119         return [escape_path [lindex [file split $path] end]]
1122 set next_icon_id 0
1124 proc merge_state {path new_state} {
1125         global file_states next_icon_id
1127         set s0 [string index $new_state 0]
1128         set s1 [string index $new_state 1]
1130         if {[catch {set info $file_states($path)}]} {
1131                 set state __
1132                 set icon n[incr next_icon_id]
1133         } else {
1134                 set state [lindex $info 0]
1135                 set icon [lindex $info 1]
1136         }
1138         if {$s0 eq {_}} {
1139                 set s0 [string index $state 0]
1140         } elseif {$s0 eq {*}} {
1141                 set s0 _
1142         }
1144         if {$s1 eq {_}} {
1145                 set s1 [string index $state 1]
1146         } elseif {$s1 eq {*}} {
1147                 set s1 _
1148         }
1150         set file_states($path) [list $s0$s1 $icon]
1151         return $state
1154 proc display_file {path state} {
1155         global file_states file_lists selected_paths rescan_active
1157         set old_m [merge_state $path $state]
1158         if {$rescan_active > 0} return
1160         set s $file_states($path)
1161         set new_m [lindex $s 0]
1162         set new_w [mapcol $new_m $path] 
1163         set old_w [mapcol $old_m $path]
1164         set new_icon [mapicon $new_m $path]
1166         if {$new_w ne $old_w} {
1167                 set lno [lsearch -sorted $file_lists($old_w) $path]
1168                 if {$lno >= 0} {
1169                         incr lno
1170                         $old_w conf -state normal
1171                         $old_w delete $lno.0 [expr {$lno + 1}].0
1172                         $old_w conf -state disabled
1173                 }
1175                 lappend file_lists($new_w) $path
1176                 set file_lists($new_w) [lsort $file_lists($new_w)]
1177                 set lno [lsearch -sorted $file_lists($new_w) $path]
1178                 incr lno
1179                 $new_w conf -state normal
1180                 $new_w image create $lno.0 \
1181                         -align center -padx 5 -pady 1 \
1182                         -name [lindex $s 1] \
1183                         -image $new_icon
1184                 $new_w insert $lno.1 "[escape_path $path]\n"
1185                 if {[catch {set in_sel $selected_paths($path)}]} {
1186                         set in_sel 0
1187                 }
1188                 if {$in_sel} {
1189                         $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1190                 }
1191                 $new_w conf -state disabled
1192         } elseif {$new_icon ne [mapicon $old_m $path]} {
1193                 $new_w conf -state normal
1194                 $new_w image conf [lindex $s 1] -image $new_icon
1195                 $new_w conf -state disabled
1196         }
1199 proc display_all_files {} {
1200         global ui_index ui_other
1201         global file_states file_lists
1202         global last_clicked selected_paths
1204         $ui_index conf -state normal
1205         $ui_other conf -state normal
1207         $ui_index delete 0.0 end
1208         $ui_other delete 0.0 end
1209         set last_clicked {}
1211         set file_lists($ui_index) [list]
1212         set file_lists($ui_other) [list]
1214         foreach path [lsort [array names file_states]] {
1215                 set s $file_states($path)
1216                 set m [lindex $s 0]
1217                 set w [mapcol $m $path]
1218                 lappend file_lists($w) $path
1219                 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1220                 $w image create end \
1221                         -align center -padx 5 -pady 1 \
1222                         -name [lindex $s 1] \
1223                         -image [mapicon $m $path]
1224                 $w insert end "[escape_path $path]\n"
1225                 if {[catch {set in_sel $selected_paths($path)}]} {
1226                         set in_sel 0
1227                 }
1228                 if {$in_sel} {
1229                         $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1230                 }
1231         }
1233         $ui_index conf -state disabled
1234         $ui_other conf -state disabled
1237 proc update_index {msg pathList after} {
1238         global update_index_cp update_index_rsd ui_status_value
1240         if {![lock_index update]} return
1242         set update_index_cp 0
1243         set update_index_rsd 0
1244         set pathList [lsort $pathList]
1245         set totalCnt [llength $pathList]
1246         set batch [expr {int($totalCnt * .01) + 1}]
1247         if {$batch > 25} {set batch 25}
1249         set ui_status_value [format \
1250                 "$msg... %i/%i files (%.2f%%)" \
1251                 $update_index_cp \
1252                 $totalCnt \
1253                 0.0]
1254         set fd [open "| git update-index --add --remove -z --stdin" w]
1255         fconfigure $fd \
1256                 -blocking 0 \
1257                 -buffering full \
1258                 -buffersize 512 \
1259                 -translation binary
1260         fileevent $fd writable [list \
1261                 write_update_index \
1262                 $fd \
1263                 $pathList \
1264                 $totalCnt \
1265                 $batch \
1266                 $msg \
1267                 $after \
1268                 ]
1271 proc write_update_index {fd pathList totalCnt batch msg after} {
1272         global update_index_cp update_index_rsd ui_status_value
1273         global file_states current_diff
1275         if {$update_index_cp >= $totalCnt} {
1276                 close $fd
1277                 unlock_index
1278                 if {$update_index_rsd} reshow_diff
1279                 uplevel #0 $after
1280                 return
1281         }
1283         for {set i $batch} \
1284                 {$update_index_cp < $totalCnt && $i > 0} \
1285                 {incr i -1} {
1286                 set path [lindex $pathList $update_index_cp]
1287                 incr update_index_cp
1289                 switch -glob -- [lindex $file_states($path) 0] {
1290                 AD -
1291                 MD -
1292                 _D {set new D*}
1294                 _M -
1295                 MM -
1296                 M_ {set new M*}
1298                 _O -
1299                 AM -
1300                 A_ {set new A*}
1302                 ?? {continue}
1303                 }
1305                 puts -nonewline $fd $path
1306                 puts -nonewline $fd "\0"
1307                 display_file $path $new
1308                 if {$current_diff eq $path} {
1309                         set update_index_rsd 1
1310                 }
1311         }
1313         set ui_status_value [format \
1314                 "$msg... %i/%i files (%.2f%%)" \
1315                 $update_index_cp \
1316                 $totalCnt \
1317                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1320 ######################################################################
1321 ##
1322 ## remote management
1324 proc load_all_remotes {} {
1325         global gitdir all_remotes repo_config
1327         set all_remotes [list]
1328         set rm_dir [file join $gitdir remotes]
1329         if {[file isdirectory $rm_dir]} {
1330                 set all_remotes [concat $all_remotes [glob \
1331                         -types f \
1332                         -tails \
1333                         -nocomplain \
1334                         -directory $rm_dir *]]
1335         }
1337         foreach line [array names repo_config remote.*.url] {
1338                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1339                         lappend all_remotes $name
1340                 }
1341         }
1343         set all_remotes [lsort -unique $all_remotes]
1346 proc populate_remote_menu {m pfx op} {
1347         global all_remotes
1349         foreach remote $all_remotes {
1350                 $m add command -label "$pfx $remote..." \
1351                         -command [list $op $remote] \
1352                         -font font_ui
1353         }
1356 proc populate_pull_menu {m} {
1357         global gitdir repo_config all_remotes disable_on_lock
1359         foreach remote $all_remotes {
1360                 set rb {}
1361                 if {[array get repo_config remote.$remote.url] ne {}} {
1362                         if {[array get repo_config remote.$remote.fetch] ne {}} {
1363                                 regexp {^([^:]+):} \
1364                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1365                                         line rb
1366                         }
1367                 } else {
1368                         catch {
1369                                 set fd [open [file join $gitdir remotes $remote] r]
1370                                 while {[gets $fd line] >= 0} {
1371                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1372                                                 break
1373                                         }
1374                                 }
1375                                 close $fd
1376                         }
1377                 }
1379                 set rb_short $rb
1380                 regsub ^refs/heads/ $rb {} rb_short
1381                 if {$rb_short ne {}} {
1382                         $m add command \
1383                                 -label "Branch $rb_short from $remote..." \
1384                                 -command [list pull_remote $remote $rb] \
1385                                 -font font_ui
1386                         lappend disable_on_lock \
1387                                 [list $m entryconf [$m index last] -state]
1388                 }
1389         }
1392 ######################################################################
1393 ##
1394 ## icons
1396 set filemask {
1397 #define mask_width 14
1398 #define mask_height 15
1399 static unsigned char mask_bits[] = {
1400    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1401    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1402    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1405 image create bitmap file_plain -background white -foreground black -data {
1406 #define plain_width 14
1407 #define plain_height 15
1408 static unsigned char plain_bits[] = {
1409    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1410    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1411    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1412 } -maskdata $filemask
1414 image create bitmap file_mod -background white -foreground blue -data {
1415 #define mod_width 14
1416 #define mod_height 15
1417 static unsigned char mod_bits[] = {
1418    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1419    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1420    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1421 } -maskdata $filemask
1423 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1424 #define file_fulltick_width 14
1425 #define file_fulltick_height 15
1426 static unsigned char file_fulltick_bits[] = {
1427    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1428    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1429    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1430 } -maskdata $filemask
1432 image create bitmap file_parttick -background white -foreground "#005050" -data {
1433 #define parttick_width 14
1434 #define parttick_height 15
1435 static unsigned char parttick_bits[] = {
1436    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1437    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1438    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1439 } -maskdata $filemask
1441 image create bitmap file_question -background white -foreground black -data {
1442 #define file_question_width 14
1443 #define file_question_height 15
1444 static unsigned char file_question_bits[] = {
1445    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1446    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1447    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1448 } -maskdata $filemask
1450 image create bitmap file_removed -background white -foreground red -data {
1451 #define file_removed_width 14
1452 #define file_removed_height 15
1453 static unsigned char file_removed_bits[] = {
1454    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1455    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1456    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1457 } -maskdata $filemask
1459 image create bitmap file_merge -background white -foreground blue -data {
1460 #define file_merge_width 14
1461 #define file_merge_height 15
1462 static unsigned char file_merge_bits[] = {
1463    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1464    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1465    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1466 } -maskdata $filemask
1468 set ui_index .vpane.files.index.list
1469 set ui_other .vpane.files.other.list
1470 set max_status_desc 0
1471 foreach i {
1472                 {__ i plain    "Unmodified"}
1473                 {_M i mod      "Modified"}
1474                 {M_ i fulltick "Included in commit"}
1475                 {MM i parttick "Partially included"}
1477                 {_O o plain    "Untracked"}
1478                 {A_ o fulltick "Added by commit"}
1479                 {AM o parttick "Partially added"}
1480                 {AD o question "Added (but now gone)"}
1482                 {_D i question "Missing"}
1483                 {D_ i removed  "Removed by commit"}
1484                 {DD i removed  "Removed by commit"}
1485                 {DO i removed  "Removed (still exists)"}
1487                 {UM i merge    "Merge conflicts"}
1488                 {U_ i merge    "Merge conflicts"}
1489         } {
1490         if {$max_status_desc < [string length [lindex $i 3]]} {
1491                 set max_status_desc [string length [lindex $i 3]]
1492         }
1493         if {[lindex $i 1] eq {i}} {
1494                 set all_cols([lindex $i 0]) $ui_index
1495         } else {
1496                 set all_cols([lindex $i 0]) $ui_other
1497         }
1498         set all_icons([lindex $i 0]) file_[lindex $i 2]
1499         set all_descs([lindex $i 0]) [lindex $i 3]
1501 unset filemask i
1503 ######################################################################
1504 ##
1505 ## util
1507 proc is_MacOSX {} {
1508         global tcl_platform tk_library
1509         if {$tcl_platform(platform) eq {unix}
1510                 && $tcl_platform(os) eq {Darwin}
1511                 && [string match /Library/Frameworks/* $tk_library]} {
1512                 return 1
1513         }
1514         return 0
1517 proc bind_button3 {w cmd} {
1518         bind $w <Any-Button-3> $cmd
1519         if {[is_MacOSX]} {
1520                 bind $w <Control-Button-1> $cmd
1521         }
1524 proc incr_font_size {font {amt 1}} {
1525         set sz [font configure $font -size]
1526         incr sz $amt
1527         font configure $font -size $sz
1528         font configure ${font}bold -size $sz
1531 proc hook_failed_popup {hook msg} {
1532         global gitdir appname
1534         set w .hookfail
1535         toplevel $w
1537         frame $w.m
1538         label $w.m.l1 -text "$hook hook failed:" \
1539                 -anchor w \
1540                 -justify left \
1541                 -font font_uibold
1542         text $w.m.t \
1543                 -background white -borderwidth 1 \
1544                 -relief sunken \
1545                 -width 80 -height 10 \
1546                 -font font_diff \
1547                 -yscrollcommand [list $w.m.sby set]
1548         label $w.m.l2 \
1549                 -text {You must correct the above errors before committing.} \
1550                 -anchor w \
1551                 -justify left \
1552                 -font font_uibold
1553         scrollbar $w.m.sby -command [list $w.m.t yview]
1554         pack $w.m.l1 -side top -fill x
1555         pack $w.m.l2 -side bottom -fill x
1556         pack $w.m.sby -side right -fill y
1557         pack $w.m.t -side left -fill both -expand 1
1558         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1560         $w.m.t insert 1.0 $msg
1561         $w.m.t conf -state disabled
1563         button $w.ok -text OK \
1564                 -width 15 \
1565                 -font font_ui \
1566                 -command "destroy $w"
1567         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1569         bind $w <Visibility> "grab $w; focus $w"
1570         bind $w <Key-Return> "destroy $w"
1571         wm title $w "$appname ([lindex [file split \
1572                 [file normalize [file dirname $gitdir]]] \
1573                 end]): error"
1574         tkwait window $w
1577 set next_console_id 0
1579 proc new_console {short_title long_title} {
1580         global next_console_id console_data
1581         set w .console[incr next_console_id]
1582         set console_data($w) [list $short_title $long_title]
1583         return [console_init $w]
1586 proc console_init {w} {
1587         global console_cr console_data
1588         global gitdir appname M1B
1590         set console_cr($w) 1.0
1591         toplevel $w
1592         frame $w.m
1593         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1594                 -anchor w \
1595                 -justify left \
1596                 -font font_uibold
1597         text $w.m.t \
1598                 -background white -borderwidth 1 \
1599                 -relief sunken \
1600                 -width 80 -height 10 \
1601                 -font font_diff \
1602                 -state disabled \
1603                 -yscrollcommand [list $w.m.sby set]
1604         label $w.m.s -text {Working... please wait...} \
1605                 -anchor w \
1606                 -justify left \
1607                 -font font_uibold
1608         scrollbar $w.m.sby -command [list $w.m.t yview]
1609         pack $w.m.l1 -side top -fill x
1610         pack $w.m.s -side bottom -fill x
1611         pack $w.m.sby -side right -fill y
1612         pack $w.m.t -side left -fill both -expand 1
1613         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1615         menu $w.ctxm -tearoff 0
1616         $w.ctxm add command -label "Copy" \
1617                 -font font_ui \
1618                 -command "tk_textCopy $w.m.t"
1619         $w.ctxm add command -label "Select All" \
1620                 -font font_ui \
1621                 -command "$w.m.t tag add sel 0.0 end"
1622         $w.ctxm add command -label "Copy All" \
1623                 -font font_ui \
1624                 -command "
1625                         $w.m.t tag add sel 0.0 end
1626                         tk_textCopy $w.m.t
1627                         $w.m.t tag remove sel 0.0 end
1628                 "
1630         button $w.ok -text {Close} \
1631                 -font font_ui \
1632                 -state disabled \
1633                 -command "destroy $w"
1634         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1636         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1637         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1638         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1639         bind $w <Visibility> "focus $w"
1640         wm title $w "$appname ([lindex [file split \
1641                 [file normalize [file dirname $gitdir]]] \
1642                 end]): [lindex $console_data($w) 0]"
1643         return $w
1646 proc console_exec {w cmd {after {}}} {
1647         global tcl_platform
1649         # -- Windows tosses the enviroment when we exec our child.
1650         #    But most users need that so we have to relogin. :-(
1651         #
1652         if {$tcl_platform(platform) eq {windows}} {
1653                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1654         }
1656         # -- Tcl won't let us redirect both stdout and stderr to
1657         #    the same pipe.  So pass it through cat...
1658         #
1659         set cmd [concat | $cmd |& cat]
1661         set fd_f [open $cmd r]
1662         fconfigure $fd_f -blocking 0 -translation binary
1663         fileevent $fd_f readable [list console_read $w $fd_f $after]
1666 proc console_read {w fd after} {
1667         global console_cr console_data
1669         set buf [read $fd]
1670         if {$buf ne {}} {
1671                 if {![winfo exists $w]} {console_init $w}
1672                 $w.m.t conf -state normal
1673                 set c 0
1674                 set n [string length $buf]
1675                 while {$c < $n} {
1676                         set cr [string first "\r" $buf $c]
1677                         set lf [string first "\n" $buf $c]
1678                         if {$cr < 0} {set cr [expr {$n + 1}]}
1679                         if {$lf < 0} {set lf [expr {$n + 1}]}
1681                         if {$lf < $cr} {
1682                                 $w.m.t insert end [string range $buf $c $lf]
1683                                 set console_cr($w) [$w.m.t index {end -1c}]
1684                                 set c $lf
1685                                 incr c
1686                         } else {
1687                                 $w.m.t delete $console_cr($w) end
1688                                 $w.m.t insert end "\n"
1689                                 $w.m.t insert end [string range $buf $c $cr]
1690                                 set c $cr
1691                                 incr c
1692                         }
1693                 }
1694                 $w.m.t conf -state disabled
1695                 $w.m.t see end
1696         }
1698         fconfigure $fd -blocking 1
1699         if {[eof $fd]} {
1700                 if {[catch {close $fd}]} {
1701                         if {![winfo exists $w]} {console_init $w}
1702                         $w.m.s conf -background red -text {Error: Command Failed}
1703                         $w.ok conf -state normal
1704                         set ok 0
1705                 } elseif {[winfo exists $w]} {
1706                         $w.m.s conf -background green -text {Success}
1707                         $w.ok conf -state normal
1708                         set ok 1
1709                 }
1710                 array unset console_cr $w
1711                 array unset console_data $w
1712                 if {$after ne {}} {
1713                         uplevel #0 $after $ok
1714                 }
1715                 return
1716         }
1717         fconfigure $fd -blocking 0
1720 ######################################################################
1721 ##
1722 ## ui commands
1724 set starting_gitk_msg {Please wait... Starting gitk...}
1726 proc do_gitk {} {
1727         global tcl_platform ui_status_value starting_gitk_msg
1729         set ui_status_value $starting_gitk_msg
1730         after 10000 {
1731                 if {$ui_status_value eq $starting_gitk_msg} {
1732                         set ui_status_value {Ready.}
1733                 }
1734         }
1736         if {$tcl_platform(platform) eq {windows}} {
1737                 exec sh -c gitk &
1738         } else {
1739                 exec gitk &
1740         }
1743 proc do_repack {} {
1744         set w [new_console "repack" "Repacking the object database"]
1745         set cmd [list git repack]
1746         lappend cmd -a
1747         lappend cmd -d
1748         console_exec $w $cmd
1751 set is_quitting 0
1753 proc do_quit {} {
1754         global gitdir ui_comm is_quitting repo_config
1756         if {$is_quitting} return
1757         set is_quitting 1
1759         # -- Stash our current commit buffer.
1760         #
1761         set save [file join $gitdir GITGUI_MSG]
1762         set msg [string trim [$ui_comm get 0.0 end]]
1763         if {[$ui_comm edit modified] && $msg ne {}} {
1764                 catch {
1765                         set fd [open $save w]
1766                         puts $fd [string trim [$ui_comm get 0.0 end]]
1767                         close $fd
1768                 }
1769         } elseif {$msg eq {} && [file exists $save]} {
1770                 file delete $save
1771         }
1773         # -- Stash our current window geometry into this repository.
1774         #
1775         set cfg_geometry [list]
1776         lappend cfg_geometry [wm geometry .]
1777         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1778         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1779         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1780                 set rc_geometry {}
1781         }
1782         if {$cfg_geometry ne $rc_geometry} {
1783                 catch {exec git repo-config gui.geometry $cfg_geometry}
1784         }
1786         destroy .
1789 proc do_rescan {} {
1790         rescan {set ui_status_value {Ready.}}
1793 proc do_include_all {} {
1794         global file_states
1796         if {![lock_index begin-update]} return
1798         set pathList [list]
1799         foreach path [array names file_states] {
1800                 set s $file_states($path)
1801                 set m [lindex $s 0]
1802                 switch -- $m {
1803                 AM -
1804                 MM -
1805                 _M -
1806                 _D {lappend pathList $path}
1807                 }
1808         }
1809         if {$pathList eq {}} {
1810                 unlock_index
1811         } else {
1812                 update_index \
1813                         "Including all modified files" \
1814                         $pathList \
1815                         {set ui_status_value {Ready to commit.}}
1816         }
1819 set GIT_COMMITTER_IDENT {}
1821 proc do_signoff {} {
1822         global ui_comm GIT_COMMITTER_IDENT
1824         if {$GIT_COMMITTER_IDENT eq {}} {
1825                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1826                         error_popup "Unable to obtain your identity:\n\n$err"
1827                         return
1828                 }
1829                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1830                         $me me GIT_COMMITTER_IDENT]} {
1831                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1832                         return
1833                 }
1834         }
1836         set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1837         set last [$ui_comm get {end -1c linestart} {end -1c}]
1838         if {$last ne $sob} {
1839                 $ui_comm edit separator
1840                 if {$last ne {}
1841                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1842                         $ui_comm insert end "\n"
1843                 }
1844                 $ui_comm insert end "\n$sob"
1845                 $ui_comm edit separator
1846                 $ui_comm see end
1847         }
1850 proc do_amend_last {} {
1851         load_last_commit
1854 proc do_commit {} {
1855         commit_tree
1858 proc do_options {} {
1859         global appname gitdir font_descs
1860         global repo_config global_config
1861         global repo_config_new global_config_new
1863         array unset repo_config_new
1864         array unset global_config_new
1865         foreach name [array names repo_config] {
1866                 set repo_config_new($name) $repo_config($name)
1867         }
1868         load_config 1
1869         foreach name [array names repo_config] {
1870                 switch -- $name {
1871                 gui.diffcontext {continue}
1872                 }
1873                 set repo_config_new($name) $repo_config($name)
1874         }
1875         foreach name [array names global_config] {
1876                 set global_config_new($name) $global_config($name)
1877         }
1878         set reponame [lindex [file split \
1879                 [file normalize [file dirname $gitdir]]] \
1880                 end]
1882         set w .options_editor
1883         toplevel $w
1884         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1886         label $w.header -text "$appname Options" \
1887                 -font font_uibold
1888         pack $w.header -side top -fill x
1890         frame $w.buttons
1891         button $w.buttons.restore -text {Restore Defaults} \
1892                 -font font_ui \
1893                 -command do_restore_defaults
1894         pack $w.buttons.restore -side left
1895         button $w.buttons.save -text Save \
1896                 -font font_ui \
1897                 -command [list do_save_config $w]
1898         pack $w.buttons.save -side right
1899         button $w.buttons.cancel -text {Cancel} \
1900                 -font font_ui \
1901                 -command [list destroy $w]
1902         pack $w.buttons.cancel -side right
1903         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1905         labelframe $w.repo -text "$reponame Repository" \
1906                 -font font_ui \
1907                 -relief raised -borderwidth 2
1908         labelframe $w.global -text {Global (All Repositories)} \
1909                 -font font_ui \
1910                 -relief raised -borderwidth 2
1911         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1912         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1914         foreach option {
1915                 {b partialinclude {Allow Partially Included Files}}
1916                 {b pullsummary {Show Pull Summary}}
1917                 {b trustmtime  {Trust File Modification Timestamps}}
1918                 {i diffcontext {Number of Diff Context Lines}}
1919                 } {
1920                 set type [lindex $option 0]
1921                 set name [lindex $option 1]
1922                 set text [lindex $option 2]
1923                 foreach f {repo global} {
1924                         switch $type {
1925                         b {
1926                                 checkbutton $w.$f.$name -text $text \
1927                                         -variable ${f}_config_new(gui.$name) \
1928                                         -onvalue true \
1929                                         -offvalue false \
1930                                         -font font_ui
1931                                 pack $w.$f.$name -side top -anchor w
1932                         }
1933                         i {
1934                                 frame $w.$f.$name
1935                                 label $w.$f.$name.l -text "$text:" -font font_ui
1936                                 pack $w.$f.$name.l -side left -anchor w -fill x
1937                                 spinbox $w.$f.$name.v \
1938                                         -textvariable ${f}_config_new(gui.$name) \
1939                                         -from 1 -to 99 -increment 1 \
1940                                         -width 3 \
1941                                         -font font_ui
1942                                 pack $w.$f.$name.v -side right -anchor e
1943                                 pack $w.$f.$name -side top -anchor w -fill x
1944                         }
1945                         }
1946                 }
1947         }
1949         set all_fonts [lsort [font families]]
1950         foreach option $font_descs {
1951                 set name [lindex $option 0]
1952                 set font [lindex $option 1]
1953                 set text [lindex $option 2]
1955                 set global_config_new(gui.$font^^family) \
1956                         [font configure $font -family]
1957                 set global_config_new(gui.$font^^size) \
1958                         [font configure $font -size]
1960                 frame $w.global.$name
1961                 label $w.global.$name.l -text "$text:" -font font_ui
1962                 pack $w.global.$name.l -side left -anchor w -fill x
1963                 eval tk_optionMenu $w.global.$name.family \
1964                         global_config_new(gui.$font^^family) \
1965                         $all_fonts
1966                 spinbox $w.global.$name.size \
1967                         -textvariable global_config_new(gui.$font^^size) \
1968                         -from 2 -to 80 -increment 1 \
1969                         -width 3 \
1970                         -font font_ui
1971                 pack $w.global.$name.size -side right -anchor e
1972                 pack $w.global.$name.family -side right -anchor e
1973                 pack $w.global.$name -side top -anchor w -fill x
1974         }
1976         bind $w <Visibility> "grab $w; focus $w"
1977         bind $w <Key-Escape> "destroy $w"
1978         wm title $w "$appname ($reponame): Options"
1979         tkwait window $w
1982 proc do_restore_defaults {} {
1983         global font_descs default_config repo_config
1984         global repo_config_new global_config_new
1986         foreach name [array names default_config] {
1987                 set repo_config_new($name) $default_config($name)
1988                 set global_config_new($name) $default_config($name)
1989         }
1991         foreach option $font_descs {
1992                 set name [lindex $option 0]
1993                 set repo_config(gui.$name) $default_config(gui.$name)
1994         }
1995         apply_config
1997         foreach option $font_descs {
1998                 set name [lindex $option 0]
1999                 set font [lindex $option 1]
2000                 set global_config_new(gui.$font^^family) \
2001                         [font configure $font -family]
2002                 set global_config_new(gui.$font^^size) \
2003                         [font configure $font -size]
2004         }
2007 proc do_save_config {w} {
2008         if {[catch {save_config} err]} {
2009                 error_popup "Failed to completely save options:\n\n$err"
2010         }
2011         reshow_diff
2012         destroy $w
2015 proc do_windows_shortcut {} {
2016         global gitdir appname argv0
2018         set reponame [lindex [file split \
2019                 [file normalize [file dirname $gitdir]]] \
2020                 end]
2022         if {[catch {
2023                 set desktop [exec cygpath \
2024                         --windows \
2025                         --absolute \
2026                         --long-name \
2027                         --desktop]
2028                 }]} {
2029                         set desktop .
2030         }
2031         set fn [tk_getSaveFile \
2032                 -parent . \
2033                 -title "$appname ($reponame): Create Desktop Icon" \
2034                 -initialdir $desktop \
2035                 -initialfile "Git $reponame.bat"]
2036         if {$fn != {}} {
2037                 if {[catch {
2038                                 set fd [open $fn w]
2039                                 set sh [exec cygpath \
2040                                         --windows \
2041                                         --absolute \
2042                                         --long-name \
2043                                         /bin/sh]
2044                                 set me [exec cygpath \
2045                                         --unix \
2046                                         --absolute \
2047                                         $argv0]
2048                                 set gd [exec cygpath \
2049                                         --unix \
2050                                         --absolute \
2051                                         $gitdir]
2052                                 puts -nonewline $fd "\"$sh\" --login -c \""
2053                                 puts -nonewline $fd "GIT_DIR='$gd'"
2054                                 puts -nonewline $fd " '$me'"
2055                                 puts $fd "&\""
2056                                 close $fd
2057                         } err]} {
2058                         error_popup "Cannot write script:\n\n$err"
2059                 }
2060         }
2063 proc toggle_or_diff {w x y} {
2064         global file_lists ui_index ui_other
2065         global last_clicked selected_paths
2067         set pos [split [$w index @$x,$y] .]
2068         set lno [lindex $pos 0]
2069         set col [lindex $pos 1]
2070         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2071         if {$path eq {}} {
2072                 set last_clicked {}
2073                 return
2074         }
2076         set last_clicked [list $w $lno]
2077         array unset selected_paths
2078         $ui_index tag remove in_sel 0.0 end
2079         $ui_other tag remove in_sel 0.0 end
2081         if {$col == 0} {
2082                 update_index \
2083                         "Including [short_path $path]" \
2084                         [list $path] \
2085                         {set ui_status_value {Ready.}}
2086         } else {
2087                 show_diff $path $w $lno
2088         }
2091 proc add_one_to_selection {w x y} {
2092         global file_lists
2093         global last_clicked selected_paths
2095         set pos [split [$w index @$x,$y] .]
2096         set lno [lindex $pos 0]
2097         set col [lindex $pos 1]
2098         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2099         if {$path eq {}} {
2100                 set last_clicked {}
2101                 return
2102         }
2104         set last_clicked [list $w $lno]
2105         if {[catch {set in_sel $selected_paths($path)}]} {
2106                 set in_sel 0
2107         }
2108         if {$in_sel} {
2109                 unset selected_paths($path)
2110                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2111         } else {
2112                 set selected_paths($path) 1
2113                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2114         }
2117 proc add_range_to_selection {w x y} {
2118         global file_lists
2119         global last_clicked selected_paths
2121         if {[lindex $last_clicked 0] ne $w} {
2122                 toggle_or_diff $w $x $y
2123                 return
2124         }
2126         set pos [split [$w index @$x,$y] .]
2127         set lno [lindex $pos 0]
2128         set lc [lindex $last_clicked 1]
2129         if {$lc < $lno} {
2130                 set begin $lc
2131                 set end $lno
2132         } else {
2133                 set begin $lno
2134                 set end $lc
2135         }
2137         foreach path [lrange $file_lists($w) \
2138                 [expr {$begin - 1}] \
2139                 [expr {$end - 1}]] {
2140                 set selected_paths($path) 1
2141         }
2142         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2145 ######################################################################
2146 ##
2147 ## config defaults
2149 set cursor_ptr arrow
2150 font create font_diff -family Courier -size 10
2151 font create font_ui
2152 catch {
2153         label .dummy
2154         eval font configure font_ui [font actual [.dummy cget -font]]
2155         destroy .dummy
2158 font create font_uibold
2159 font create font_diffbold
2161 set M1B M1
2162 set M1T M1
2163 if {$tcl_platform(platform) eq {windows}} {
2164         set M1B Control
2165         set M1T Ctrl
2166 } elseif {[is_MacOSX]} {
2167         set M1B M1
2168         set M1T Cmd
2171 proc apply_config {} {
2172         global repo_config font_descs
2174         foreach option $font_descs {
2175                 set name [lindex $option 0]
2176                 set font [lindex $option 1]
2177                 if {[catch {
2178                         foreach {cn cv} $repo_config(gui.$name) {
2179                                 font configure $font $cn $cv
2180                         }
2181                         } err]} {
2182                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2183                 }
2184                 foreach {cn cv} [font configure $font] {
2185                         font configure ${font}bold $cn $cv
2186                 }
2187                 font configure ${font}bold -weight bold
2188         }
2191 set default_config(gui.trustmtime) false
2192 set default_config(gui.pullsummary) true
2193 set default_config(gui.partialinclude) false
2194 set default_config(gui.diffcontext) 5
2195 set default_config(gui.fontui) [font configure font_ui]
2196 set default_config(gui.fontdiff) [font configure font_diff]
2197 set font_descs {
2198         {fontui   font_ui   {Main Font}}
2199         {fontdiff font_diff {Diff/Console Font}}
2201 load_config 0
2202 apply_config
2204 ######################################################################
2205 ##
2206 ## ui construction
2208 # -- Menu Bar
2209 menu .mbar -tearoff 0
2210 .mbar add cascade -label Project -menu .mbar.project
2211 .mbar add cascade -label Edit -menu .mbar.edit
2212 .mbar add cascade -label Commit -menu .mbar.commit
2213 if {!$single_commit} {
2214         .mbar add cascade -label Fetch -menu .mbar.fetch
2215         .mbar add cascade -label Pull -menu .mbar.pull
2216         .mbar add cascade -label Push -menu .mbar.push
2218 . configure -menu .mbar
2220 # -- Project Menu
2221 menu .mbar.project
2222 .mbar.project add command -label Visualize \
2223         -command do_gitk \
2224         -font font_ui
2225 if {!$single_commit} {
2226         .mbar.project add command -label {Repack Database} \
2227                 -command do_repack \
2228                 -font font_ui
2230         if {$tcl_platform(platform) eq {windows}} {
2231                 .mbar.project add command \
2232                         -label {Create Desktop Icon} \
2233                         -command do_windows_shortcut \
2234                         -font font_ui
2235         }
2237 .mbar.project add command -label Quit \
2238         -command do_quit \
2239         -accelerator $M1T-Q \
2240         -font font_ui
2242 # -- Edit Menu
2244 menu .mbar.edit
2245 .mbar.edit add command -label Undo \
2246         -command {catch {[focus] edit undo}} \
2247         -accelerator $M1T-Z \
2248         -font font_ui
2249 .mbar.edit add command -label Redo \
2250         -command {catch {[focus] edit redo}} \
2251         -accelerator $M1T-Y \
2252         -font font_ui
2253 .mbar.edit add separator
2254 .mbar.edit add command -label Cut \
2255         -command {catch {tk_textCut [focus]}} \
2256         -accelerator $M1T-X \
2257         -font font_ui
2258 .mbar.edit add command -label Copy \
2259         -command {catch {tk_textCopy [focus]}} \
2260         -accelerator $M1T-C \
2261         -font font_ui
2262 .mbar.edit add command -label Paste \
2263         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2264         -accelerator $M1T-V \
2265         -font font_ui
2266 .mbar.edit add command -label Delete \
2267         -command {catch {[focus] delete sel.first sel.last}} \
2268         -accelerator Del \
2269         -font font_ui
2270 .mbar.edit add separator
2271 .mbar.edit add command -label {Select All} \
2272         -command {catch {[focus] tag add sel 0.0 end}} \
2273         -accelerator $M1T-A \
2274         -font font_ui
2275 .mbar.edit add separator
2276 .mbar.edit add command -label {Options...} \
2277         -command do_options \
2278         -font font_ui
2280 # -- Commit Menu
2281 menu .mbar.commit
2282 .mbar.commit add command -label Rescan \
2283         -command do_rescan \
2284         -accelerator F5 \
2285         -font font_ui
2286 lappend disable_on_lock \
2287         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2288 .mbar.commit add command -label {Amend Last Commit} \
2289         -command do_amend_last \
2290         -font font_ui
2291 lappend disable_on_lock \
2292         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2293 .mbar.commit add command -label {Include All Files} \
2294         -command do_include_all \
2295         -accelerator $M1T-I \
2296         -font font_ui
2297 lappend disable_on_lock \
2298         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2299 .mbar.commit add command -label {Sign Off} \
2300         -command do_signoff \
2301         -accelerator $M1T-S \
2302         -font font_ui
2303 .mbar.commit add command -label Commit \
2304         -command do_commit \
2305         -accelerator $M1T-Return \
2306         -font font_ui
2307 lappend disable_on_lock \
2308         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2310 if {!$single_commit} {
2311         # -- Fetch Menu
2312         menu .mbar.fetch
2314         # -- Pull Menu
2315         menu .mbar.pull
2317         # -- Push Menu
2318         menu .mbar.push
2321 # -- Main Window Layout
2322 panedwindow .vpane -orient vertical
2323 panedwindow .vpane.files -orient horizontal
2324 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2325 pack .vpane -anchor n -side top -fill both -expand 1
2327 # -- Index File List
2328 frame .vpane.files.index -height 100 -width 400
2329 label .vpane.files.index.title -text {Modified Files} \
2330         -background green \
2331         -font font_ui
2332 text $ui_index -background white -borderwidth 0 \
2333         -width 40 -height 10 \
2334         -font font_ui \
2335         -cursor $cursor_ptr \
2336         -yscrollcommand {.vpane.files.index.sb set} \
2337         -state disabled
2338 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2339 pack .vpane.files.index.title -side top -fill x
2340 pack .vpane.files.index.sb -side right -fill y
2341 pack $ui_index -side left -fill both -expand 1
2342 .vpane.files add .vpane.files.index -sticky nsew
2344 # -- Other (Add) File List
2345 frame .vpane.files.other -height 100 -width 100
2346 label .vpane.files.other.title -text {Untracked Files} \
2347         -background red \
2348         -font font_ui
2349 text $ui_other -background white -borderwidth 0 \
2350         -width 40 -height 10 \
2351         -font font_ui \
2352         -cursor $cursor_ptr \
2353         -yscrollcommand {.vpane.files.other.sb set} \
2354         -state disabled
2355 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2356 pack .vpane.files.other.title -side top -fill x
2357 pack .vpane.files.other.sb -side right -fill y
2358 pack $ui_other -side left -fill both -expand 1
2359 .vpane.files add .vpane.files.other -sticky nsew
2361 foreach i [list $ui_index $ui_other] {
2362         $i tag conf in_diff -font font_uibold
2363         $i tag conf in_sel \
2364                 -background [$i cget -foreground] \
2365                 -foreground [$i cget -background]
2367 unset i
2369 # -- Diff and Commit Area
2370 frame .vpane.lower -height 300 -width 400
2371 frame .vpane.lower.commarea
2372 frame .vpane.lower.diff -relief sunken -borderwidth 1
2373 pack .vpane.lower.commarea -side top -fill x
2374 pack .vpane.lower.diff -side bottom -fill both -expand 1
2375 .vpane add .vpane.lower -stick nsew
2377 # -- Commit Area Buttons
2378 frame .vpane.lower.commarea.buttons
2379 label .vpane.lower.commarea.buttons.l -text {} \
2380         -anchor w \
2381         -justify left \
2382         -font font_ui
2383 pack .vpane.lower.commarea.buttons.l -side top -fill x
2384 pack .vpane.lower.commarea.buttons -side left -fill y
2386 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2387         -command do_rescan \
2388         -font font_ui
2389 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2390 lappend disable_on_lock \
2391         {.vpane.lower.commarea.buttons.rescan conf -state}
2393 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2394         -command do_amend_last \
2395         -font font_ui
2396 pack .vpane.lower.commarea.buttons.amend -side top -fill x
2397 lappend disable_on_lock \
2398         {.vpane.lower.commarea.buttons.amend conf -state}
2400 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2401         -command do_include_all \
2402         -font font_ui
2403 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2404 lappend disable_on_lock \
2405         {.vpane.lower.commarea.buttons.incall conf -state}
2407 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2408         -command do_signoff \
2409         -font font_ui
2410 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2412 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2413         -command do_commit \
2414         -font font_ui
2415 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2416 lappend disable_on_lock \
2417         {.vpane.lower.commarea.buttons.commit conf -state}
2419 # -- Commit Message Buffer
2420 frame .vpane.lower.commarea.buffer
2421 set ui_comm .vpane.lower.commarea.buffer.t
2422 set ui_coml .vpane.lower.commarea.buffer.l
2423 label $ui_coml -text {Commit Message:} \
2424         -anchor w \
2425         -justify left \
2426         -font font_ui
2427 trace add variable commit_type write {uplevel #0 {
2428         switch -glob $commit_type \
2429         initial {$ui_coml conf -text {Initial Commit Message:}} \
2430         amend   {$ui_coml conf -text {Amended Commit Message:}} \
2431         merge   {$ui_coml conf -text {Merge Commit Message:}} \
2432         *       {$ui_coml conf -text {Commit Message:}}
2433 }}
2434 text $ui_comm -background white -borderwidth 1 \
2435         -undo true \
2436         -maxundo 20 \
2437         -autoseparators true \
2438         -relief sunken \
2439         -width 75 -height 9 -wrap none \
2440         -font font_diff \
2441         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2442 scrollbar .vpane.lower.commarea.buffer.sby \
2443         -command [list $ui_comm yview]
2444 pack $ui_coml -side top -fill x
2445 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2446 pack $ui_comm -side left -fill y
2447 pack .vpane.lower.commarea.buffer -side left -fill y
2449 # -- Commit Message Buffer Context Menu
2451 set ctxm .vpane.lower.commarea.buffer.ctxm
2452 menu $ctxm -tearoff 0
2453 $ctxm add command \
2454         -label {Cut} \
2455         -font font_ui \
2456         -command {tk_textCut $ui_comm}
2457 $ctxm add command \
2458         -label {Copy} \
2459         -font font_ui \
2460         -command {tk_textCopy $ui_comm}
2461 $ctxm add command \
2462         -label {Paste} \
2463         -font font_ui \
2464         -command {tk_textPaste $ui_comm}
2465 $ctxm add command \
2466         -label {Delete} \
2467         -font font_ui \
2468         -command {$ui_comm delete sel.first sel.last}
2469 $ctxm add separator
2470 $ctxm add command \
2471         -label {Select All} \
2472         -font font_ui \
2473         -command {$ui_comm tag add sel 0.0 end}
2474 $ctxm add command \
2475         -label {Copy All} \
2476         -font font_ui \
2477         -command {
2478                 $ui_comm tag add sel 0.0 end
2479                 tk_textCopy $ui_comm
2480                 $ui_comm tag remove sel 0.0 end
2481         }
2482 $ctxm add separator
2483 $ctxm add command \
2484         -label {Sign Off} \
2485         -font font_ui \
2486         -command do_signoff
2487 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2489 # -- Diff Header
2490 set current_diff {}
2491 set diff_actions [list]
2492 proc current_diff_trace {varname args} {
2493         global current_diff diff_actions file_states
2494         if {$current_diff eq {}} {
2495                 set s {}
2496                 set f {}
2497                 set p {}
2498                 set o disabled
2499         } else {
2500                 set p $current_diff
2501                 set s [mapdesc [lindex $file_states($p) 0] $p]
2502                 set f {File:}
2503                 set p [escape_path $p]
2504                 set o normal
2505         }
2507         .vpane.lower.diff.header.status configure -text $s
2508         .vpane.lower.diff.header.file configure -text $f
2509         .vpane.lower.diff.header.path configure -text $p
2510         foreach w $diff_actions {
2511                 uplevel #0 $w $o
2512         }
2514 trace add variable current_diff write current_diff_trace
2516 frame .vpane.lower.diff.header -background orange
2517 label .vpane.lower.diff.header.status \
2518         -background orange \
2519         -width $max_status_desc \
2520         -anchor w \
2521         -justify left \
2522         -font font_ui
2523 label .vpane.lower.diff.header.file \
2524         -background orange \
2525         -anchor w \
2526         -justify left \
2527         -font font_ui
2528 label .vpane.lower.diff.header.path \
2529         -background orange \
2530         -anchor w \
2531         -justify left \
2532         -font font_ui
2533 pack .vpane.lower.diff.header.status -side left
2534 pack .vpane.lower.diff.header.file -side left
2535 pack .vpane.lower.diff.header.path -fill x
2536 set ctxm .vpane.lower.diff.header.ctxm
2537 menu $ctxm -tearoff 0
2538 $ctxm add command \
2539         -label {Copy} \
2540         -font font_ui \
2541         -command {
2542                 clipboard clear
2543                 clipboard append \
2544                         -format STRING \
2545                         -type STRING \
2546                         -- $current_diff
2547         }
2548 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2549 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2551 # -- Diff Body
2552 frame .vpane.lower.diff.body
2553 set ui_diff .vpane.lower.diff.body.t
2554 text $ui_diff -background white -borderwidth 0 \
2555         -width 80 -height 15 -wrap none \
2556         -font font_diff \
2557         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2558         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2559         -state disabled
2560 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2561         -command [list $ui_diff xview]
2562 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2563         -command [list $ui_diff yview]
2564 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2565 pack .vpane.lower.diff.body.sby -side right -fill y
2566 pack $ui_diff -side left -fill both -expand 1
2567 pack .vpane.lower.diff.header -side top -fill x
2568 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2570 $ui_diff tag conf dm -foreground red
2571 $ui_diff tag conf dp -foreground blue
2572 $ui_diff tag conf di -foreground {#00a000}
2573 $ui_diff tag conf dni -foreground {#a000a0}
2574 $ui_diff tag conf da -font font_diffbold
2575 $ui_diff tag conf bold -font font_diffbold
2577 # -- Diff Body Context Menu
2579 set ctxm .vpane.lower.diff.body.ctxm
2580 menu $ctxm -tearoff 0
2581 $ctxm add command \
2582         -label {Copy} \
2583         -font font_ui \
2584         -command {tk_textCopy $ui_diff}
2585 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2586 $ctxm add command \
2587         -label {Select All} \
2588         -font font_ui \
2589         -command {$ui_diff tag add sel 0.0 end}
2590 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2591 $ctxm add command \
2592         -label {Copy All} \
2593         -font font_ui \
2594         -command {
2595                 $ui_diff tag add sel 0.0 end
2596                 tk_textCopy $ui_diff
2597                 $ui_diff tag remove sel 0.0 end
2598         }
2599 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2600 $ctxm add separator
2601 $ctxm add command \
2602         -label {Decrease Font Size} \
2603         -font font_ui \
2604         -command {incr_font_size font_diff -1}
2605 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2606 $ctxm add command \
2607         -label {Increase Font Size} \
2608         -font font_ui \
2609         -command {incr_font_size font_diff 1}
2610 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2611 $ctxm add separator
2612 $ctxm add command \
2613         -label {Show Less Context} \
2614         -font font_ui \
2615         -command {if {$repo_config(gui.diffcontext) >= 2} {
2616                 incr repo_config(gui.diffcontext) -1
2617                 reshow_diff
2618         }}
2619 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2620 $ctxm add command \
2621         -label {Show More Context} \
2622         -font font_ui \
2623         -command {
2624                 incr repo_config(gui.diffcontext)
2625                 reshow_diff
2626         }
2627 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2628 $ctxm add separator
2629 $ctxm add command -label {Options...} \
2630         -font font_ui \
2631         -command do_options
2632 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
2634 # -- Status Bar
2636 set ui_status_value {Initializing...}
2637 label .status -textvariable ui_status_value \
2638         -anchor w \
2639         -justify left \
2640         -borderwidth 1 \
2641         -relief sunken \
2642         -font font_ui
2643 pack .status -anchor w -side bottom -fill x
2645 # -- Load geometry
2647 catch {
2648 set gm $repo_config(gui.geometry)
2649 wm geometry . [lindex $gm 0]
2650 .vpane sash place 0 \
2651         [lindex [.vpane sash coord 0] 0] \
2652         [lindex $gm 1]
2653 .vpane.files sash place 0 \
2654         [lindex $gm 2] \
2655         [lindex [.vpane.files sash coord 0] 1]
2656 unset gm
2659 # -- Key Bindings
2661 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2662 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2663 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2664 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2665 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2666 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2667 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2668 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2669 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2670 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2671 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2673 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2674 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2675 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2676 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2677 bind $ui_diff <$M1B-Key-v> {break}
2678 bind $ui_diff <$M1B-Key-V> {break}
2679 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2680 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2681 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2682 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2683 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2684 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2686 bind .   <Destroy> do_quit
2687 bind all <Key-F5> do_rescan
2688 bind all <$M1B-Key-r> do_rescan
2689 bind all <$M1B-Key-R> do_rescan
2690 bind .   <$M1B-Key-s> do_signoff
2691 bind .   <$M1B-Key-S> do_signoff
2692 bind .   <$M1B-Key-i> do_include_all
2693 bind .   <$M1B-Key-I> do_include_all
2694 bind .   <$M1B-Key-Return> do_commit
2695 bind all <$M1B-Key-q> do_quit
2696 bind all <$M1B-Key-Q> do_quit
2697 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2698 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2699 foreach i [list $ui_index $ui_other] {
2700         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2701         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2702         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2704 unset i
2706 set file_lists($ui_index) [list]
2707 set file_lists($ui_other) [list]
2708 set current_diff {}
2710 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2711 focus -force $ui_comm
2712 if {!$single_commit} {
2713         load_all_remotes
2714         populate_remote_menu .mbar.fetch From fetch_from
2715         populate_remote_menu .mbar.push To push_to
2716         populate_pull_menu .mbar.pull
2718 after 1 do_rescan