cb2b459ffd8a4569675e99ede0ce9e6652037320
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3exec wish "$0" -- "$@"
4
5set copyright {
6Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
7
8This program is free software; you can redistribute it and/or modify
9it under the terms of the GNU General Public License as published by
10the Free Software Foundation; either version 2 of the License, or
11(at your option) any later version.
12
13This program is distributed in the hope that it will be useful,
14but WITHOUT ANY WARRANTY; without even the implied warranty of
15MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16GNU General Public License for more details.
17
18You should have received a copy of the GNU General Public License
19along with this program; if not, write to the Free Software
20Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
21
22set appvers {@@GITGUI_VERSION@@}
23set appname [lindex [file split $argv0] end]
24set gitdir {}
25
26######################################################################
27##
28## config
29
30proc is_many_config {name} {
31 switch -glob -- $name {
32 remote.*.fetch -
33 remote.*.push
34 {return 1}
35 *
36 {return 0}
37 }
38}
39
40proc load_config {include_global} {
41 global repo_config global_config default_config
42
43 array unset global_config
44 if {$include_global} {
45 catch {
46 set fd_rc [open "| git repo-config --global --list" r]
47 while {[gets $fd_rc line] >= 0} {
48 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
49 if {[is_many_config $name]} {
50 lappend global_config($name) $value
51 } else {
52 set global_config($name) $value
53 }
54 }
55 }
56 close $fd_rc
57 }
58 }
59
60 array unset repo_config
61 catch {
62 set fd_rc [open "| git repo-config --list" r]
63 while {[gets $fd_rc line] >= 0} {
64 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
65 if {[is_many_config $name]} {
66 lappend repo_config($name) $value
67 } else {
68 set repo_config($name) $value
69 }
70 }
71 }
72 close $fd_rc
73 }
74
75 foreach name [array names default_config] {
76 if {[catch {set v $global_config($name)}]} {
77 set global_config($name) $default_config($name)
78 }
79 if {[catch {set v $repo_config($name)}]} {
80 set repo_config($name) $default_config($name)
81 }
82 }
83}
84
85proc save_config {} {
86 global default_config font_descs
87 global repo_config global_config
88 global repo_config_new global_config_new
89
90 foreach option $font_descs {
91 set name [lindex $option 0]
92 set font [lindex $option 1]
93 font configure $font \
94 -family $global_config_new(gui.$font^^family) \
95 -size $global_config_new(gui.$font^^size)
96 font configure ${font}bold \
97 -family $global_config_new(gui.$font^^family) \
98 -size $global_config_new(gui.$font^^size)
99 set global_config_new(gui.$name) [font configure $font]
100 unset global_config_new(gui.$font^^family)
101 unset global_config_new(gui.$font^^size)
102 }
103
104 foreach name [array names default_config] {
105 set value $global_config_new($name)
106 if {$value ne $global_config($name)} {
107 if {$value eq $default_config($name)} {
108 catch {exec git repo-config --global --unset $name}
109 } else {
110 regsub -all "\[{}\]" $value {"} value
111 exec git repo-config --global $name $value
112 }
113 set global_config($name) $value
114 if {$value eq $repo_config($name)} {
115 catch {exec git repo-config --unset $name}
116 set repo_config($name) $value
117 }
118 }
119 }
120
121 foreach name [array names default_config] {
122 set value $repo_config_new($name)
123 if {$value ne $repo_config($name)} {
124 if {$value eq $global_config($name)} {
125 catch {exec git repo-config --unset $name}
126 } else {
127 regsub -all "\[{}\]" $value {"} value
128 exec git repo-config $name $value
129 }
130 set repo_config($name) $value
131 }
132 }
133}
134
135proc error_popup {msg} {
136 global gitdir appname
137
138 set title $appname
139 if {$gitdir ne {}} {
140 append title { (}
141 append title [lindex \
142 [file split [file normalize [file dirname $gitdir]]] \
143 end]
144 append title {)}
145 }
146 set cmd [list tk_messageBox \
147 -icon error \
148 -type ok \
149 -title "$title: error" \
150 -message $msg]
151 if {[winfo ismapped .]} {
152 lappend cmd -parent .
153 }
154 eval $cmd
155}
156
157proc warn_popup {msg} {
158 global gitdir appname
159
160 set title $appname
161 if {$gitdir ne {}} {
162 append title { (}
163 append title [lindex \
164 [file split [file normalize [file dirname $gitdir]]] \
165 end]
166 append title {)}
167 }
168 set cmd [list tk_messageBox \
169 -icon warning \
170 -type ok \
171 -title "$title: warning" \
172 -message $msg]
173 if {[winfo ismapped .]} {
174 lappend cmd -parent .
175 }
176 eval $cmd
177}
178
179proc info_popup {msg} {
180 global gitdir appname
181
182 set title $appname
183 if {$gitdir ne {}} {
184 append title { (}
185 append title [lindex \
186 [file split [file normalize [file dirname $gitdir]]] \
187 end]
188 append title {)}
189 }
190 tk_messageBox \
191 -parent . \
192 -icon info \
193 -type ok \
194 -title $title \
195 -message $msg
196}
197
198######################################################################
199##
200## repository setup
201
202if { [catch {set gitdir $env(GIT_DIR)}]
203 && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
204 catch {wm withdraw .}
205 error_popup "Cannot find the git directory:\n\n$err"
206 exit 1
207}
208if {![file isdirectory $gitdir]} {
209 catch {wm withdraw .}
210 error_popup "Git directory not found:\n\n$gitdir"
211 exit 1
212}
213if {[lindex [file split $gitdir] end] ne {.git}} {
214 catch {wm withdraw .}
215 error_popup "Cannot use funny .git directory:\n\n$gitdir"
216 exit 1
217}
218if {[catch {cd [file dirname $gitdir]} err]} {
219 catch {wm withdraw .}
220 error_popup "No working directory [file dirname $gitdir]:\n\n$err"
221 exit 1
222}
223
224set single_commit 0
225if {$appname eq {git-citool}} {
226 set single_commit 1
227}
228
229######################################################################
230##
231## task management
232
233set rescan_active 0
234set diff_active 0
235set last_clicked {}
236
237set disable_on_lock [list]
238set index_lock_type none
239
240proc lock_index {type} {
241 global index_lock_type disable_on_lock
242
243 if {$index_lock_type eq {none}} {
244 set index_lock_type $type
245 foreach w $disable_on_lock {
246 uplevel #0 $w disabled
247 }
248 return 1
249 } elseif {$index_lock_type eq "begin-$type"} {
250 set index_lock_type $type
251 return 1
252 }
253 return 0
254}
255
256proc unlock_index {} {
257 global index_lock_type disable_on_lock
258
259 set index_lock_type none
260 foreach w $disable_on_lock {
261 uplevel #0 $w normal
262 }
263}
264
265######################################################################
266##
267## status
268
269proc repository_state {ctvar hdvar mhvar} {
270 global gitdir current_branch
271 upvar $ctvar ct $hdvar hd $mhvar mh
272
273 set mh [list]
274
275 if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
276 set current_branch {}
277 } else {
278 regsub ^refs/((heads|tags|remotes)/)? \
279 $current_branch \
280 {} \
281 current_branch
282 }
283
284 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
285 set hd {}
286 set ct initial
287 return
288 }
289
290 set merge_head [file join $gitdir MERGE_HEAD]
291 if {[file exists $merge_head]} {
292 set ct merge
293 set fd_mh [open $merge_head r]
294 while {[gets $fd_mh line] >= 0} {
295 lappend mh $line
296 }
297 close $fd_mh
298 return
299 }
300
301 set ct normal
302}
303
304proc PARENT {} {
305 global PARENT empty_tree
306
307 set p [lindex $PARENT 0]
308 if {$p ne {}} {
309 return $p
310 }
311 if {$empty_tree eq {}} {
312 set empty_tree [exec git mktree << {}]
313 }
314 return $empty_tree
315}
316
317proc rescan {after} {
318 global HEAD PARENT MERGE_HEAD commit_type
319 global ui_index ui_other ui_status_value ui_comm
320 global rescan_active file_states
321 global repo_config
322
323 if {$rescan_active > 0 || ![lock_index read]} return
324
325 repository_state newType newHEAD newMERGE_HEAD
326 if {[string match amend* $commit_type]
327 && $newType eq {normal}
328 && $newHEAD eq $HEAD} {
329 } else {
330 set HEAD $newHEAD
331 set PARENT $newHEAD
332 set MERGE_HEAD $newMERGE_HEAD
333 set commit_type $newType
334 }
335
336 array unset file_states
337
338 if {![$ui_comm edit modified]
339 || [string trim [$ui_comm get 0.0 end]] eq {}} {
340 if {[load_message GITGUI_MSG]} {
341 } elseif {[load_message MERGE_MSG]} {
342 } elseif {[load_message SQUASH_MSG]} {
343 }
344 $ui_comm edit reset
345 $ui_comm edit modified false
346 }
347
348 if {$repo_config(gui.trustmtime) eq {true}} {
349 rescan_stage2 {} $after
350 } else {
351 set rescan_active 1
352 set ui_status_value {Refreshing file status...}
353 set cmd [list git update-index]
354 lappend cmd -q
355 lappend cmd --unmerged
356 lappend cmd --ignore-missing
357 lappend cmd --refresh
358 set fd_rf [open "| $cmd" r]
359 fconfigure $fd_rf -blocking 0 -translation binary
360 fileevent $fd_rf readable \
361 [list rescan_stage2 $fd_rf $after]
362 }
363}
364
365proc rescan_stage2 {fd after} {
366 global gitdir ui_status_value
367 global rescan_active buf_rdi buf_rdf buf_rlo
368
369 if {$fd ne {}} {
370 read $fd
371 if {![eof $fd]} return
372 close $fd
373 }
374
375 set ls_others [list | git ls-files --others -z \
376 --exclude-per-directory=.gitignore]
377 set info_exclude [file join $gitdir info exclude]
378 if {[file readable $info_exclude]} {
379 lappend ls_others "--exclude-from=$info_exclude"
380 }
381
382 set buf_rdi {}
383 set buf_rdf {}
384 set buf_rlo {}
385
386 set rescan_active 3
387 set ui_status_value {Scanning for modified files ...}
388 set fd_di [open "| git diff-index --cached -z [PARENT]" r]
389 set fd_df [open "| git diff-files -z" r]
390 set fd_lo [open $ls_others r]
391
392 fconfigure $fd_di -blocking 0 -translation binary
393 fconfigure $fd_df -blocking 0 -translation binary
394 fconfigure $fd_lo -blocking 0 -translation binary
395 fileevent $fd_di readable [list read_diff_index $fd_di $after]
396 fileevent $fd_df readable [list read_diff_files $fd_df $after]
397 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
398}
399
400proc load_message {file} {
401 global gitdir ui_comm
402
403 set f [file join $gitdir $file]
404 if {[file isfile $f]} {
405 if {[catch {set fd [open $f r]}]} {
406 return 0
407 }
408 set content [string trim [read $fd]]
409 close $fd
410 $ui_comm delete 0.0 end
411 $ui_comm insert end $content
412 return 1
413 }
414 return 0
415}
416
417proc read_diff_index {fd after} {
418 global buf_rdi
419
420 append buf_rdi [read $fd]
421 set c 0
422 set n [string length $buf_rdi]
423 while {$c < $n} {
424 set z1 [string first "\0" $buf_rdi $c]
425 if {$z1 == -1} break
426 incr z1
427 set z2 [string first "\0" $buf_rdi $z1]
428 if {$z2 == -1} break
429
430 incr c
431 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
432 merge_state \
433 [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
434 [lindex $i 4]? \
435 [list [lindex $i 0] [lindex $i 2]] \
436 [list]
437 set c $z2
438 incr c
439 }
440 if {$c < $n} {
441 set buf_rdi [string range $buf_rdi $c end]
442 } else {
443 set buf_rdi {}
444 }
445
446 rescan_done $fd buf_rdi $after
447}
448
449proc read_diff_files {fd after} {
450 global buf_rdf
451
452 append buf_rdf [read $fd]
453 set c 0
454 set n [string length $buf_rdf]
455 while {$c < $n} {
456 set z1 [string first "\0" $buf_rdf $c]
457 if {$z1 == -1} break
458 incr z1
459 set z2 [string first "\0" $buf_rdf $z1]
460 if {$z2 == -1} break
461
462 incr c
463 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
464 merge_state \
465 [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
466 ?[lindex $i 4] \
467 [list] \
468 [list [lindex $i 0] [lindex $i 2]]
469 set c $z2
470 incr c
471 }
472 if {$c < $n} {
473 set buf_rdf [string range $buf_rdf $c end]
474 } else {
475 set buf_rdf {}
476 }
477
478 rescan_done $fd buf_rdf $after
479}
480
481proc read_ls_others {fd after} {
482 global buf_rlo
483
484 append buf_rlo [read $fd]
485 set pck [split $buf_rlo "\0"]
486 set buf_rlo [lindex $pck end]
487 foreach p [lrange $pck 0 end-1] {
488 merge_state $p ?O
489 }
490 rescan_done $fd buf_rlo $after
491}
492
493proc rescan_done {fd buf after} {
494 global rescan_active
495 global file_states repo_config
496 upvar $buf to_clear
497
498 if {![eof $fd]} return
499 set to_clear {}
500 close $fd
501 if {[incr rescan_active -1] > 0} return
502
503 prune_selection
504 unlock_index
505 display_all_files
506
507 if {$repo_config(gui.partialinclude) ne {true}} {
508 set pathList [list]
509 foreach path [array names file_states] {
510 switch -- [lindex $file_states($path) 0] {
511 A? -
512 M? {lappend pathList $path}
513 }
514 }
515 if {$pathList ne {}} {
516 update_index \
517 "Updating included files" \
518 $pathList \
519 [concat {reshow_diff;} $after]
520 return
521 }
522 }
523
524 reshow_diff
525 uplevel #0 $after
526}
527
528proc prune_selection {} {
529 global file_states selected_paths
530
531 foreach path [array names selected_paths] {
532 if {[catch {set still_here $file_states($path)}]} {
533 unset selected_paths($path)
534 }
535 }
536}
537
538######################################################################
539##
540## diff
541
542proc clear_diff {} {
543 global ui_diff current_diff ui_index ui_other
544
545 $ui_diff conf -state normal
546 $ui_diff delete 0.0 end
547 $ui_diff conf -state disabled
548
549 set current_diff {}
550
551 $ui_index tag remove in_diff 0.0 end
552 $ui_other tag remove in_diff 0.0 end
553}
554
555proc reshow_diff {} {
556 global current_diff ui_status_value file_states
557
558 if {$current_diff eq {}
559 || [catch {set s $file_states($current_diff)}]} {
560 clear_diff
561 } else {
562 show_diff $current_diff
563 }
564}
565
566proc handle_empty_diff {} {
567 global current_diff file_states file_lists
568
569 set path $current_diff
570 set s $file_states($path)
571 if {[lindex $s 0] ne {_M}} return
572
573 info_popup "No differences detected.
574
575[short_path $path] has no changes.
576
577The modification date of this file was updated
578by another application and you currently have
579the Trust File Modification Timestamps option
580enabled, so Git did not automatically detect
581that there are no content differences in this
582file.
583
584This file will now be removed from the modified
585files list, to prevent possible confusion.
586"
587 if {[catch {exec git update-index -- $path} err]} {
588 error_popup "Failed to refresh index:\n\n$err"
589 }
590
591 clear_diff
592 set old_w [mapcol [lindex $file_states($path) 0] $path]
593 set lno [lsearch -sorted $file_lists($old_w) $path]
594 if {$lno >= 0} {
595 set file_lists($old_w) \
596 [lreplace $file_lists($old_w) $lno $lno]
597 incr lno
598 $old_w conf -state normal
599 $old_w delete $lno.0 [expr {$lno + 1}].0
600 $old_w conf -state disabled
601 }
602}
603
604proc show_diff {path {w {}} {lno {}}} {
605 global file_states file_lists
606 global is_3way_diff diff_active repo_config
607 global ui_diff current_diff ui_status_value
608
609 if {$diff_active || ![lock_index read]} return
610
611 clear_diff
612 if {$w eq {} || $lno == {}} {
613 foreach w [array names file_lists] {
614 set lno [lsearch -sorted $file_lists($w) $path]
615 if {$lno >= 0} {
616 incr lno
617 break
618 }
619 }
620 }
621 if {$w ne {} && $lno >= 1} {
622 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
623 }
624
625 set s $file_states($path)
626 set m [lindex $s 0]
627 set is_3way_diff 0
628 set diff_active 1
629 set current_diff $path
630 set ui_status_value "Loading diff of [escape_path $path]..."
631
632 set cmd [list | git diff-index]
633 lappend cmd --no-color
634 if {$repo_config(gui.diffcontext) > 0} {
635 lappend cmd "-U$repo_config(gui.diffcontext)"
636 }
637 lappend cmd -p
638
639 switch $m {
640 MM {
641 lappend cmd -c
642 }
643 _O {
644 if {[catch {
645 set fd [open $path r]
646 set content [read $fd]
647 close $fd
648 } err ]} {
649 set diff_active 0
650 unlock_index
651 set ui_status_value "Unable to display [escape_path $path]"
652 error_popup "Error loading file:\n\n$err"
653 return
654 }
655 $ui_diff conf -state normal
656 $ui_diff insert end $content
657 $ui_diff conf -state disabled
658 set diff_active 0
659 unlock_index
660 set ui_status_value {Ready.}
661 return
662 }
663 }
664
665 lappend cmd [PARENT]
666 lappend cmd --
667 lappend cmd $path
668
669 if {[catch {set fd [open $cmd r]} err]} {
670 set diff_active 0
671 unlock_index
672 set ui_status_value "Unable to display [escape_path $path]"
673 error_popup "Error loading diff:\n\n$err"
674 return
675 }
676
677 fconfigure $fd -blocking 0 -translation auto
678 fileevent $fd readable [list read_diff $fd]
679}
680
681proc read_diff {fd} {
682 global ui_diff ui_status_value is_3way_diff diff_active
683 global repo_config
684
685 $ui_diff conf -state normal
686 while {[gets $fd line] >= 0} {
687 # -- Cleanup uninteresting diff header lines.
688 #
689 if {[string match {diff --git *} $line]} continue
690 if {[string match {diff --combined *} $line]} continue
691 if {[string match {--- *} $line]} continue
692 if {[string match {+++ *} $line]} continue
693 if {$line eq {deleted file mode 120000}} {
694 set line "deleted symlink"
695 }
696
697 # -- Automatically detect if this is a 3 way diff.
698 #
699 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
700
701 # -- Reformat a 3 way diff, 'cause its too weird.
702 #
703 if {$is_3way_diff} {
704 set op [string range $line 0 1]
705 switch -- $op {
706 {@@} {set tags d_@}
707 {++} {set tags d_+ ; set op { +}}
708 {--} {set tags d_- ; set op { -}}
709 { +} {set tags d_++; set op {++}}
710 { -} {set tags d_--; set op {--}}
711 {+ } {set tags d_-+; set op {-+}}
712 {- } {set tags d_+-; set op {+-}}
713 default {set tags {}}
714 }
715 set line [string replace $line 0 1 $op]
716 } else {
717 switch -- [string index $line 0] {
718 @ {set tags d_@}
719 + {set tags d_+}
720 - {set tags d_-}
721 default {set tags {}}
722 }
723 }
724 $ui_diff insert end $line $tags
725 $ui_diff insert end "\n" $tags
726 }
727 $ui_diff conf -state disabled
728
729 if {[eof $fd]} {
730 close $fd
731 set diff_active 0
732 unlock_index
733 set ui_status_value {Ready.}
734
735 if {$repo_config(gui.trustmtime) eq {true}
736 && [$ui_diff index end] eq {2.0}} {
737 handle_empty_diff
738 }
739 }
740}
741
742######################################################################
743##
744## commit
745
746proc load_last_commit {} {
747 global HEAD PARENT MERGE_HEAD commit_type ui_comm
748
749 if {[llength $PARENT] == 0} {
750 error_popup {There is nothing to amend.
751
752You are about to create the initial commit.
753There is no commit before this to amend.
754}
755 return
756 }
757
758 repository_state curType curHEAD curMERGE_HEAD
759 if {$curType eq {merge}} {
760 error_popup {Cannot amend while merging.
761
762You are currently in the middle of a merge that
763has not been fully completed. You cannot amend
764the prior commit unless you first abort the
765current merge activity.
766}
767 return
768 }
769
770 set msg {}
771 set parents [list]
772 if {[catch {
773 set fd [open "| git cat-file commit $curHEAD" r]
774 while {[gets $fd line] > 0} {
775 if {[string match {parent *} $line]} {
776 lappend parents [string range $line 7 end]
777 }
778 }
779 set msg [string trim [read $fd]]
780 close $fd
781 } err]} {
782 error_popup "Error loading commit data for amend:\n\n$err"
783 return
784 }
785
786 set HEAD $curHEAD
787 set PARENT $parents
788 set MERGE_HEAD [list]
789 switch -- [llength $parents] {
790 0 {set commit_type amend-initial}
791 1 {set commit_type amend}
792 default {set commit_type amend-merge}
793 }
794
795 $ui_comm delete 0.0 end
796 $ui_comm insert end $msg
797 $ui_comm edit reset
798 $ui_comm edit modified false
799 rescan {set ui_status_value {Ready.}}
800}
801
802proc create_new_commit {} {
803 global commit_type ui_comm
804
805 set commit_type normal
806 $ui_comm delete 0.0 end
807 $ui_comm edit reset
808 $ui_comm edit modified false
809 rescan {set ui_status_value {Ready.}}
810}
811
812set GIT_COMMITTER_IDENT {}
813
814proc committer_ident {} {
815 global GIT_COMMITTER_IDENT
816
817 if {$GIT_COMMITTER_IDENT eq {}} {
818 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
819 error_popup "Unable to obtain your identity:\n\n$err"
820 return {}
821 }
822 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
823 $me me GIT_COMMITTER_IDENT]} {
824 error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
825 return {}
826 }
827 }
828
829 return $GIT_COMMITTER_IDENT
830}
831
832proc commit_tree {} {
833 global HEAD commit_type file_states ui_comm repo_config
834
835 if {![lock_index update]} return
836 if {[committer_ident] eq {}} return
837
838 # -- Our in memory state should match the repository.
839 #
840 repository_state curType curHEAD curMERGE_HEAD
841 if {[string match amend* $commit_type]
842 && $curType eq {normal}
843 && $curHEAD eq $HEAD} {
844 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
845 info_popup {Last scanned state does not match repository state.
846
847Another Git program has modified this repository
848since the last scan. A rescan must be performed
849before another commit can be created.
850
851The rescan will be automatically started now.
852}
853 unlock_index
854 rescan {set ui_status_value {Ready.}}
855 return
856 }
857
858 # -- At least one file should differ in the index.
859 #
860 set files_ready 0
861 foreach path [array names file_states] {
862 switch -glob -- [lindex $file_states($path) 0] {
863 _? {continue}
864 A? -
865 D? -
866 M? {set files_ready 1; break}
867 U? {
868 error_popup "Unmerged files cannot be committed.
869
870File [short_path $path] has merge conflicts.
871You must resolve them and include the file before committing.
872"
873 unlock_index
874 return
875 }
876 default {
877 error_popup "Unknown file state [lindex $s 0] detected.
878
879File [short_path $path] cannot be committed by this program.
880"
881 }
882 }
883 }
884 if {!$files_ready} {
885 error_popup {No included files to commit.
886
887You must include at least 1 file before you can commit.
888}
889 unlock_index
890 return
891 }
892
893 # -- A message is required.
894 #
895 set msg [string trim [$ui_comm get 1.0 end]]
896 if {$msg eq {}} {
897 error_popup {Please supply a commit message.
898
899A good commit message has the following format:
900
901- First line: Describe in one sentance what you did.
902- Second line: Blank
903- Remaining lines: Describe why this change is good.
904}
905 unlock_index
906 return
907 }
908
909 # -- Update included files if partialincludes are off.
910 #
911 if {$repo_config(gui.partialinclude) ne {true}} {
912 set pathList [list]
913 foreach path [array names file_states] {
914 switch -glob -- [lindex $file_states($path) 0] {
915 A? -
916 M? {lappend pathList $path}
917 }
918 }
919 if {$pathList ne {}} {
920 unlock_index
921 update_index \
922 "Updating included files" \
923 $pathList \
924 [concat {lock_index update;} \
925 [list commit_prehook $curHEAD $msg]]
926 return
927 }
928 }
929
930 commit_prehook $curHEAD $msg
931}
932
933proc commit_prehook {curHEAD msg} {
934 global gitdir ui_status_value pch_error
935
936 set pchook [file join $gitdir hooks pre-commit]
937
938 # On Cygwin [file executable] might lie so we need to ask
939 # the shell if the hook is executable. Yes that's annoying.
940 #
941 if {[is_Windows] && [file isfile $pchook]} {
942 set pchook [list sh -c [concat \
943 "if test -x \"$pchook\";" \
944 "then exec \"$pchook\" 2>&1;" \
945 "fi"]]
946 } elseif {[file executable $pchook]} {
947 set pchook [list $pchook |& cat]
948 } else {
949 commit_writetree $curHEAD $msg
950 return
951 }
952
953 set ui_status_value {Calling pre-commit hook...}
954 set pch_error {}
955 set fd_ph [open "| $pchook" r]
956 fconfigure $fd_ph -blocking 0 -translation binary
957 fileevent $fd_ph readable \
958 [list commit_prehook_wait $fd_ph $curHEAD $msg]
959}
960
961proc commit_prehook_wait {fd_ph curHEAD msg} {
962 global pch_error ui_status_value
963
964 append pch_error [read $fd_ph]
965 fconfigure $fd_ph -blocking 1
966 if {[eof $fd_ph]} {
967 if {[catch {close $fd_ph}]} {
968 set ui_status_value {Commit declined by pre-commit hook.}
969 hook_failed_popup pre-commit $pch_error
970 unlock_index
971 } else {
972 commit_writetree $curHEAD $msg
973 }
974 set pch_error {}
975 return
976 }
977 fconfigure $fd_ph -blocking 0
978}
979
980proc commit_writetree {curHEAD msg} {
981 global ui_status_value
982
983 set ui_status_value {Committing changes...}
984 set fd_wt [open "| git write-tree" r]
985 fileevent $fd_wt readable \
986 [list commit_committree $fd_wt $curHEAD $msg]
987}
988
989proc commit_committree {fd_wt curHEAD msg} {
990 global HEAD PARENT MERGE_HEAD commit_type
991 global single_commit gitdir
992 global ui_status_value ui_comm selected_commit_type
993 global file_states selected_paths rescan_active
994
995 gets $fd_wt tree_id
996 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
997 error_popup "write-tree failed:\n\n$err"
998 set ui_status_value {Commit failed.}
999 unlock_index
1000 return
1001 }
1002
1003 # -- Create the commit.
1004 #
1005 set cmd [list git commit-tree $tree_id]
1006 set parents [concat $PARENT $MERGE_HEAD]
1007 if {[llength $parents] > 0} {
1008 foreach p $parents {
1009 lappend cmd -p $p
1010 }
1011 } else {
1012 # git commit-tree writes to stderr during initial commit.
1013 lappend cmd 2>/dev/null
1014 }
1015 lappend cmd << $msg
1016 if {[catch {set cmt_id [eval exec $cmd]} err]} {
1017 error_popup "commit-tree failed:\n\n$err"
1018 set ui_status_value {Commit failed.}
1019 unlock_index
1020 return
1021 }
1022
1023 # -- Update the HEAD ref.
1024 #
1025 set reflogm commit
1026 if {$commit_type ne {normal}} {
1027 append reflogm " ($commit_type)"
1028 }
1029 set i [string first "\n" $msg]
1030 if {$i >= 0} {
1031 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1032 } else {
1033 append reflogm {: } $msg
1034 }
1035 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1036 if {[catch {eval exec $cmd} err]} {
1037 error_popup "update-ref failed:\n\n$err"
1038 set ui_status_value {Commit failed.}
1039 unlock_index
1040 return
1041 }
1042
1043 # -- Cleanup after ourselves.
1044 #
1045 catch {file delete [file join $gitdir MERGE_HEAD]}
1046 catch {file delete [file join $gitdir MERGE_MSG]}
1047 catch {file delete [file join $gitdir SQUASH_MSG]}
1048 catch {file delete [file join $gitdir GITGUI_MSG]}
1049
1050 # -- Let rerere do its thing.
1051 #
1052 if {[file isdirectory [file join $gitdir rr-cache]]} {
1053 catch {exec git rerere}
1054 }
1055
1056 # -- Run the post-commit hook.
1057 #
1058 set pchook [file join $gitdir hooks post-commit]
1059 if {[is_Windows] && [file isfile $pchook]} {
1060 set pchook [list sh -c [concat \
1061 "if test -x \"$pchook\";" \
1062 "then exec \"$pchook\";" \
1063 "fi"]]
1064 } elseif {![file executable $pchook]} {
1065 set pchook {}
1066 }
1067 if {$pchook ne {}} {
1068 catch {exec $pchook &}
1069 }
1070
1071 $ui_comm delete 0.0 end
1072 $ui_comm edit reset
1073 $ui_comm edit modified false
1074
1075 if {$single_commit} do_quit
1076
1077 # -- Update in memory status
1078 #
1079 set selected_commit_type new
1080 set commit_type normal
1081 set HEAD $cmt_id
1082 set PARENT $cmt_id
1083 set MERGE_HEAD [list]
1084
1085 foreach path [array names file_states] {
1086 set s $file_states($path)
1087 set m [lindex $s 0]
1088 switch -glob -- $m {
1089 _O -
1090 _M -
1091 _D {continue}
1092 __ -
1093 A_ -
1094 M_ -
1095 DD {
1096 unset file_states($path)
1097 catch {unset selected_paths($path)}
1098 }
1099 DO {
1100 set file_states($path) [list _O [lindex $s 1] {} {}]
1101 }
1102 AM -
1103 AD -
1104 MM -
1105 MD -
1106 DM {
1107 set file_states($path) [list \
1108 _[string index $m 1] \
1109 [lindex $s 1] \
1110 [lindex $s 3] \
1111 {}]
1112 }
1113 }
1114 }
1115
1116 display_all_files
1117 unlock_index
1118 reshow_diff
1119 set ui_status_value \
1120 "Changes committed as [string range $cmt_id 0 7]."
1121}
1122
1123######################################################################
1124##
1125## fetch pull push
1126
1127proc fetch_from {remote} {
1128 set w [new_console "fetch $remote" \
1129 "Fetching new changes from $remote"]
1130 set cmd [list git fetch]
1131 lappend cmd $remote
1132 console_exec $w $cmd
1133}
1134
1135proc pull_remote {remote branch} {
1136 global HEAD commit_type file_states repo_config
1137
1138 if {![lock_index update]} return
1139
1140 # -- Our in memory state should match the repository.
1141 #
1142 repository_state curType curHEAD curMERGE_HEAD
1143 if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1144 info_popup {Last scanned state does not match repository state.
1145
1146Another Git program has modified this repository
1147since the last scan. A rescan must be performed
1148before a pull operation can be started.
1149
1150The rescan will be automatically started now.
1151}
1152 unlock_index
1153 rescan {set ui_status_value {Ready.}}
1154 return
1155 }
1156
1157 # -- No differences should exist before a pull.
1158 #
1159 if {[array size file_states] != 0} {
1160 error_popup {Uncommitted but modified files are present.
1161
1162You should not perform a pull with unmodified
1163files in your working directory as Git will be
1164unable to recover from an incorrect merge.
1165
1166You should commit or revert all changes before
1167starting a pull operation.
1168}
1169 unlock_index
1170 return
1171 }
1172
1173 set w [new_console "pull $remote $branch" \
1174 "Pulling new changes from branch $branch in $remote"]
1175 set cmd [list git pull]
1176 if {$repo_config(gui.pullsummary) eq {false}} {
1177 lappend cmd --no-summary
1178 }
1179 lappend cmd $remote
1180 lappend cmd $branch
1181 console_exec $w $cmd [list post_pull_remote $remote $branch]
1182}
1183
1184proc post_pull_remote {remote branch success} {
1185 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1186 global ui_status_value
1187
1188 unlock_index
1189 if {$success} {
1190 repository_state commit_type HEAD MERGE_HEAD
1191 set PARENT $HEAD
1192 set selected_commit_type new
1193 set ui_status_value "Pulling $branch from $remote complete."
1194 } else {
1195 rescan [list set ui_status_value \
1196 "Conflicts detected while pulling $branch from $remote."]
1197 }
1198}
1199
1200proc push_to {remote} {
1201 set w [new_console "push $remote" \
1202 "Pushing changes to $remote"]
1203 set cmd [list git push]
1204 lappend cmd $remote
1205 console_exec $w $cmd
1206}
1207
1208######################################################################
1209##
1210## ui helpers
1211
1212proc mapcol {state path} {
1213 global all_cols ui_other
1214
1215 if {[catch {set r $all_cols($state)}]} {
1216 puts "error: no column for state={$state} $path"
1217 return $ui_other
1218 }
1219 return $r
1220}
1221
1222proc mapicon {state path} {
1223 global all_icons
1224
1225 if {[catch {set r $all_icons($state)}]} {
1226 puts "error: no icon for state={$state} $path"
1227 return file_plain
1228 }
1229 return $r
1230}
1231
1232proc mapdesc {state path} {
1233 global all_descs
1234
1235 if {[catch {set r $all_descs($state)}]} {
1236 puts "error: no desc for state={$state} $path"
1237 return $state
1238 }
1239 return $r
1240}
1241
1242proc escape_path {path} {
1243 regsub -all "\n" $path "\\n" path
1244 return $path
1245}
1246
1247proc short_path {path} {
1248 return [escape_path [lindex [file split $path] end]]
1249}
1250
1251set next_icon_id 0
1252set null_sha1 [string repeat 0 40]
1253
1254proc merge_state {path new_state {head_info {}} {index_info {}}} {
1255 global file_states next_icon_id null_sha1
1256
1257 set s0 [string index $new_state 0]
1258 set s1 [string index $new_state 1]
1259
1260 if {[catch {set info $file_states($path)}]} {
1261 set state __
1262 set icon n[incr next_icon_id]
1263 } else {
1264 set state [lindex $info 0]
1265 set icon [lindex $info 1]
1266 if {$head_info eq {}} {set head_info [lindex $info 2]}
1267 if {$index_info eq {}} {set index_info [lindex $info 3]}
1268 }
1269
1270 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1271 elseif {$s0 eq {_}} {set s0 _}
1272
1273 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1274 elseif {$s1 eq {_}} {set s1 _}
1275
1276 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1277 set head_info [list 0 $null_sha1]
1278 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1279 && $head_info eq {}} {
1280 set head_info $index_info
1281 }
1282
1283 set file_states($path) [list $s0$s1 $icon \
1284 $head_info $index_info \
1285 ]
1286 return $state
1287}
1288
1289proc display_file {path state} {
1290 global file_states file_lists selected_paths
1291
1292 set old_m [merge_state $path $state]
1293 set s $file_states($path)
1294 set new_m [lindex $s 0]
1295 set new_w [mapcol $new_m $path]
1296 set old_w [mapcol $old_m $path]
1297 set new_icon [mapicon $new_m $path]
1298
1299 if {$new_m eq {__}} {
1300 set lno [lsearch -sorted $file_lists($old_w) $path]
1301 if {$lno >= 0} {
1302 set file_lists($old_w) \
1303 [lreplace $file_lists($old_w) $lno $lno]
1304 incr lno
1305 $old_w conf -state normal
1306 $old_w delete $lno.0 [expr {$lno + 1}].0
1307 $old_w conf -state disabled
1308 }
1309 unset file_states($path)
1310 catch {unset selected_paths($path)}
1311 return
1312 }
1313
1314 if {$new_w ne $old_w} {
1315 set lno [lsearch -sorted $file_lists($old_w) $path]
1316 if {$lno >= 0} {
1317 set file_lists($old_w) \
1318 [lreplace $file_lists($old_w) $lno $lno]
1319 incr lno
1320 $old_w conf -state normal
1321 $old_w delete $lno.0 [expr {$lno + 1}].0
1322 $old_w conf -state disabled
1323 }
1324
1325 lappend file_lists($new_w) $path
1326 set file_lists($new_w) [lsort $file_lists($new_w)]
1327 set lno [lsearch -sorted $file_lists($new_w) $path]
1328 incr lno
1329 $new_w conf -state normal
1330 $new_w image create $lno.0 \
1331 -align center -padx 5 -pady 1 \
1332 -name [lindex $s 1] \
1333 -image $new_icon
1334 $new_w insert $lno.1 "[escape_path $path]\n"
1335 if {[catch {set in_sel $selected_paths($path)}]} {
1336 set in_sel 0
1337 }
1338 if {$in_sel} {
1339 $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1340 }
1341 $new_w conf -state disabled
1342 } elseif {$new_icon ne [mapicon $old_m $path]} {
1343 $new_w conf -state normal
1344 $new_w image conf [lindex $s 1] -image $new_icon
1345 $new_w conf -state disabled
1346 }
1347}
1348
1349proc display_all_files {} {
1350 global ui_index ui_other
1351 global file_states file_lists
1352 global last_clicked selected_paths
1353
1354 $ui_index conf -state normal
1355 $ui_other conf -state normal
1356
1357 $ui_index delete 0.0 end
1358 $ui_other delete 0.0 end
1359 set last_clicked {}
1360
1361 set file_lists($ui_index) [list]
1362 set file_lists($ui_other) [list]
1363
1364 foreach path [lsort [array names file_states]] {
1365 set s $file_states($path)
1366 set m [lindex $s 0]
1367 set w [mapcol $m $path]
1368 lappend file_lists($w) $path
1369 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1370 $w image create end \
1371 -align center -padx 5 -pady 1 \
1372 -name [lindex $s 1] \
1373 -image [mapicon $m $path]
1374 $w insert end "[escape_path $path]\n"
1375 if {[catch {set in_sel $selected_paths($path)}]} {
1376 set in_sel 0
1377 }
1378 if {$in_sel} {
1379 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1380 }
1381 }
1382
1383 $ui_index conf -state disabled
1384 $ui_other conf -state disabled
1385}
1386
1387proc update_indexinfo {msg pathList after} {
1388 global update_index_cp ui_status_value
1389
1390 if {![lock_index update]} return
1391
1392 set update_index_cp 0
1393 set pathList [lsort $pathList]
1394 set totalCnt [llength $pathList]
1395 set batch [expr {int($totalCnt * .01) + 1}]
1396 if {$batch > 25} {set batch 25}
1397
1398 set ui_status_value [format \
1399 "$msg... %i/%i files (%.2f%%)" \
1400 $update_index_cp \
1401 $totalCnt \
1402 0.0]
1403 set fd [open "| git update-index -z --index-info" w]
1404 fconfigure $fd \
1405 -blocking 0 \
1406 -buffering full \
1407 -buffersize 512 \
1408 -translation binary
1409 fileevent $fd writable [list \
1410 write_update_indexinfo \
1411 $fd \
1412 $pathList \
1413 $totalCnt \
1414 $batch \
1415 $msg \
1416 $after \
1417 ]
1418}
1419
1420proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1421 global update_index_cp ui_status_value
1422 global file_states current_diff
1423
1424 if {$update_index_cp >= $totalCnt} {
1425 close $fd
1426 unlock_index
1427 uplevel #0 $after
1428 return
1429 }
1430
1431 for {set i $batch} \
1432 {$update_index_cp < $totalCnt && $i > 0} \
1433 {incr i -1} {
1434 set path [lindex $pathList $update_index_cp]
1435 incr update_index_cp
1436
1437 set s $file_states($path)
1438 switch -glob -- [lindex $s 0] {
1439 A? {set new _O}
1440 M? {set new _M}
1441 D_ {set new _D}
1442 D? {set new _?}
1443 ?? {continue}
1444 }
1445 set info [lindex $s 2]
1446 if {$info eq {}} continue
1447
1448 puts -nonewline $fd $info
1449 puts -nonewline $fd "\t"
1450 puts -nonewline $fd $path
1451 puts -nonewline $fd "\0"
1452 display_file $path $new
1453 }
1454
1455 set ui_status_value [format \
1456 "$msg... %i/%i files (%.2f%%)" \
1457 $update_index_cp \
1458 $totalCnt \
1459 [expr {100.0 * $update_index_cp / $totalCnt}]]
1460}
1461
1462proc update_index {msg pathList after} {
1463 global update_index_cp ui_status_value
1464
1465 if {![lock_index update]} return
1466
1467 set update_index_cp 0
1468 set pathList [lsort $pathList]
1469 set totalCnt [llength $pathList]
1470 set batch [expr {int($totalCnt * .01) + 1}]
1471 if {$batch > 25} {set batch 25}
1472
1473 set ui_status_value [format \
1474 "$msg... %i/%i files (%.2f%%)" \
1475 $update_index_cp \
1476 $totalCnt \
1477 0.0]
1478 set fd [open "| git update-index --add --remove -z --stdin" w]
1479 fconfigure $fd \
1480 -blocking 0 \
1481 -buffering full \
1482 -buffersize 512 \
1483 -translation binary
1484 fileevent $fd writable [list \
1485 write_update_index \
1486 $fd \
1487 $pathList \
1488 $totalCnt \
1489 $batch \
1490 $msg \
1491 $after \
1492 ]
1493}
1494
1495proc write_update_index {fd pathList totalCnt batch msg after} {
1496 global update_index_cp ui_status_value
1497 global file_states current_diff
1498
1499 if {$update_index_cp >= $totalCnt} {
1500 close $fd
1501 unlock_index
1502 uplevel #0 $after
1503 return
1504 }
1505
1506 for {set i $batch} \
1507 {$update_index_cp < $totalCnt && $i > 0} \
1508 {incr i -1} {
1509 set path [lindex $pathList $update_index_cp]
1510 incr update_index_cp
1511
1512 switch -glob -- [lindex $file_states($path) 0] {
1513 AD -
1514 MD -
1515 UD -
1516 _D {set new DD}
1517
1518 _M -
1519 MM -
1520 UM -
1521 U_ -
1522 M_ {set new M_}
1523
1524 _O -
1525 AM -
1526 A_ {set new A_}
1527
1528 ?? {continue}
1529 }
1530
1531 puts -nonewline $fd $path
1532 puts -nonewline $fd "\0"
1533 display_file $path $new
1534 }
1535
1536 set ui_status_value [format \
1537 "$msg... %i/%i files (%.2f%%)" \
1538 $update_index_cp \
1539 $totalCnt \
1540 [expr {100.0 * $update_index_cp / $totalCnt}]]
1541}
1542
1543proc checkout_index {msg pathList after} {
1544 global update_index_cp ui_status_value
1545
1546 if {![lock_index update]} return
1547
1548 set update_index_cp 0
1549 set pathList [lsort $pathList]
1550 set totalCnt [llength $pathList]
1551 set batch [expr {int($totalCnt * .01) + 1}]
1552 if {$batch > 25} {set batch 25}
1553
1554 set ui_status_value [format \
1555 "$msg... %i/%i files (%.2f%%)" \
1556 $update_index_cp \
1557 $totalCnt \
1558 0.0]
1559 set cmd [list git checkout-index]
1560 lappend cmd --index
1561 lappend cmd --quiet
1562 lappend cmd --force
1563 lappend cmd -z
1564 lappend cmd --stdin
1565 set fd [open "| $cmd " w]
1566 fconfigure $fd \
1567 -blocking 0 \
1568 -buffering full \
1569 -buffersize 512 \
1570 -translation binary
1571 fileevent $fd writable [list \
1572 write_checkout_index \
1573 $fd \
1574 $pathList \
1575 $totalCnt \
1576 $batch \
1577 $msg \
1578 $after \
1579 ]
1580}
1581
1582proc write_checkout_index {fd pathList totalCnt batch msg after} {
1583 global update_index_cp ui_status_value
1584 global file_states current_diff
1585
1586 if {$update_index_cp >= $totalCnt} {
1587 close $fd
1588 unlock_index
1589 uplevel #0 $after
1590 return
1591 }
1592
1593 for {set i $batch} \
1594 {$update_index_cp < $totalCnt && $i > 0} \
1595 {incr i -1} {
1596 set path [lindex $pathList $update_index_cp]
1597 incr update_index_cp
1598
1599 switch -glob -- [lindex $file_states($path) 0] {
1600 AM -
1601 AD {set new A_}
1602 MM -
1603 MD {set new M_}
1604 _M -
1605 _D {set new __}
1606 ?? {continue}
1607 }
1608
1609 puts -nonewline $fd $path
1610 puts -nonewline $fd "\0"
1611 display_file $path $new
1612 }
1613
1614 set ui_status_value [format \
1615 "$msg... %i/%i files (%.2f%%)" \
1616 $update_index_cp \
1617 $totalCnt \
1618 [expr {100.0 * $update_index_cp / $totalCnt}]]
1619}
1620
1621######################################################################
1622##
1623## branch management
1624
1625proc load_all_heads {} {
1626 global all_heads tracking_branches
1627
1628 set all_heads [list]
1629 set cmd [list git for-each-ref]
1630 lappend cmd --format=%(refname)
1631 lappend cmd refs/heads
1632 set fd [open "| $cmd" r]
1633 while {[gets $fd line] > 0} {
1634 if {![catch {set info $tracking_branches($line)}]} continue
1635 if {![regsub ^refs/heads/ $line {} name]} continue
1636 lappend all_heads $name
1637 }
1638 close $fd
1639
1640 set all_heads [lsort $all_heads]
1641}
1642
1643proc populate_branch_menu {m} {
1644 global all_heads disable_on_lock
1645
1646 $m add separator
1647 foreach b $all_heads {
1648 $m add radiobutton \
1649 -label $b \
1650 -command [list switch_branch $b] \
1651 -variable current_branch \
1652 -value $b \
1653 -font font_ui
1654 lappend disable_on_lock \
1655 [list $m entryconf [$m index last] -state]
1656 }
1657}
1658
1659proc do_create_branch {} {
1660 error "NOT IMPLEMENTED"
1661}
1662
1663proc do_delete_branch {} {
1664 error "NOT IMPLEMENTED"
1665}
1666
1667proc switch_branch {b} {
1668 global HEAD commit_type file_states current_branch
1669 global selected_commit_type ui_comm
1670
1671 if {![lock_index switch]} return
1672
1673 # -- Backup the selected branch (repository_state resets it)
1674 #
1675 set new_branch $current_branch
1676
1677 # -- Our in memory state should match the repository.
1678 #
1679 repository_state curType curHEAD curMERGE_HEAD
1680 if {[string match amend* $commit_type]
1681 && $curType eq {normal}
1682 && $curHEAD eq $HEAD} {
1683 } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1684 info_popup {Last scanned state does not match repository state.
1685
1686Another Git program has modified this repository
1687since the last scan. A rescan must be performed
1688before the current branch can be changed.
1689
1690The rescan will be automatically started now.
1691}
1692 unlock_index
1693 rescan {set ui_status_value {Ready.}}
1694 return
1695 }
1696
1697 # -- Toss the message buffer if we are in amend mode.
1698 #
1699 if {[string match amend* $curType]} {
1700 $ui_comm delete 0.0 end
1701 $ui_comm edit reset
1702 $ui_comm edit modified false
1703 }
1704
1705 set selected_commit_type new
1706 set current_branch $new_branch
1707
1708 unlock_index
1709 error "NOT FINISHED"
1710}
1711
1712######################################################################
1713##
1714## remote management
1715
1716proc load_all_remotes {} {
1717 global gitdir repo_config
1718 global all_remotes tracking_branches
1719
1720 set all_remotes [list]
1721 array unset tracking_branches
1722
1723 set rm_dir [file join $gitdir remotes]
1724 if {[file isdirectory $rm_dir]} {
1725 set all_remotes [glob \
1726 -types f \
1727 -tails \
1728 -nocomplain \
1729 -directory $rm_dir *]
1730
1731 foreach name $all_remotes {
1732 catch {
1733 set fd [open [file join $rm_dir $name] r]
1734 while {[gets $fd line] >= 0} {
1735 if {![regexp {^Pull:[ ]*([^:]+):(.+)$} \
1736 $line line src dst]} continue
1737 if {![regexp ^refs/ $dst]} {
1738 set dst "refs/heads/$dst"
1739 }
1740 set tracking_branches($dst) [list $name $src]
1741 }
1742 close $fd
1743 }
1744 }
1745 }
1746
1747 foreach line [array names repo_config remote.*.url] {
1748 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
1749 lappend all_remotes $name
1750
1751 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
1752 set fl {}
1753 }
1754 foreach line $fl {
1755 if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
1756 if {![regexp ^refs/ $dst]} {
1757 set dst "refs/heads/$dst"
1758 }
1759 set tracking_branches($dst) [list $name $src]
1760 }
1761 }
1762
1763 set all_remotes [lsort -unique $all_remotes]
1764}
1765
1766proc populate_fetch_menu {m} {
1767 global gitdir all_remotes repo_config
1768
1769 foreach r $all_remotes {
1770 set enable 0
1771 if {![catch {set a $repo_config(remote.$r.url)}]} {
1772 if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1773 set enable 1
1774 }
1775 } else {
1776 catch {
1777 set fd [open [file join $gitdir remotes $r] r]
1778 while {[gets $fd n] >= 0} {
1779 if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1780 set enable 1
1781 break
1782 }
1783 }
1784 close $fd
1785 }
1786 }
1787
1788 if {$enable} {
1789 $m add command \
1790 -label "Fetch from $r..." \
1791 -command [list fetch_from $r] \
1792 -font font_ui
1793 }
1794 }
1795}
1796
1797proc populate_push_menu {m} {
1798 global gitdir all_remotes repo_config
1799
1800 foreach r $all_remotes {
1801 set enable 0
1802 if {![catch {set a $repo_config(remote.$r.url)}]} {
1803 if {![catch {set a $repo_config(remote.$r.push)}]} {
1804 set enable 1
1805 }
1806 } else {
1807 catch {
1808 set fd [open [file join $gitdir remotes $r] r]
1809 while {[gets $fd n] >= 0} {
1810 if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1811 set enable 1
1812 break
1813 }
1814 }
1815 close $fd
1816 }
1817 }
1818
1819 if {$enable} {
1820 $m add command \
1821 -label "Push to $r..." \
1822 -command [list push_to $r] \
1823 -font font_ui
1824 }
1825 }
1826}
1827
1828proc populate_pull_menu {m} {
1829 global gitdir repo_config all_remotes disable_on_lock
1830
1831 foreach remote $all_remotes {
1832 set rb_list [list]
1833 if {[array get repo_config remote.$remote.url] ne {}} {
1834 if {[array get repo_config remote.$remote.fetch] ne {}} {
1835 foreach line $repo_config(remote.$remote.fetch) {
1836 if {[regexp {^([^:]+):} $line line rb]} {
1837 lappend rb_list $rb
1838 }
1839 }
1840 }
1841 } else {
1842 catch {
1843 set fd [open [file join $gitdir remotes $remote] r]
1844 while {[gets $fd line] >= 0} {
1845 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1846 lappend rb_list $rb
1847 }
1848 }
1849 close $fd
1850 }
1851 }
1852
1853 foreach rb $rb_list {
1854 regsub ^refs/heads/ $rb {} rb_short
1855 $m add command \
1856 -label "Branch $rb_short from $remote..." \
1857 -command [list pull_remote $remote $rb] \
1858 -font font_ui
1859 lappend disable_on_lock \
1860 [list $m entryconf [$m index last] -state]
1861 }
1862 }
1863}
1864
1865######################################################################
1866##
1867## icons
1868
1869set filemask {
1870#define mask_width 14
1871#define mask_height 15
1872static unsigned char mask_bits[] = {
1873 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1874 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1875 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1876}
1877
1878image create bitmap file_plain -background white -foreground black -data {
1879#define plain_width 14
1880#define plain_height 15
1881static unsigned char plain_bits[] = {
1882 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1883 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1884 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1885} -maskdata $filemask
1886
1887image create bitmap file_mod -background white -foreground blue -data {
1888#define mod_width 14
1889#define mod_height 15
1890static unsigned char mod_bits[] = {
1891 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1892 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1893 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1894} -maskdata $filemask
1895
1896image create bitmap file_fulltick -background white -foreground "#007000" -data {
1897#define file_fulltick_width 14
1898#define file_fulltick_height 15
1899static unsigned char file_fulltick_bits[] = {
1900 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1901 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1902 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1903} -maskdata $filemask
1904
1905image create bitmap file_parttick -background white -foreground "#005050" -data {
1906#define parttick_width 14
1907#define parttick_height 15
1908static unsigned char parttick_bits[] = {
1909 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1910 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1911 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1912} -maskdata $filemask
1913
1914image create bitmap file_question -background white -foreground black -data {
1915#define file_question_width 14
1916#define file_question_height 15
1917static unsigned char file_question_bits[] = {
1918 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1919 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1920 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1921} -maskdata $filemask
1922
1923image create bitmap file_removed -background white -foreground red -data {
1924#define file_removed_width 14
1925#define file_removed_height 15
1926static unsigned char file_removed_bits[] = {
1927 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1928 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1929 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1930} -maskdata $filemask
1931
1932image create bitmap file_merge -background white -foreground blue -data {
1933#define file_merge_width 14
1934#define file_merge_height 15
1935static unsigned char file_merge_bits[] = {
1936 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1937 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1938 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1939} -maskdata $filemask
1940
1941set ui_index .vpane.files.index.list
1942set ui_other .vpane.files.other.list
1943set max_status_desc 0
1944foreach i {
1945 {__ i plain "Unmodified"}
1946 {_M i mod "Modified"}
1947 {M_ i fulltick "Added to commit"}
1948 {MM i parttick "Partially included"}
1949 {MD i question "Added (but gone)"}
1950
1951 {_O o plain "Untracked"}
1952 {A_ o fulltick "Added by commit"}
1953 {AM o parttick "Partially added"}
1954 {AD o question "Added (but gone)"}
1955
1956 {_D i question "Missing"}
1957 {DD i removed "Removed by commit"}
1958 {D_ i removed "Removed by commit"}
1959 {DO i removed "Removed (still exists)"}
1960 {DM i removed "Removed (but modified)"}
1961
1962 {UD i merge "Merge conflicts"}
1963 {UM i merge "Merge conflicts"}
1964 {U_ i merge "Merge conflicts"}
1965 } {
1966 if {$max_status_desc < [string length [lindex $i 3]]} {
1967 set max_status_desc [string length [lindex $i 3]]
1968 }
1969 if {[lindex $i 1] eq {i}} {
1970 set all_cols([lindex $i 0]) $ui_index
1971 } else {
1972 set all_cols([lindex $i 0]) $ui_other
1973 }
1974 set all_icons([lindex $i 0]) file_[lindex $i 2]
1975 set all_descs([lindex $i 0]) [lindex $i 3]
1976}
1977unset filemask i
1978
1979######################################################################
1980##
1981## util
1982
1983proc is_MacOSX {} {
1984 global tcl_platform tk_library
1985 if {[tk windowingsystem] eq {aqua}} {
1986 return 1
1987 }
1988 return 0
1989}
1990
1991proc is_Windows {} {
1992 global tcl_platform
1993 if {$tcl_platform(platform) eq {windows}} {
1994 return 1
1995 }
1996 return 0
1997}
1998
1999proc bind_button3 {w cmd} {
2000 bind $w <Any-Button-3> $cmd
2001 if {[is_MacOSX]} {
2002 bind $w <Control-Button-1> $cmd
2003 }
2004}
2005
2006proc incr_font_size {font {amt 1}} {
2007 set sz [font configure $font -size]
2008 incr sz $amt
2009 font configure $font -size $sz
2010 font configure ${font}bold -size $sz
2011}
2012
2013proc hook_failed_popup {hook msg} {
2014 global gitdir appname
2015
2016 set w .hookfail
2017 toplevel $w
2018
2019 frame $w.m
2020 label $w.m.l1 -text "$hook hook failed:" \
2021 -anchor w \
2022 -justify left \
2023 -font font_uibold
2024 text $w.m.t \
2025 -background white -borderwidth 1 \
2026 -relief sunken \
2027 -width 80 -height 10 \
2028 -font font_diff \
2029 -yscrollcommand [list $w.m.sby set]
2030 label $w.m.l2 \
2031 -text {You must correct the above errors before committing.} \
2032 -anchor w \
2033 -justify left \
2034 -font font_uibold
2035 scrollbar $w.m.sby -command [list $w.m.t yview]
2036 pack $w.m.l1 -side top -fill x
2037 pack $w.m.l2 -side bottom -fill x
2038 pack $w.m.sby -side right -fill y
2039 pack $w.m.t -side left -fill both -expand 1
2040 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2041
2042 $w.m.t insert 1.0 $msg
2043 $w.m.t conf -state disabled
2044
2045 button $w.ok -text OK \
2046 -width 15 \
2047 -font font_ui \
2048 -command "destroy $w"
2049 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2050
2051 bind $w <Visibility> "grab $w; focus $w"
2052 bind $w <Key-Return> "destroy $w"
2053 wm title $w "$appname ([lindex [file split \
2054 [file normalize [file dirname $gitdir]]] \
2055 end]): error"
2056 tkwait window $w
2057}
2058
2059set next_console_id 0
2060
2061proc new_console {short_title long_title} {
2062 global next_console_id console_data
2063 set w .console[incr next_console_id]
2064 set console_data($w) [list $short_title $long_title]
2065 return [console_init $w]
2066}
2067
2068proc console_init {w} {
2069 global console_cr console_data
2070 global gitdir appname M1B
2071
2072 set console_cr($w) 1.0
2073 toplevel $w
2074 frame $w.m
2075 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2076 -anchor w \
2077 -justify left \
2078 -font font_uibold
2079 text $w.m.t \
2080 -background white -borderwidth 1 \
2081 -relief sunken \
2082 -width 80 -height 10 \
2083 -font font_diff \
2084 -state disabled \
2085 -yscrollcommand [list $w.m.sby set]
2086 label $w.m.s -text {Working... please wait...} \
2087 -anchor w \
2088 -justify left \
2089 -font font_uibold
2090 scrollbar $w.m.sby -command [list $w.m.t yview]
2091 pack $w.m.l1 -side top -fill x
2092 pack $w.m.s -side bottom -fill x
2093 pack $w.m.sby -side right -fill y
2094 pack $w.m.t -side left -fill both -expand 1
2095 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2096
2097 menu $w.ctxm -tearoff 0
2098 $w.ctxm add command -label "Copy" \
2099 -font font_ui \
2100 -command "tk_textCopy $w.m.t"
2101 $w.ctxm add command -label "Select All" \
2102 -font font_ui \
2103 -command "$w.m.t tag add sel 0.0 end"
2104 $w.ctxm add command -label "Copy All" \
2105 -font font_ui \
2106 -command "
2107 $w.m.t tag add sel 0.0 end
2108 tk_textCopy $w.m.t
2109 $w.m.t tag remove sel 0.0 end
2110 "
2111
2112 button $w.ok -text {Close} \
2113 -font font_ui \
2114 -state disabled \
2115 -command "destroy $w"
2116 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2117
2118 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2119 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2120 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2121 bind $w <Visibility> "focus $w"
2122 wm title $w "$appname ([lindex [file split \
2123 [file normalize [file dirname $gitdir]]] \
2124 end]): [lindex $console_data($w) 0]"
2125 return $w
2126}
2127
2128proc console_exec {w cmd {after {}}} {
2129 # -- Windows tosses the enviroment when we exec our child.
2130 # But most users need that so we have to relogin. :-(
2131 #
2132 if {[is_Windows]} {
2133 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2134 }
2135
2136 # -- Tcl won't let us redirect both stdout and stderr to
2137 # the same pipe. So pass it through cat...
2138 #
2139 set cmd [concat | $cmd |& cat]
2140
2141 set fd_f [open $cmd r]
2142 fconfigure $fd_f -blocking 0 -translation binary
2143 fileevent $fd_f readable [list console_read $w $fd_f $after]
2144}
2145
2146proc console_read {w fd after} {
2147 global console_cr console_data
2148
2149 set buf [read $fd]
2150 if {$buf ne {}} {
2151 if {![winfo exists $w]} {console_init $w}
2152 $w.m.t conf -state normal
2153 set c 0
2154 set n [string length $buf]
2155 while {$c < $n} {
2156 set cr [string first "\r" $buf $c]
2157 set lf [string first "\n" $buf $c]
2158 if {$cr < 0} {set cr [expr {$n + 1}]}
2159 if {$lf < 0} {set lf [expr {$n + 1}]}
2160
2161 if {$lf < $cr} {
2162 $w.m.t insert end [string range $buf $c $lf]
2163 set console_cr($w) [$w.m.t index {end -1c}]
2164 set c $lf
2165 incr c
2166 } else {
2167 $w.m.t delete $console_cr($w) end
2168 $w.m.t insert end "\n"
2169 $w.m.t insert end [string range $buf $c $cr]
2170 set c $cr
2171 incr c
2172 }
2173 }
2174 $w.m.t conf -state disabled
2175 $w.m.t see end
2176 }
2177
2178 fconfigure $fd -blocking 1
2179 if {[eof $fd]} {
2180 if {[catch {close $fd}]} {
2181 if {![winfo exists $w]} {console_init $w}
2182 $w.m.s conf -background red -text {Error: Command Failed}
2183 $w.ok conf -state normal
2184 set ok 0
2185 } elseif {[winfo exists $w]} {
2186 $w.m.s conf -background green -text {Success}
2187 $w.ok conf -state normal
2188 set ok 1
2189 }
2190 array unset console_cr $w
2191 array unset console_data $w
2192 if {$after ne {}} {
2193 uplevel #0 $after $ok
2194 }
2195 return
2196 }
2197 fconfigure $fd -blocking 0
2198}
2199
2200######################################################################
2201##
2202## ui commands
2203
2204set starting_gitk_msg {Please wait... Starting gitk...}
2205
2206proc do_gitk {revs} {
2207 global ui_status_value starting_gitk_msg
2208
2209 set cmd gitk
2210 if {$revs ne {}} {
2211 append cmd { }
2212 append cmd $revs
2213 }
2214 if {[is_Windows]} {
2215 set cmd "sh -c \"exec $cmd\""
2216 }
2217 append cmd { &}
2218
2219 if {[catch {eval exec $cmd} err]} {
2220 error_popup "Failed to start gitk:\n\n$err"
2221 } else {
2222 set ui_status_value $starting_gitk_msg
2223 after 10000 {
2224 if {$ui_status_value eq $starting_gitk_msg} {
2225 set ui_status_value {Ready.}
2226 }
2227 }
2228 }
2229}
2230
2231proc do_gc {} {
2232 set w [new_console {gc} {Compressing the object database}]
2233 console_exec $w {git gc}
2234}
2235
2236proc do_fsck_objects {} {
2237 set w [new_console {fsck-objects} \
2238 {Verifying the object database with fsck-objects}]
2239 set cmd [list git fsck-objects]
2240 lappend cmd --full
2241 lappend cmd --cache
2242 lappend cmd --strict
2243 console_exec $w $cmd
2244}
2245
2246set is_quitting 0
2247
2248proc do_quit {} {
2249 global gitdir ui_comm is_quitting repo_config commit_type
2250
2251 if {$is_quitting} return
2252 set is_quitting 1
2253
2254 # -- Stash our current commit buffer.
2255 #
2256 set save [file join $gitdir GITGUI_MSG]
2257 set msg [string trim [$ui_comm get 0.0 end]]
2258 if {![string match amend* $commit_type]
2259 && [$ui_comm edit modified]
2260 && $msg ne {}} {
2261 catch {
2262 set fd [open $save w]
2263 puts $fd [string trim [$ui_comm get 0.0 end]]
2264 close $fd
2265 }
2266 } else {
2267 catch {file delete $save}
2268 }
2269
2270 # -- Stash our current window geometry into this repository.
2271 #
2272 set cfg_geometry [list]
2273 lappend cfg_geometry [wm geometry .]
2274 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2275 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2276 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2277 set rc_geometry {}
2278 }
2279 if {$cfg_geometry ne $rc_geometry} {
2280 catch {exec git repo-config gui.geometry $cfg_geometry}
2281 }
2282
2283 destroy .
2284}
2285
2286proc do_rescan {} {
2287 rescan {set ui_status_value {Ready.}}
2288}
2289
2290proc remove_helper {txt paths} {
2291 global file_states current_diff
2292
2293 if {![lock_index begin-update]} return
2294
2295 set pathList [list]
2296 set after {}
2297 foreach path $paths {
2298 switch -glob -- [lindex $file_states($path) 0] {
2299 A? -
2300 M? -
2301 D? {
2302 lappend pathList $path
2303 if {$path eq $current_diff} {
2304 set after {reshow_diff;}
2305 }
2306 }
2307 }
2308 }
2309 if {$pathList eq {}} {
2310 unlock_index
2311 } else {
2312 update_indexinfo \
2313 $txt \
2314 $pathList \
2315 [concat $after {set ui_status_value {Ready.}}]
2316 }
2317}
2318
2319proc do_remove_selection {} {
2320 global current_diff selected_paths
2321
2322 if {[array size selected_paths] > 0} {
2323 remove_helper \
2324 {Removing selected files from commit} \
2325 [array names selected_paths]
2326 } elseif {$current_diff ne {}} {
2327 remove_helper \
2328 "Removing [short_path $current_diff] from commit" \
2329 [list $current_diff]
2330 }
2331}
2332
2333proc include_helper {txt paths} {
2334 global file_states current_diff
2335
2336 if {![lock_index begin-update]} return
2337
2338 set pathList [list]
2339 set after {}
2340 foreach path $paths {
2341 switch -glob -- [lindex $file_states($path) 0] {
2342 AM -
2343 AD -
2344 MM -
2345 MD -
2346 U? -
2347 _M -
2348 _D -
2349 _O {
2350 lappend pathList $path
2351 if {$path eq $current_diff} {
2352 set after {reshow_diff;}
2353 }
2354 }
2355 }
2356 }
2357 if {$pathList eq {}} {
2358 unlock_index
2359 } else {
2360 update_index \
2361 $txt \
2362 $pathList \
2363 [concat $after {set ui_status_value {Ready to commit.}}]
2364 }
2365}
2366
2367proc do_include_selection {} {
2368 global current_diff selected_paths
2369
2370 if {[array size selected_paths] > 0} {
2371 include_helper \
2372 {Adding selected files} \
2373 [array names selected_paths]
2374 } elseif {$current_diff ne {}} {
2375 include_helper \
2376 "Adding [short_path $current_diff]" \
2377 [list $current_diff]
2378 }
2379}
2380
2381proc do_include_all {} {
2382 global file_states
2383
2384 set paths [list]
2385 foreach path [array names file_states] {
2386 switch -- [lindex $file_states($path) 0] {
2387 AM -
2388 AD -
2389 MM -
2390 MD -
2391 _M -
2392 _D {lappend paths $path}
2393 }
2394 }
2395 include_helper \
2396 {Adding all modified files} \
2397 $paths
2398}
2399
2400proc revert_helper {txt paths} {
2401 global gitdir appname
2402 global file_states current_diff
2403
2404 if {![lock_index begin-update]} return
2405
2406 set pathList [list]
2407 set after {}
2408 foreach path $paths {
2409 switch -glob -- [lindex $file_states($path) 0] {
2410 AM -
2411 AD -
2412 MM -
2413 MD -
2414 _M -
2415 _D {
2416 lappend pathList $path
2417 if {$path eq $current_diff} {
2418 set after {reshow_diff;}
2419 }
2420 }
2421 }
2422 }
2423
2424 set n [llength $pathList]
2425 if {$n == 0} {
2426 unlock_index
2427 return
2428 } elseif {$n == 1} {
2429 set s "[short_path [lindex $pathList]]"
2430 } else {
2431 set s "these $n files"
2432 }
2433
2434 set reponame [lindex [file split \
2435 [file normalize [file dirname $gitdir]]] \
2436 end]
2437
2438 set reply [tk_dialog \
2439 .confirm_revert \
2440 "$appname ($reponame)" \
2441 "Revert changes in $s?
2442
2443Any unadded changes will be permanently lost by the revert." \
2444 question \
2445 1 \
2446 {Do Nothing} \
2447 {Revert Changes} \
2448 ]
2449 if {$reply == 1} {
2450 checkout_index \
2451 $txt \
2452 $pathList \
2453 [concat $after {set ui_status_value {Ready.}}]
2454 } else {
2455 unlock_index
2456 }
2457}
2458
2459proc do_revert_selection {} {
2460 global current_diff selected_paths
2461
2462 if {[array size selected_paths] > 0} {
2463 revert_helper \
2464 {Reverting selected files} \
2465 [array names selected_paths]
2466 } elseif {$current_diff ne {}} {
2467 revert_helper \
2468 "Reverting [short_path $current_diff]" \
2469 [list $current_diff]
2470 }
2471}
2472
2473proc do_signoff {} {
2474 global ui_comm
2475
2476 set me [committer_ident]
2477 if {$me eq {}} return
2478
2479 set sob "Signed-off-by: $me"
2480 set last [$ui_comm get {end -1c linestart} {end -1c}]
2481 if {$last ne $sob} {
2482 $ui_comm edit separator
2483 if {$last ne {}
2484 && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2485 $ui_comm insert end "\n"
2486 }
2487 $ui_comm insert end "\n$sob"
2488 $ui_comm edit separator
2489 $ui_comm see end
2490 }
2491}
2492
2493proc do_select_commit_type {} {
2494 global commit_type selected_commit_type
2495
2496 if {$selected_commit_type eq {new}
2497 && [string match amend* $commit_type]} {
2498 create_new_commit
2499 } elseif {$selected_commit_type eq {amend}
2500 && ![string match amend* $commit_type]} {
2501 load_last_commit
2502
2503 # The amend request was rejected...
2504 #
2505 if {![string match amend* $commit_type]} {
2506 set selected_commit_type new
2507 }
2508 }
2509}
2510
2511proc do_commit {} {
2512 commit_tree
2513}
2514
2515proc do_about {} {
2516 global appname appvers copyright
2517 global tcl_patchLevel tk_patchLevel
2518
2519 set w .about_dialog
2520 toplevel $w
2521 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2522
2523 label $w.header -text "About $appname" \
2524 -font font_uibold
2525 pack $w.header -side top -fill x
2526
2527 frame $w.buttons
2528 button $w.buttons.close -text {Close} \
2529 -font font_ui \
2530 -command [list destroy $w]
2531 pack $w.buttons.close -side right
2532 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2533
2534 label $w.desc \
2535 -text "$appname - a commit creation tool for Git.
2536$copyright" \
2537 -padx 5 -pady 5 \
2538 -justify left \
2539 -anchor w \
2540 -borderwidth 1 \
2541 -relief solid \
2542 -font font_ui
2543 pack $w.desc -side top -fill x -padx 5 -pady 5
2544
2545 set v {}
2546 append v "$appname version $appvers\n\n"
2547 append v "[exec git --version]\n\n"
2548 if {$tcl_patchLevel eq $tk_patchLevel} {
2549 append v "Tcl/Tk version $tcl_patchLevel"
2550 } else {
2551 append v "Tcl version $tcl_patchLevel"
2552 append v ", Tk version $tk_patchLevel"
2553 }
2554
2555 label $w.vers \
2556 -text $v \
2557 -padx 5 -pady 5 \
2558 -justify left \
2559 -anchor w \
2560 -borderwidth 1 \
2561 -relief solid \
2562 -font font_ui
2563 pack $w.vers -side top -fill x -padx 5 -pady 5
2564
2565 bind $w <Visibility> "grab $w; focus $w"
2566 bind $w <Key-Escape> "destroy $w"
2567 wm title $w "About $appname"
2568 tkwait window $w
2569}
2570
2571proc do_options {} {
2572 global appname gitdir font_descs
2573 global repo_config global_config
2574 global repo_config_new global_config_new
2575
2576 array unset repo_config_new
2577 array unset global_config_new
2578 foreach name [array names repo_config] {
2579 set repo_config_new($name) $repo_config($name)
2580 }
2581 load_config 1
2582 foreach name [array names repo_config] {
2583 switch -- $name {
2584 gui.diffcontext {continue}
2585 }
2586 set repo_config_new($name) $repo_config($name)
2587 }
2588 foreach name [array names global_config] {
2589 set global_config_new($name) $global_config($name)
2590 }
2591 set reponame [lindex [file split \
2592 [file normalize [file dirname $gitdir]]] \
2593 end]
2594
2595 set w .options_editor
2596 toplevel $w
2597 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2598
2599 label $w.header -text "$appname Options" \
2600 -font font_uibold
2601 pack $w.header -side top -fill x
2602
2603 frame $w.buttons
2604 button $w.buttons.restore -text {Restore Defaults} \
2605 -font font_ui \
2606 -command do_restore_defaults
2607 pack $w.buttons.restore -side left
2608 button $w.buttons.save -text Save \
2609 -font font_ui \
2610 -command [list do_save_config $w]
2611 pack $w.buttons.save -side right
2612 button $w.buttons.cancel -text {Cancel} \
2613 -font font_ui \
2614 -command [list destroy $w]
2615 pack $w.buttons.cancel -side right
2616 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2617
2618 labelframe $w.repo -text "$reponame Repository" \
2619 -font font_ui \
2620 -relief raised -borderwidth 2
2621 labelframe $w.global -text {Global (All Repositories)} \
2622 -font font_ui \
2623 -relief raised -borderwidth 2
2624 pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2625 pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2626
2627 foreach option {
2628 {b partialinclude {Allow Partially Added Files}}
2629 {b pullsummary {Show Pull Summary}}
2630 {b trustmtime {Trust File Modification Timestamps}}
2631 {i diffcontext {Number of Diff Context Lines}}
2632 } {
2633 set type [lindex $option 0]
2634 set name [lindex $option 1]
2635 set text [lindex $option 2]
2636 foreach f {repo global} {
2637 switch $type {
2638 b {
2639 checkbutton $w.$f.$name -text $text \
2640 -variable ${f}_config_new(gui.$name) \
2641 -onvalue true \
2642 -offvalue false \
2643 -font font_ui
2644 pack $w.$f.$name -side top -anchor w
2645 }
2646 i {
2647 frame $w.$f.$name
2648 label $w.$f.$name.l -text "$text:" -font font_ui
2649 pack $w.$f.$name.l -side left -anchor w -fill x
2650 spinbox $w.$f.$name.v \
2651 -textvariable ${f}_config_new(gui.$name) \
2652 -from 1 -to 99 -increment 1 \
2653 -width 3 \
2654 -font font_ui
2655 pack $w.$f.$name.v -side right -anchor e
2656 pack $w.$f.$name -side top -anchor w -fill x
2657 }
2658 }
2659 }
2660 }
2661
2662 set all_fonts [lsort [font families]]
2663 foreach option $font_descs {
2664 set name [lindex $option 0]
2665 set font [lindex $option 1]
2666 set text [lindex $option 2]
2667
2668 set global_config_new(gui.$font^^family) \
2669 [font configure $font -family]
2670 set global_config_new(gui.$font^^size) \
2671 [font configure $font -size]
2672
2673 frame $w.global.$name
2674 label $w.global.$name.l -text "$text:" -font font_ui
2675 pack $w.global.$name.l -side left -anchor w -fill x
2676 eval tk_optionMenu $w.global.$name.family \
2677 global_config_new(gui.$font^^family) \
2678 $all_fonts
2679 spinbox $w.global.$name.size \
2680 -textvariable global_config_new(gui.$font^^size) \
2681 -from 2 -to 80 -increment 1 \
2682 -width 3 \
2683 -font font_ui
2684 pack $w.global.$name.size -side right -anchor e
2685 pack $w.global.$name.family -side right -anchor e
2686 pack $w.global.$name -side top -anchor w -fill x
2687 }
2688
2689 bind $w <Visibility> "grab $w; focus $w"
2690 bind $w <Key-Escape> "destroy $w"
2691 wm title $w "$appname ($reponame): Options"
2692 tkwait window $w
2693}
2694
2695proc do_restore_defaults {} {
2696 global font_descs default_config repo_config
2697 global repo_config_new global_config_new
2698
2699 foreach name [array names default_config] {
2700 set repo_config_new($name) $default_config($name)
2701 set global_config_new($name) $default_config($name)
2702 }
2703
2704 foreach option $font_descs {
2705 set name [lindex $option 0]
2706 set repo_config(gui.$name) $default_config(gui.$name)
2707 }
2708 apply_config
2709
2710 foreach option $font_descs {
2711 set name [lindex $option 0]
2712 set font [lindex $option 1]
2713 set global_config_new(gui.$font^^family) \
2714 [font configure $font -family]
2715 set global_config_new(gui.$font^^size) \
2716 [font configure $font -size]
2717 }
2718}
2719
2720proc do_save_config {w} {
2721 if {[catch {save_config} err]} {
2722 error_popup "Failed to completely save options:\n\n$err"
2723 }
2724 reshow_diff
2725 destroy $w
2726}
2727
2728proc do_windows_shortcut {} {
2729 global gitdir appname argv0
2730
2731 set reponame [lindex [file split \
2732 [file normalize [file dirname $gitdir]]] \
2733 end]
2734
2735 if {[catch {
2736 set desktop [exec cygpath \
2737 --windows \
2738 --absolute \
2739 --long-name \
2740 --desktop]
2741 }]} {
2742 set desktop .
2743 }
2744 set fn [tk_getSaveFile \
2745 -parent . \
2746 -title "$appname ($reponame): Create Desktop Icon" \
2747 -initialdir $desktop \
2748 -initialfile "Git $reponame.bat"]
2749 if {$fn != {}} {
2750 if {[catch {
2751 set fd [open $fn w]
2752 set sh [exec cygpath \
2753 --windows \
2754 --absolute \
2755 /bin/sh]
2756 set me [exec cygpath \
2757 --unix \
2758 --absolute \
2759 $argv0]
2760 set gd [exec cygpath \
2761 --unix \
2762 --absolute \
2763 $gitdir]
2764 regsub -all ' $me "'\\''" me
2765 regsub -all ' $gd "'\\''" gd
2766 puts $fd "@ECHO Starting git-gui... Please wait..."
2767 puts -nonewline $fd "@\"$sh\" --login -c \""
2768 puts -nonewline $fd "GIT_DIR='$gd'"
2769 puts -nonewline $fd " '$me'"
2770 puts $fd "&\""
2771 close $fd
2772 } err]} {
2773 error_popup "Cannot write script:\n\n$err"
2774 }
2775 }
2776}
2777
2778proc do_macosx_app {} {
2779 global gitdir appname argv0 env
2780
2781 set reponame [lindex [file split \
2782 [file normalize [file dirname $gitdir]]] \
2783 end]
2784
2785 set fn [tk_getSaveFile \
2786 -parent . \
2787 -title "$appname ($reponame): Create Desktop Icon" \
2788 -initialdir [file join $env(HOME) Desktop] \
2789 -initialfile "Git $reponame.app"]
2790 if {$fn != {}} {
2791 if {[catch {
2792 set Contents [file join $fn Contents]
2793 set MacOS [file join $Contents MacOS]
2794 set exe [file join $MacOS git-gui]
2795
2796 file mkdir $MacOS
2797
2798 set fd [open [file join $Contents Info.plist] w]
2799 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2800<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2801<plist version="1.0">
2802<dict>
2803 <key>CFBundleDevelopmentRegion</key>
2804 <string>English</string>
2805 <key>CFBundleExecutable</key>
2806 <string>git-gui</string>
2807 <key>CFBundleIdentifier</key>
2808 <string>org.spearce.git-gui</string>
2809 <key>CFBundleInfoDictionaryVersion</key>
2810 <string>6.0</string>
2811 <key>CFBundlePackageType</key>
2812 <string>APPL</string>
2813 <key>CFBundleSignature</key>
2814 <string>????</string>
2815 <key>CFBundleVersion</key>
2816 <string>1.0</string>
2817 <key>NSPrincipalClass</key>
2818 <string>NSApplication</string>
2819</dict>
2820</plist>}
2821 close $fd
2822
2823 set fd [open $exe w]
2824 set gd [file normalize $gitdir]
2825 set ep [file normalize [exec git --exec-path]]
2826 regsub -all ' $gd "'\\''" gd
2827 regsub -all ' $ep "'\\''" ep
2828 puts $fd "#!/bin/sh"
2829 foreach name [array names env] {
2830 if {[string match GIT_* $name]} {
2831 regsub -all ' $env($name) "'\\''" v
2832 puts $fd "export $name='$v'"
2833 }
2834 }
2835 puts $fd "export PATH='$ep':\$PATH"
2836 puts $fd "export GIT_DIR='$gd'"
2837 puts $fd "exec [file normalize $argv0]"
2838 close $fd
2839
2840 file attributes $exe -permissions u+x,g+x,o+x
2841 } err]} {
2842 error_popup "Cannot write icon:\n\n$err"
2843 }
2844 }
2845}
2846
2847proc toggle_or_diff {w x y} {
2848 global file_states file_lists current_diff ui_index ui_other
2849 global last_clicked selected_paths
2850
2851 set pos [split [$w index @$x,$y] .]
2852 set lno [lindex $pos 0]
2853 set col [lindex $pos 1]
2854 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2855 if {$path eq {}} {
2856 set last_clicked {}
2857 return
2858 }
2859
2860 set last_clicked [list $w $lno]
2861 array unset selected_paths
2862 $ui_index tag remove in_sel 0.0 end
2863 $ui_other tag remove in_sel 0.0 end
2864
2865 if {$col == 0} {
2866 if {$current_diff eq $path} {
2867 set after {reshow_diff;}
2868 } else {
2869 set after {}
2870 }
2871 switch -glob -- [lindex $file_states($path) 0] {
2872 A_ -
2873 M_ -
2874 DD -
2875 DO -
2876 DM {
2877 update_indexinfo \
2878 "Removing [short_path $path] from commit" \
2879 [list $path] \
2880 [concat $after {set ui_status_value {Ready.}}]
2881 }
2882 ?? {
2883 update_index \
2884 "Adding [short_path $path]" \
2885 [list $path] \
2886 [concat $after {set ui_status_value {Ready.}}]
2887 }
2888 }
2889 } else {
2890 show_diff $path $w $lno
2891 }
2892}
2893
2894proc add_one_to_selection {w x y} {
2895 global file_lists
2896 global last_clicked selected_paths
2897
2898 set pos [split [$w index @$x,$y] .]
2899 set lno [lindex $pos 0]
2900 set col [lindex $pos 1]
2901 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2902 if {$path eq {}} {
2903 set last_clicked {}
2904 return
2905 }
2906
2907 set last_clicked [list $w $lno]
2908 if {[catch {set in_sel $selected_paths($path)}]} {
2909 set in_sel 0
2910 }
2911 if {$in_sel} {
2912 unset selected_paths($path)
2913 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2914 } else {
2915 set selected_paths($path) 1
2916 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2917 }
2918}
2919
2920proc add_range_to_selection {w x y} {
2921 global file_lists
2922 global last_clicked selected_paths
2923
2924 if {[lindex $last_clicked 0] ne $w} {
2925 toggle_or_diff $w $x $y
2926 return
2927 }
2928
2929 set pos [split [$w index @$x,$y] .]
2930 set lno [lindex $pos 0]
2931 set lc [lindex $last_clicked 1]
2932 if {$lc < $lno} {
2933 set begin $lc
2934 set end $lno
2935 } else {
2936 set begin $lno
2937 set end $lc
2938 }
2939
2940 foreach path [lrange $file_lists($w) \
2941 [expr {$begin - 1}] \
2942 [expr {$end - 1}]] {
2943 set selected_paths($path) 1
2944 }
2945 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2946}
2947
2948######################################################################
2949##
2950## config defaults
2951
2952set cursor_ptr arrow
2953font create font_diff -family Courier -size 10
2954font create font_ui
2955catch {
2956 label .dummy
2957 eval font configure font_ui [font actual [.dummy cget -font]]
2958 destroy .dummy
2959}
2960
2961font create font_uibold
2962font create font_diffbold
2963
2964if {[is_Windows]} {
2965 set M1B Control
2966 set M1T Ctrl
2967} elseif {[is_MacOSX]} {
2968 set M1B M1
2969 set M1T Cmd
2970} else {
2971 set M1B M1
2972 set M1T M1
2973}
2974
2975proc apply_config {} {
2976 global repo_config font_descs
2977
2978 foreach option $font_descs {
2979 set name [lindex $option 0]
2980 set font [lindex $option 1]
2981 if {[catch {
2982 foreach {cn cv} $repo_config(gui.$name) {
2983 font configure $font $cn $cv
2984 }
2985 } err]} {
2986 error_popup "Invalid font specified in gui.$name:\n\n$err"
2987 }
2988 foreach {cn cv} [font configure $font] {
2989 font configure ${font}bold $cn $cv
2990 }
2991 font configure ${font}bold -weight bold
2992 }
2993}
2994
2995set default_config(gui.trustmtime) false
2996set default_config(gui.pullsummary) true
2997set default_config(gui.partialinclude) false
2998set default_config(gui.diffcontext) 5
2999set default_config(gui.fontui) [font configure font_ui]
3000set default_config(gui.fontdiff) [font configure font_diff]
3001set font_descs {
3002 {fontui font_ui {Main Font}}
3003 {fontdiff font_diff {Diff/Console Font}}
3004}
3005load_config 0
3006apply_config
3007
3008######################################################################
3009##
3010## ui construction
3011
3012# -- Menu Bar
3013#
3014menu .mbar -tearoff 0
3015.mbar add cascade -label Repository -menu .mbar.repository
3016.mbar add cascade -label Edit -menu .mbar.edit
3017if {!$single_commit} {
3018 .mbar add cascade -label Branch -menu .mbar.branch
3019}
3020.mbar add cascade -label Commit -menu .mbar.commit
3021if {!$single_commit} {
3022 .mbar add cascade -label Fetch -menu .mbar.fetch
3023 .mbar add cascade -label Pull -menu .mbar.pull
3024 .mbar add cascade -label Push -menu .mbar.push
3025}
3026. configure -menu .mbar
3027
3028# -- Repository Menu
3029#
3030menu .mbar.repository
3031.mbar.repository add command \
3032 -label {Visualize Current Branch} \
3033 -command {do_gitk {}} \
3034 -font font_ui
3035if {![is_MacOSX]} {
3036 .mbar.repository add command \
3037 -label {Visualize All Branches} \
3038 -command {do_gitk {--all}} \
3039 -font font_ui
3040}
3041.mbar.repository add separator
3042
3043if {!$single_commit} {
3044 .mbar.repository add command -label {Compress Database} \
3045 -command do_gc \
3046 -font font_ui
3047
3048 .mbar.repository add command -label {Verify Database} \
3049 -command do_fsck_objects \
3050 -font font_ui
3051
3052 .mbar.repository add separator
3053
3054 if {[is_Windows]} {
3055 .mbar.repository add command \
3056 -label {Create Desktop Icon} \
3057 -command do_windows_shortcut \
3058 -font font_ui
3059 } elseif {[is_MacOSX]} {
3060 .mbar.repository add command \
3061 -label {Create Desktop Icon} \
3062 -command do_macosx_app \
3063 -font font_ui
3064 }
3065}
3066
3067.mbar.repository add command -label Quit \
3068 -command do_quit \
3069 -accelerator $M1T-Q \
3070 -font font_ui
3071
3072# -- Edit Menu
3073#
3074menu .mbar.edit
3075.mbar.edit add command -label Undo \
3076 -command {catch {[focus] edit undo}} \
3077 -accelerator $M1T-Z \
3078 -font font_ui
3079.mbar.edit add command -label Redo \
3080 -command {catch {[focus] edit redo}} \
3081 -accelerator $M1T-Y \
3082 -font font_ui
3083.mbar.edit add separator
3084.mbar.edit add command -label Cut \
3085 -command {catch {tk_textCut [focus]}} \
3086 -accelerator $M1T-X \
3087 -font font_ui
3088.mbar.edit add command -label Copy \
3089 -command {catch {tk_textCopy [focus]}} \
3090 -accelerator $M1T-C \
3091 -font font_ui
3092.mbar.edit add command -label Paste \
3093 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3094 -accelerator $M1T-V \
3095 -font font_ui
3096.mbar.edit add command -label Delete \
3097 -command {catch {[focus] delete sel.first sel.last}} \
3098 -accelerator Del \
3099 -font font_ui
3100.mbar.edit add separator
3101.mbar.edit add command -label {Select All} \
3102 -command {catch {[focus] tag add sel 0.0 end}} \
3103 -accelerator $M1T-A \
3104 -font font_ui
3105
3106# -- Branch Menu
3107#
3108if {!$single_commit} {
3109 menu .mbar.branch
3110
3111 .mbar.branch add command -label {Create...} \
3112 -command do_create_branch \
3113 -font font_ui
3114 lappend disable_on_lock [list .mbar.branch entryconf \
3115 [.mbar.branch index last] -state]
3116
3117 .mbar.branch add command -label {Delete...} \
3118 -command do_delete_branch \
3119 -font font_ui
3120 lappend disable_on_lock [list .mbar.branch entryconf \
3121 [.mbar.branch index last] -state]
3122}
3123
3124# -- Commit Menu
3125#
3126menu .mbar.commit
3127
3128.mbar.commit add radiobutton \
3129 -label {New Commit} \
3130 -command do_select_commit_type \
3131 -variable selected_commit_type \
3132 -value new \
3133 -font font_ui
3134lappend disable_on_lock \
3135 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3136
3137.mbar.commit add radiobutton \
3138 -label {Amend Last Commit} \
3139 -command do_select_commit_type \
3140 -variable selected_commit_type \
3141 -value amend \
3142 -font font_ui
3143lappend disable_on_lock \
3144 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3145
3146.mbar.commit add separator
3147
3148.mbar.commit add command -label Rescan \
3149 -command do_rescan \
3150 -accelerator F5 \
3151 -font font_ui
3152lappend disable_on_lock \
3153 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3154
3155.mbar.commit add command -label {Add To Commit} \
3156 -command do_include_selection \
3157 -font font_ui
3158lappend disable_on_lock \
3159 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3160
3161.mbar.commit add command -label {Add All To Commit} \
3162 -command do_include_all \
3163 -accelerator $M1T-I \
3164 -font font_ui
3165lappend disable_on_lock \
3166 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3167
3168.mbar.commit add command -label {Remove From Commit} \
3169 -command do_remove_selection \
3170 -font font_ui
3171lappend disable_on_lock \
3172 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3173
3174.mbar.commit add command -label {Revert Changes} \
3175 -command do_revert_selection \
3176 -font font_ui
3177lappend disable_on_lock \
3178 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3179
3180.mbar.commit add separator
3181
3182.mbar.commit add command -label {Sign Off} \
3183 -command do_signoff \
3184 -accelerator $M1T-S \
3185 -font font_ui
3186
3187.mbar.commit add command -label Commit \
3188 -command do_commit \
3189 -accelerator $M1T-Return \
3190 -font font_ui
3191lappend disable_on_lock \
3192 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3193
3194# -- Transport menus
3195#
3196if {!$single_commit} {
3197 menu .mbar.fetch
3198 menu .mbar.pull
3199 menu .mbar.push
3200}
3201
3202if {[is_MacOSX]} {
3203 # -- Apple Menu (Mac OS X only)
3204 #
3205 .mbar add cascade -label Apple -menu .mbar.apple
3206 menu .mbar.apple
3207
3208 .mbar.apple add command -label "About $appname" \
3209 -command do_about \
3210 -font font_ui
3211 .mbar.apple add command -label "$appname Options..." \
3212 -command do_options \
3213 -font font_ui
3214} else {
3215 # -- Edit Menu
3216 #
3217 .mbar.edit add separator
3218 .mbar.edit add command -label {Options...} \
3219 -command do_options \
3220 -font font_ui
3221
3222 # -- Tools Menu
3223 #
3224 if {[file exists /usr/local/miga/lib/gui-miga]} {
3225 proc do_miga {} {
3226 global gitdir ui_status_value
3227 if {![lock_index update]} return
3228 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3229 set miga_fd [open "|$cmd" r]
3230 fconfigure $miga_fd -blocking 0
3231 fileevent $miga_fd readable [list miga_done $miga_fd]
3232 set ui_status_value {Running miga...}
3233 }
3234 proc miga_done {fd} {
3235 read $fd 512
3236 if {[eof $fd]} {
3237 close $fd
3238 unlock_index
3239 rescan [list set ui_status_value {Ready.}]
3240 }
3241 }
3242 .mbar add cascade -label Tools -menu .mbar.tools
3243 menu .mbar.tools
3244 .mbar.tools add command -label "Migrate" \
3245 -command do_miga \
3246 -font font_ui
3247 lappend disable_on_lock \
3248 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3249 }
3250
3251 # -- Help Menu
3252 #
3253 .mbar add cascade -label Help -menu .mbar.help
3254 menu .mbar.help
3255
3256 .mbar.help add command -label "About $appname" \
3257 -command do_about \
3258 -font font_ui
3259}
3260
3261
3262# -- Branch Control
3263#
3264frame .branch \
3265 -borderwidth 1 \
3266 -relief sunken
3267label .branch.l1 \
3268 -text {Current Branch:} \
3269 -anchor w \
3270 -justify left \
3271 -font font_ui
3272label .branch.cb \
3273 -textvariable current_branch \
3274 -anchor w \
3275 -justify left \
3276 -font font_ui
3277pack .branch.l1 -side left
3278pack .branch.cb -side left -fill x
3279pack .branch -side top -fill x
3280
3281# -- Main Window Layout
3282#
3283panedwindow .vpane -orient vertical
3284panedwindow .vpane.files -orient horizontal
3285.vpane add .vpane.files -sticky nsew -height 100 -width 400
3286pack .vpane -anchor n -side top -fill both -expand 1
3287
3288# -- Index File List
3289#
3290frame .vpane.files.index -height 100 -width 400
3291label .vpane.files.index.title -text {Modified Files} \
3292 -background green \
3293 -font font_ui
3294text $ui_index -background white -borderwidth 0 \
3295 -width 40 -height 10 \
3296 -font font_ui \
3297 -cursor $cursor_ptr \
3298 -yscrollcommand {.vpane.files.index.sb set} \
3299 -state disabled
3300scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3301pack .vpane.files.index.title -side top -fill x
3302pack .vpane.files.index.sb -side right -fill y
3303pack $ui_index -side left -fill both -expand 1
3304.vpane.files add .vpane.files.index -sticky nsew
3305
3306# -- Other (Add) File List
3307#
3308frame .vpane.files.other -height 100 -width 100
3309label .vpane.files.other.title -text {Untracked Files} \
3310 -background red \
3311 -font font_ui
3312text $ui_other -background white -borderwidth 0 \
3313 -width 40 -height 10 \
3314 -font font_ui \
3315 -cursor $cursor_ptr \
3316 -yscrollcommand {.vpane.files.other.sb set} \
3317 -state disabled
3318scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3319pack .vpane.files.other.title -side top -fill x
3320pack .vpane.files.other.sb -side right -fill y
3321pack $ui_other -side left -fill both -expand 1
3322.vpane.files add .vpane.files.other -sticky nsew
3323
3324foreach i [list $ui_index $ui_other] {
3325 $i tag conf in_diff -font font_uibold
3326 $i tag conf in_sel \
3327 -background [$i cget -foreground] \
3328 -foreground [$i cget -background]
3329}
3330unset i
3331
3332# -- Diff and Commit Area
3333#
3334frame .vpane.lower -height 300 -width 400
3335frame .vpane.lower.commarea
3336frame .vpane.lower.diff -relief sunken -borderwidth 1
3337pack .vpane.lower.commarea -side top -fill x
3338pack .vpane.lower.diff -side bottom -fill both -expand 1
3339.vpane add .vpane.lower -stick nsew
3340
3341# -- Commit Area Buttons
3342#
3343frame .vpane.lower.commarea.buttons
3344label .vpane.lower.commarea.buttons.l -text {} \
3345 -anchor w \
3346 -justify left \
3347 -font font_ui
3348pack .vpane.lower.commarea.buttons.l -side top -fill x
3349pack .vpane.lower.commarea.buttons -side left -fill y
3350
3351button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3352 -command do_rescan \
3353 -font font_ui
3354pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3355lappend disable_on_lock \
3356 {.vpane.lower.commarea.buttons.rescan conf -state}
3357
3358button .vpane.lower.commarea.buttons.incall -text {Add All} \
3359 -command do_include_all \
3360 -font font_ui
3361pack .vpane.lower.commarea.buttons.incall -side top -fill x
3362lappend disable_on_lock \
3363 {.vpane.lower.commarea.buttons.incall conf -state}
3364
3365button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3366 -command do_signoff \
3367 -font font_ui
3368pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3369
3370button .vpane.lower.commarea.buttons.commit -text {Commit} \
3371 -command do_commit \
3372 -font font_ui
3373pack .vpane.lower.commarea.buttons.commit -side top -fill x
3374lappend disable_on_lock \
3375 {.vpane.lower.commarea.buttons.commit conf -state}
3376
3377# -- Commit Message Buffer
3378#
3379frame .vpane.lower.commarea.buffer
3380frame .vpane.lower.commarea.buffer.header
3381set ui_comm .vpane.lower.commarea.buffer.t
3382set ui_coml .vpane.lower.commarea.buffer.header.l
3383radiobutton .vpane.lower.commarea.buffer.header.new \
3384 -text {New Commit} \
3385 -command do_select_commit_type \
3386 -variable selected_commit_type \
3387 -value new \
3388 -font font_ui
3389lappend disable_on_lock \
3390 [list .vpane.lower.commarea.buffer.header.new conf -state]
3391radiobutton .vpane.lower.commarea.buffer.header.amend \
3392 -text {Amend Last Commit} \
3393 -command do_select_commit_type \
3394 -variable selected_commit_type \
3395 -value amend \
3396 -font font_ui
3397lappend disable_on_lock \
3398 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3399label $ui_coml \
3400 -anchor w \
3401 -justify left \
3402 -font font_ui
3403proc trace_commit_type {varname args} {
3404 global ui_coml commit_type
3405 switch -glob -- $commit_type {
3406 initial {set txt {Initial Commit Message:}}
3407 amend {set txt {Amended Commit Message:}}
3408 amend-initial {set txt {Amended Initial Commit Message:}}
3409 amend-merge {set txt {Amended Merge Commit Message:}}
3410 merge {set txt {Merge Commit Message:}}
3411 * {set txt {Commit Message:}}
3412 }
3413 $ui_coml conf -text $txt
3414}
3415trace add variable commit_type write trace_commit_type
3416pack $ui_coml -side left -fill x
3417pack .vpane.lower.commarea.buffer.header.amend -side right
3418pack .vpane.lower.commarea.buffer.header.new -side right
3419
3420text $ui_comm -background white -borderwidth 1 \
3421 -undo true \
3422 -maxundo 20 \
3423 -autoseparators true \
3424 -relief sunken \
3425 -width 75 -height 9 -wrap none \
3426 -font font_diff \
3427 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3428scrollbar .vpane.lower.commarea.buffer.sby \
3429 -command [list $ui_comm yview]
3430pack .vpane.lower.commarea.buffer.header -side top -fill x
3431pack .vpane.lower.commarea.buffer.sby -side right -fill y
3432pack $ui_comm -side left -fill y
3433pack .vpane.lower.commarea.buffer -side left -fill y
3434
3435# -- Commit Message Buffer Context Menu
3436#
3437set ctxm .vpane.lower.commarea.buffer.ctxm
3438menu $ctxm -tearoff 0
3439$ctxm add command \
3440 -label {Cut} \
3441 -font font_ui \
3442 -command {tk_textCut $ui_comm}
3443$ctxm add command \
3444 -label {Copy} \
3445 -font font_ui \
3446 -command {tk_textCopy $ui_comm}
3447$ctxm add command \
3448 -label {Paste} \
3449 -font font_ui \
3450 -command {tk_textPaste $ui_comm}
3451$ctxm add command \
3452 -label {Delete} \
3453 -font font_ui \
3454 -command {$ui_comm delete sel.first sel.last}
3455$ctxm add separator
3456$ctxm add command \
3457 -label {Select All} \
3458 -font font_ui \
3459 -command {$ui_comm tag add sel 0.0 end}
3460$ctxm add command \
3461 -label {Copy All} \
3462 -font font_ui \
3463 -command {
3464 $ui_comm tag add sel 0.0 end
3465 tk_textCopy $ui_comm
3466 $ui_comm tag remove sel 0.0 end
3467 }
3468$ctxm add separator
3469$ctxm add command \
3470 -label {Sign Off} \
3471 -font font_ui \
3472 -command do_signoff
3473bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3474
3475# -- Diff Header
3476#
3477set current_diff {}
3478set diff_actions [list]
3479proc trace_current_diff {varname args} {
3480 global current_diff diff_actions file_states
3481 if {$current_diff eq {}} {
3482 set s {}
3483 set f {}
3484 set p {}
3485 set o disabled
3486 } else {
3487 set p $current_diff
3488 set s [mapdesc [lindex $file_states($p) 0] $p]
3489 set f {File:}
3490 set p [escape_path $p]
3491 set o normal
3492 }
3493
3494 .vpane.lower.diff.header.status configure -text $s
3495 .vpane.lower.diff.header.file configure -text $f
3496 .vpane.lower.diff.header.path configure -text $p
3497 foreach w $diff_actions {
3498 uplevel #0 $w $o
3499 }
3500}
3501trace add variable current_diff write trace_current_diff
3502
3503frame .vpane.lower.diff.header -background orange
3504label .vpane.lower.diff.header.status \
3505 -background orange \
3506 -width $max_status_desc \
3507 -anchor w \
3508 -justify left \
3509 -font font_ui
3510label .vpane.lower.diff.header.file \
3511 -background orange \
3512 -anchor w \
3513 -justify left \
3514 -font font_ui
3515label .vpane.lower.diff.header.path \
3516 -background orange \
3517 -anchor w \
3518 -justify left \
3519 -font font_ui
3520pack .vpane.lower.diff.header.status -side left
3521pack .vpane.lower.diff.header.file -side left
3522pack .vpane.lower.diff.header.path -fill x
3523set ctxm .vpane.lower.diff.header.ctxm
3524menu $ctxm -tearoff 0
3525$ctxm add command \
3526 -label {Copy} \
3527 -font font_ui \
3528 -command {
3529 clipboard clear
3530 clipboard append \
3531 -format STRING \
3532 -type STRING \
3533 -- $current_diff
3534 }
3535lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3536bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3537
3538# -- Diff Body
3539#
3540frame .vpane.lower.diff.body
3541set ui_diff .vpane.lower.diff.body.t
3542text $ui_diff -background white -borderwidth 0 \
3543 -width 80 -height 15 -wrap none \
3544 -font font_diff \
3545 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3546 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3547 -state disabled
3548scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3549 -command [list $ui_diff xview]
3550scrollbar .vpane.lower.diff.body.sby -orient vertical \
3551 -command [list $ui_diff yview]
3552pack .vpane.lower.diff.body.sbx -side bottom -fill x
3553pack .vpane.lower.diff.body.sby -side right -fill y
3554pack $ui_diff -side left -fill both -expand 1
3555pack .vpane.lower.diff.header -side top -fill x
3556pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3557
3558$ui_diff tag conf d_@ -font font_diffbold
3559$ui_diff tag conf d_+ -foreground blue
3560$ui_diff tag conf d_- -foreground red
3561$ui_diff tag conf d_++ -foreground {#00a000}
3562$ui_diff tag conf d_-- -foreground {#a000a0}
3563$ui_diff tag conf d_+- \
3564 -foreground red \
3565 -background {light goldenrod yellow}
3566$ui_diff tag conf d_-+ \
3567 -foreground blue \
3568 -background azure2
3569
3570# -- Diff Body Context Menu
3571#
3572set ctxm .vpane.lower.diff.body.ctxm
3573menu $ctxm -tearoff 0
3574$ctxm add command \
3575 -label {Copy} \
3576 -font font_ui \
3577 -command {tk_textCopy $ui_diff}
3578lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3579$ctxm add command \
3580 -label {Select All} \
3581 -font font_ui \
3582 -command {$ui_diff tag add sel 0.0 end}
3583lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3584$ctxm add command \
3585 -label {Copy All} \
3586 -font font_ui \
3587 -command {
3588 $ui_diff tag add sel 0.0 end
3589 tk_textCopy $ui_diff
3590 $ui_diff tag remove sel 0.0 end
3591 }
3592lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3593$ctxm add separator
3594$ctxm add command \
3595 -label {Decrease Font Size} \
3596 -font font_ui \
3597 -command {incr_font_size font_diff -1}
3598lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3599$ctxm add command \
3600 -label {Increase Font Size} \
3601 -font font_ui \
3602 -command {incr_font_size font_diff 1}
3603lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3604$ctxm add separator
3605$ctxm add command \
3606 -label {Show Less Context} \
3607 -font font_ui \
3608 -command {if {$repo_config(gui.diffcontext) >= 2} {
3609 incr repo_config(gui.diffcontext) -1
3610 reshow_diff
3611 }}
3612lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3613$ctxm add command \
3614 -label {Show More Context} \
3615 -font font_ui \
3616 -command {
3617 incr repo_config(gui.diffcontext)
3618 reshow_diff
3619 }
3620lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3621$ctxm add separator
3622$ctxm add command -label {Options...} \
3623 -font font_ui \
3624 -command do_options
3625bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3626
3627# -- Status Bar
3628#
3629set ui_status_value {Initializing...}
3630label .status -textvariable ui_status_value \
3631 -anchor w \
3632 -justify left \
3633 -borderwidth 1 \
3634 -relief sunken \
3635 -font font_ui
3636pack .status -anchor w -side bottom -fill x
3637
3638# -- Load geometry
3639#
3640catch {
3641set gm $repo_config(gui.geometry)
3642wm geometry . [lindex $gm 0]
3643.vpane sash place 0 \
3644 [lindex [.vpane sash coord 0] 0] \
3645 [lindex $gm 1]
3646.vpane.files sash place 0 \
3647 [lindex $gm 2] \
3648 [lindex [.vpane.files sash coord 0] 1]
3649unset gm
3650}
3651
3652# -- Key Bindings
3653#
3654bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3655bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3656bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3657bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3658bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3659bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3660bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3661bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3662bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3663bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3664bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3665
3666bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3667bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3668bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3669bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3670bind $ui_diff <$M1B-Key-v> {break}
3671bind $ui_diff <$M1B-Key-V> {break}
3672bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3673bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3674bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3675bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3676bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3677bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3678
3679bind . <Destroy> do_quit
3680bind all <Key-F5> do_rescan
3681bind all <$M1B-Key-r> do_rescan
3682bind all <$M1B-Key-R> do_rescan
3683bind . <$M1B-Key-s> do_signoff
3684bind . <$M1B-Key-S> do_signoff
3685bind . <$M1B-Key-i> do_include_all
3686bind . <$M1B-Key-I> do_include_all
3687bind . <$M1B-Key-Return> do_commit
3688bind all <$M1B-Key-q> do_quit
3689bind all <$M1B-Key-Q> do_quit
3690bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3691bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3692foreach i [list $ui_index $ui_other] {
3693 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
3694 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
3695 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3696}
3697unset i
3698
3699set file_lists($ui_index) [list]
3700set file_lists($ui_other) [list]
3701
3702set HEAD {}
3703set PARENT {}
3704set MERGE_HEAD [list]
3705set commit_type {}
3706set empty_tree {}
3707set current_branch {}
3708set current_diff {}
3709set selected_commit_type new
3710
3711wm title . "$appname ([file normalize [file dirname $gitdir]])"
3712focus -force $ui_comm
3713
3714# -- Warn the user about environmental problems. Cygwin's Tcl
3715# does *not* pass its env array onto any processes it spawns.
3716# This means that git processes get none of our environment.
3717#
3718if {[is_Windows]} {
3719 set ignored_env 0
3720 set suggest_user {}
3721 set msg "Possible environment issues exist.
3722
3723The following environment variables are probably
3724going to be ignored by any Git subprocess run
3725by $appname:
3726
3727"
3728 foreach name [array names env] {
3729 switch -regexp -- $name {
3730 {^GIT_INDEX_FILE$} -
3731 {^GIT_OBJECT_DIRECTORY$} -
3732 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3733 {^GIT_DIFF_OPTS$} -
3734 {^GIT_EXTERNAL_DIFF$} -
3735 {^GIT_PAGER$} -
3736 {^GIT_TRACE$} -
3737 {^GIT_CONFIG$} -
3738 {^GIT_CONFIG_LOCAL$} -
3739 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3740 append msg " - $name\n"
3741 incr ignored_env
3742 }
3743 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3744 append msg " - $name\n"
3745 incr ignored_env
3746 set suggest_user $name
3747 }
3748 }
3749 }
3750 if {$ignored_env > 0} {
3751 append msg "
3752This is due to a known issue with the
3753Tcl binary distributed by Cygwin."
3754
3755 if {$suggest_user ne {}} {
3756 append msg "
3757
3758A good replacement for $suggest_user
3759is placing values for the user.name and
3760user.email settings into your personal
3761~/.gitconfig file.
3762"
3763 }
3764 warn_popup $msg
3765 }
3766 unset ignored_env msg suggest_user name
3767}
3768
3769# -- Only initialize complex UI if we are going to stay running.
3770#
3771if {!$single_commit} {
3772 load_all_remotes
3773 load_all_heads
3774
3775 populate_branch_menu .mbar.branch
3776 populate_fetch_menu .mbar.fetch
3777 populate_pull_menu .mbar.pull
3778 populate_push_menu .mbar.push
3779}
3780
3781lock_index begin-read
3782after 1 do_rescan