6d676097a6a3aeecfda3a752b7344dc88094956c
1#!/bin/sh
2# Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 || test "z$*" = z--version; \
5 then \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
7 exit; \
8 fi; \
9 exec wish "$0" -- "$@"
10
11set appvers {@@GITGUI_VERSION@@}
12set copyright {
13Copyright © 2006, 2007 Shawn Pearce, et. al.
14
15This program is free software; you can redistribute it and/or modify
16it under the terms of the GNU General Public License as published by
17the Free Software Foundation; either version 2 of the License, or
18(at your option) any later version.
19
20This program is distributed in the hope that it will be useful,
21but WITHOUT ANY WARRANTY; without even the implied warranty of
22MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23GNU General Public License for more details.
24
25You should have received a copy of the GNU General Public License
26along with this program; if not, write to the Free Software
27Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
28
29######################################################################
30##
31## Tcl/Tk sanity check
32
33if {[catch {package require Tcl 8.4} err]
34 || [catch {package require Tk 8.4} err]
35} {
36 catch {wm withdraw .}
37 tk_messageBox \
38 -icon error \
39 -type ok \
40 -title "git-gui: fatal error" \
41 -message $err
42 exit 1
43}
44
45rename send {} ; # What an evil concept...
46
47######################################################################
48##
49## enable verbose loading?
50
51if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
52 unset _verbose
53 rename auto_load real__auto_load
54 proc auto_load {name args} {
55 puts stderr "auto_load $name"
56 return [uplevel 1 real__auto_load $name $args]
57 }
58 rename source real__source
59 proc source {name} {
60 puts stderr "source $name"
61 uplevel 1 real__source $name
62 }
63}
64
65######################################################################
66##
67## read only globals
68
69set _appname [lindex [file split $argv0] end]
70set _gitdir {}
71set _gitexec {}
72set _reponame {}
73set _iscygwin {}
74set _search_path {}
75
76proc appname {} {
77 global _appname
78 return $_appname
79}
80
81proc gitdir {args} {
82 global _gitdir
83 if {$args eq {}} {
84 return $_gitdir
85 }
86 return [eval [list file join $_gitdir] $args]
87}
88
89proc gitexec {args} {
90 global _gitexec
91 if {$_gitexec eq {}} {
92 if {[catch {set _gitexec [git --exec-path]} err]} {
93 error "Git not installed?\n\n$err"
94 }
95 if {[is_Cygwin]} {
96 set _gitexec [exec cygpath \
97 --windows \
98 --absolute \
99 $_gitexec]
100 } else {
101 set _gitexec [file normalize $_gitexec]
102 }
103 }
104 if {$args eq {}} {
105 return $_gitexec
106 }
107 return [eval [list file join $_gitexec] $args]
108}
109
110proc reponame {} {
111 return $::_reponame
112}
113
114proc is_MacOSX {} {
115 if {[tk windowingsystem] eq {aqua}} {
116 return 1
117 }
118 return 0
119}
120
121proc is_Windows {} {
122 if {$::tcl_platform(platform) eq {windows}} {
123 return 1
124 }
125 return 0
126}
127
128proc is_Cygwin {} {
129 global _iscygwin
130 if {$_iscygwin eq {}} {
131 if {$::tcl_platform(platform) eq {windows}} {
132 if {[catch {set p [exec cygpath --windir]} err]} {
133 set _iscygwin 0
134 } else {
135 set _iscygwin 1
136 }
137 } else {
138 set _iscygwin 0
139 }
140 }
141 return $_iscygwin
142}
143
144proc is_enabled {option} {
145 global enabled_options
146 if {[catch {set on $enabled_options($option)}]} {return 0}
147 return $on
148}
149
150proc enable_option {option} {
151 global enabled_options
152 set enabled_options($option) 1
153}
154
155proc disable_option {option} {
156 global enabled_options
157 set enabled_options($option) 0
158}
159
160######################################################################
161##
162## config
163
164proc is_many_config {name} {
165 switch -glob -- $name {
166 remote.*.fetch -
167 remote.*.push
168 {return 1}
169 *
170 {return 0}
171 }
172}
173
174proc is_config_true {name} {
175 global repo_config
176 if {[catch {set v $repo_config($name)}]} {
177 return 0
178 } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
179 return 1
180 } else {
181 return 0
182 }
183}
184
185proc get_config {name} {
186 global repo_config
187 if {[catch {set v $repo_config($name)}]} {
188 return {}
189 } else {
190 return $v
191 }
192}
193
194proc load_config {include_global} {
195 global repo_config global_config default_config
196
197 array unset global_config
198 if {$include_global} {
199 catch {
200 set fd_rc [git_read config --global --list]
201 while {[gets $fd_rc line] >= 0} {
202 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
203 if {[is_many_config $name]} {
204 lappend global_config($name) $value
205 } else {
206 set global_config($name) $value
207 }
208 }
209 }
210 close $fd_rc
211 }
212 }
213
214 array unset repo_config
215 catch {
216 set fd_rc [git_read config --list]
217 while {[gets $fd_rc line] >= 0} {
218 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
219 if {[is_many_config $name]} {
220 lappend repo_config($name) $value
221 } else {
222 set repo_config($name) $value
223 }
224 }
225 }
226 close $fd_rc
227 }
228
229 foreach name [array names default_config] {
230 if {[catch {set v $global_config($name)}]} {
231 set global_config($name) $default_config($name)
232 }
233 if {[catch {set v $repo_config($name)}]} {
234 set repo_config($name) $default_config($name)
235 }
236 }
237}
238
239######################################################################
240##
241## handy utils
242
243proc _git_cmd {name} {
244 global _git_cmd_path
245
246 if {[catch {set v $_git_cmd_path($name)}]} {
247 switch -- $name {
248 version -
249 --version -
250 --exec-path { return [list $::_git $name] }
251 }
252
253 set p [gitexec git-$name$::_search_exe]
254 if {[file exists $p]} {
255 set v [list $p]
256 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
257 # Try to determine what sort of magic will make
258 # git-$name go and do its thing, because native
259 # Tcl on Windows doesn't know it.
260 #
261 set p [gitexec git-$name]
262 set f [open $p r]
263 set s [gets $f]
264 close $f
265
266 switch -glob -- [lindex $s 0] {
267 #!*sh { set i sh }
268 #!*perl { set i perl }
269 #!*python { set i python }
270 default { error "git-$name is not supported: $s" }
271 }
272
273 upvar #0 _$i interp
274 if {![info exists interp]} {
275 set interp [_which $i]
276 }
277 if {$interp eq {}} {
278 error "git-$name requires $i (not in PATH)"
279 }
280 set v [concat [list $interp] [lrange $s 1 end] [list $p]]
281 } else {
282 # Assume it is builtin to git somehow and we
283 # aren't actually able to see a file for it.
284 #
285 set v [list $::_git $name]
286 }
287 set _git_cmd_path($name) $v
288 }
289 return $v
290}
291
292proc _which {what} {
293 global env _search_exe _search_path
294
295 if {$_search_path eq {}} {
296 if {[is_Cygwin]} {
297 set _search_path [split [exec cygpath \
298 --windows \
299 --path \
300 --absolute \
301 $env(PATH)] {;}]
302 set _search_exe .exe
303 } elseif {[is_Windows]} {
304 set _search_path [split $env(PATH) {;}]
305 set _search_exe .exe
306 } else {
307 set _search_path [split $env(PATH) :]
308 set _search_exe {}
309 }
310 }
311
312 foreach p $_search_path {
313 set p [file join $p $what$_search_exe]
314 if {[file exists $p]} {
315 return [file normalize $p]
316 }
317 }
318 return {}
319}
320
321proc _lappend_nice {cmd_var} {
322 global _nice
323 upvar $cmd_var cmd
324
325 if {![info exists _nice]} {
326 set _nice [_which nice]
327 }
328 if {$_nice ne {}} {
329 lappend cmd $_nice
330 }
331}
332
333proc git {args} {
334 set opt [list exec]
335
336 while {1} {
337 switch -- [lindex $args 0] {
338 --nice {
339 _lappend_nice opt
340 }
341
342 default {
343 break
344 }
345
346 }
347
348 set args [lrange $args 1 end]
349 }
350
351 set cmdp [_git_cmd [lindex $args 0]]
352 set args [lrange $args 1 end]
353
354 return [eval $opt $cmdp $args]
355}
356
357proc _open_stdout_stderr {cmd} {
358 if {[catch {
359 set fd [open $cmd r]
360 } err]} {
361 if { [lindex $cmd end] eq {2>@1}
362 && $err eq {can not find channel named "1"}
363 } {
364 # Older versions of Tcl 8.4 don't have this 2>@1 IO
365 # redirect operator. Fallback to |& cat for those.
366 # The command was not actually started, so its safe
367 # to try to start it a second time.
368 #
369 set fd [open [concat \
370 [lrange $cmd 0 end-1] \
371 [list |& cat] \
372 ] r]
373 } else {
374 error $err
375 }
376 }
377 fconfigure $fd -eofchar {}
378 return $fd
379}
380
381proc git_read {args} {
382 set opt [list |]
383
384 while {1} {
385 switch -- [lindex $args 0] {
386 --nice {
387 _lappend_nice opt
388 }
389
390 --stderr {
391 lappend args 2>@1
392 }
393
394 default {
395 break
396 }
397
398 }
399
400 set args [lrange $args 1 end]
401 }
402
403 set cmdp [_git_cmd [lindex $args 0]]
404 set args [lrange $args 1 end]
405
406 return [_open_stdout_stderr [concat $opt $cmdp $args]]
407}
408
409proc git_write {args} {
410 set opt [list |]
411
412 while {1} {
413 switch -- [lindex $args 0] {
414 --nice {
415 _lappend_nice opt
416 }
417
418 default {
419 break
420 }
421
422 }
423
424 set args [lrange $args 1 end]
425 }
426
427 set cmdp [_git_cmd [lindex $args 0]]
428 set args [lrange $args 1 end]
429
430 return [open [concat $opt $cmdp $args] w]
431}
432
433proc sq {value} {
434 regsub -all ' $value "'\\''" value
435 return "'$value'"
436}
437
438proc load_current_branch {} {
439 global current_branch is_detached
440
441 set fd [open [gitdir HEAD] r]
442 if {[gets $fd ref] < 1} {
443 set ref {}
444 }
445 close $fd
446
447 set pfx {ref: refs/heads/}
448 set len [string length $pfx]
449 if {[string equal -length $len $pfx $ref]} {
450 # We're on a branch. It might not exist. But
451 # HEAD looks good enough to be a branch.
452 #
453 set current_branch [string range $ref $len end]
454 set is_detached 0
455 } else {
456 # Assume this is a detached head.
457 #
458 set current_branch HEAD
459 set is_detached 1
460 }
461}
462
463auto_load tk_optionMenu
464rename tk_optionMenu real__tkOptionMenu
465proc tk_optionMenu {w varName args} {
466 set m [eval real__tkOptionMenu $w $varName $args]
467 $m configure -font font_ui
468 $w configure -font font_ui
469 return $m
470}
471
472######################################################################
473##
474## find git
475
476set _git [_which git]
477if {$_git eq {}} {
478 catch {wm withdraw .}
479 error_popup "Cannot find git in PATH."
480 exit 1
481}
482
483######################################################################
484##
485## version check
486
487if {[catch {set _git_version [git --version]} err]} {
488 catch {wm withdraw .}
489 tk_messageBox \
490 -icon error \
491 -type ok \
492 -title "git-gui: fatal error" \
493 -message "Cannot determine Git version:
494
495$err
496
497[appname] requires Git 1.5.0 or later."
498 exit 1
499}
500if {![regsub {^git version } $_git_version {} _git_version]} {
501 catch {wm withdraw .}
502 tk_messageBox \
503 -icon error \
504 -type ok \
505 -title "git-gui: fatal error" \
506 -message "Cannot parse Git version string:\n\n$_git_version"
507 exit 1
508}
509
510set _real_git_version $_git_version
511regsub -- {-dirty$} $_git_version {} _git_version
512regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
513regsub {\.rc[0-9]+$} $_git_version {} _git_version
514regsub {\.GIT$} $_git_version {} _git_version
515
516if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
517 catch {wm withdraw .}
518 if {[tk_messageBox \
519 -icon warning \
520 -type yesno \
521 -default no \
522 -title "[appname]: warning" \
523 -message "Git version cannot be determined.
524
525$_git claims it is version '$_real_git_version'.
526
527[appname] requires at least Git 1.5.0 or later.
528
529Assume '$_real_git_version' is version 1.5.0?
530"] eq {yes}} {
531 set _git_version 1.5.0
532 } else {
533 exit 1
534 }
535}
536unset _real_git_version
537
538proc git-version {args} {
539 global _git_version
540
541 switch [llength $args] {
542 0 {
543 return $_git_version
544 }
545
546 2 {
547 set op [lindex $args 0]
548 set vr [lindex $args 1]
549 set cm [package vcompare $_git_version $vr]
550 return [expr $cm $op 0]
551 }
552
553 4 {
554 set type [lindex $args 0]
555 set name [lindex $args 1]
556 set parm [lindex $args 2]
557 set body [lindex $args 3]
558
559 if {($type ne {proc} && $type ne {method})} {
560 error "Invalid arguments to git-version"
561 }
562 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
563 error "Last arm of $type $name must be default"
564 }
565
566 foreach {op vr cb} [lrange $body 0 end-2] {
567 if {[git-version $op $vr]} {
568 return [uplevel [list $type $name $parm $cb]]
569 }
570 }
571
572 return [uplevel [list $type $name $parm [lindex $body end]]]
573 }
574
575 default {
576 error "git-version >= x"
577 }
578
579 }
580}
581
582if {[git-version < 1.5]} {
583 catch {wm withdraw .}
584 tk_messageBox \
585 -icon error \
586 -type ok \
587 -title "git-gui: fatal error" \
588 -message "[appname] requires Git 1.5.0 or later.
589
590You are using [git-version]:
591
592[git --version]"
593 exit 1
594}
595
596######################################################################
597##
598## configure our library
599
600set oguilib {@@GITGUI_LIBDIR@@}
601set oguirel {@@GITGUI_RELATIVE@@}
602if {$oguirel eq {1}} {
603 set oguilib [file dirname [file dirname [file normalize $argv0]]]
604 set oguilib [file join $oguilib share git-gui lib]
605} elseif {[string match @@* $oguirel]} {
606 set oguilib [file join [file dirname [file normalize $argv0]] lib]
607}
608
609set idx [file join $oguilib tclIndex]
610if {[catch {set fd [open $idx r]} err]} {
611 catch {wm withdraw .}
612 tk_messageBox \
613 -icon error \
614 -type ok \
615 -title "git-gui: fatal error" \
616 -message $err
617 exit 1
618}
619if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
620 set idx [list]
621 while {[gets $fd n] >= 0} {
622 if {$n ne {} && ![string match #* $n]} {
623 lappend idx $n
624 }
625 }
626} else {
627 set idx {}
628}
629close $fd
630
631if {$idx ne {}} {
632 set loaded [list]
633 foreach p $idx {
634 if {[lsearch -exact $loaded $p] >= 0} continue
635 source [file join $oguilib $p]
636 lappend loaded $p
637 }
638 unset loaded p
639} else {
640 set auto_path [concat [list $oguilib] $auto_path]
641}
642unset -nocomplain oguirel idx fd
643
644######################################################################
645##
646## feature option selection
647
648if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
649 unset _junk
650} else {
651 set subcommand gui
652}
653if {$subcommand eq {gui.sh}} {
654 set subcommand gui
655}
656if {$subcommand eq {gui} && [llength $argv] > 0} {
657 set subcommand [lindex $argv 0]
658 set argv [lrange $argv 1 end]
659}
660
661enable_option multicommit
662enable_option branch
663enable_option transport
664disable_option bare
665
666switch -- $subcommand {
667browser -
668blame {
669 enable_option bare
670
671 disable_option multicommit
672 disable_option branch
673 disable_option transport
674}
675citool {
676 enable_option singlecommit
677
678 disable_option multicommit
679 disable_option branch
680 disable_option transport
681}
682}
683
684######################################################################
685##
686## repository setup
687
688if {[catch {
689 set _gitdir $env(GIT_DIR)
690 set _prefix {}
691 }]
692 && [catch {
693 set _gitdir [git rev-parse --git-dir]
694 set _prefix [git rev-parse --show-prefix]
695 } err]} {
696 catch {wm withdraw .}
697 error_popup "Cannot find the git directory:\n\n$err"
698 exit 1
699}
700if {![file isdirectory $_gitdir] && [is_Cygwin]} {
701 catch {set _gitdir [exec cygpath --unix $_gitdir]}
702}
703if {![file isdirectory $_gitdir]} {
704 catch {wm withdraw .}
705 error_popup "Git directory not found:\n\n$_gitdir"
706 exit 1
707}
708if {$_prefix ne {}} {
709 regsub -all {[^/]+/} $_prefix ../ cdup
710 if {[catch {cd $cdup} err]} {
711 catch {wm withdraw .}
712 error_popup "Cannot move to top of working directory:\n\n$err"
713 exit 1
714 }
715 unset cdup
716} elseif {![is_enabled bare]} {
717 if {[lindex [file split $_gitdir] end] ne {.git}} {
718 catch {wm withdraw .}
719 error_popup "Cannot use funny .git directory:\n\n$_gitdir"
720 exit 1
721 }
722 if {[catch {cd [file dirname $_gitdir]} err]} {
723 catch {wm withdraw .}
724 error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
725 exit 1
726 }
727}
728set _reponame [file split [file normalize $_gitdir]]
729if {[lindex $_reponame end] eq {.git}} {
730 set _reponame [lindex $_reponame end-1]
731} else {
732 set _reponame [lindex $_reponame end]
733}
734
735######################################################################
736##
737## global init
738
739set current_diff_path {}
740set current_diff_side {}
741set diff_actions [list]
742
743set HEAD {}
744set PARENT {}
745set MERGE_HEAD [list]
746set commit_type {}
747set empty_tree {}
748set current_branch {}
749set is_detached 0
750set current_diff_path {}
751set is_3way_diff 0
752set selected_commit_type new
753
754######################################################################
755##
756## task management
757
758set rescan_active 0
759set diff_active 0
760set last_clicked {}
761
762set disable_on_lock [list]
763set index_lock_type none
764
765proc lock_index {type} {
766 global index_lock_type disable_on_lock
767
768 if {$index_lock_type eq {none}} {
769 set index_lock_type $type
770 foreach w $disable_on_lock {
771 uplevel #0 $w disabled
772 }
773 return 1
774 } elseif {$index_lock_type eq "begin-$type"} {
775 set index_lock_type $type
776 return 1
777 }
778 return 0
779}
780
781proc unlock_index {} {
782 global index_lock_type disable_on_lock
783
784 set index_lock_type none
785 foreach w $disable_on_lock {
786 uplevel #0 $w normal
787 }
788}
789
790######################################################################
791##
792## status
793
794proc repository_state {ctvar hdvar mhvar} {
795 global current_branch
796 upvar $ctvar ct $hdvar hd $mhvar mh
797
798 set mh [list]
799
800 load_current_branch
801 if {[catch {set hd [git rev-parse --verify HEAD]}]} {
802 set hd {}
803 set ct initial
804 return
805 }
806
807 set merge_head [gitdir MERGE_HEAD]
808 if {[file exists $merge_head]} {
809 set ct merge
810 set fd_mh [open $merge_head r]
811 while {[gets $fd_mh line] >= 0} {
812 lappend mh $line
813 }
814 close $fd_mh
815 return
816 }
817
818 set ct normal
819}
820
821proc PARENT {} {
822 global PARENT empty_tree
823
824 set p [lindex $PARENT 0]
825 if {$p ne {}} {
826 return $p
827 }
828 if {$empty_tree eq {}} {
829 set empty_tree [git mktree << {}]
830 }
831 return $empty_tree
832}
833
834proc rescan {after {honor_trustmtime 1}} {
835 global HEAD PARENT MERGE_HEAD commit_type
836 global ui_index ui_workdir ui_comm
837 global rescan_active file_states
838 global repo_config
839
840 if {$rescan_active > 0 || ![lock_index read]} return
841
842 repository_state newType newHEAD newMERGE_HEAD
843 if {[string match amend* $commit_type]
844 && $newType eq {normal}
845 && $newHEAD eq $HEAD} {
846 } else {
847 set HEAD $newHEAD
848 set PARENT $newHEAD
849 set MERGE_HEAD $newMERGE_HEAD
850 set commit_type $newType
851 }
852
853 array unset file_states
854
855 if {!$::GITGUI_BCK_exists &&
856 (![$ui_comm edit modified]
857 || [string trim [$ui_comm get 0.0 end]] eq {})} {
858 if {[string match amend* $commit_type]} {
859 } elseif {[load_message GITGUI_MSG]} {
860 } elseif {[load_message MERGE_MSG]} {
861 } elseif {[load_message SQUASH_MSG]} {
862 }
863 $ui_comm edit reset
864 $ui_comm edit modified false
865 }
866
867 if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
868 rescan_stage2 {} $after
869 } else {
870 set rescan_active 1
871 ui_status {Refreshing file status...}
872 set fd_rf [git_read update-index \
873 -q \
874 --unmerged \
875 --ignore-missing \
876 --refresh \
877 ]
878 fconfigure $fd_rf -blocking 0 -translation binary
879 fileevent $fd_rf readable \
880 [list rescan_stage2 $fd_rf $after]
881 }
882}
883
884proc rescan_stage2 {fd after} {
885 global rescan_active buf_rdi buf_rdf buf_rlo
886
887 if {$fd ne {}} {
888 read $fd
889 if {![eof $fd]} return
890 close $fd
891 }
892
893 set ls_others [list --exclude-per-directory=.gitignore]
894 set info_exclude [gitdir info exclude]
895 if {[file readable $info_exclude]} {
896 lappend ls_others "--exclude-from=$info_exclude"
897 }
898 set user_exclude [get_config core.excludesfile]
899 if {$user_exclude ne {} && [file readable $user_exclude]} {
900 lappend ls_others "--exclude-from=$user_exclude"
901 }
902
903 set buf_rdi {}
904 set buf_rdf {}
905 set buf_rlo {}
906
907 set rescan_active 3
908 ui_status {Scanning for modified files ...}
909 set fd_di [git_read diff-index --cached -z [PARENT]]
910 set fd_df [git_read diff-files -z]
911 set fd_lo [eval git_read ls-files --others -z $ls_others]
912
913 fconfigure $fd_di -blocking 0 -translation binary -encoding binary
914 fconfigure $fd_df -blocking 0 -translation binary -encoding binary
915 fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
916 fileevent $fd_di readable [list read_diff_index $fd_di $after]
917 fileevent $fd_df readable [list read_diff_files $fd_df $after]
918 fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
919}
920
921proc load_message {file} {
922 global ui_comm
923
924 set f [gitdir $file]
925 if {[file isfile $f]} {
926 if {[catch {set fd [open $f r]}]} {
927 return 0
928 }
929 fconfigure $fd -eofchar {}
930 set content [string trim [read $fd]]
931 close $fd
932 regsub -all -line {[ \r\t]+$} $content {} content
933 $ui_comm delete 0.0 end
934 $ui_comm insert end $content
935 return 1
936 }
937 return 0
938}
939
940proc read_diff_index {fd after} {
941 global buf_rdi
942
943 append buf_rdi [read $fd]
944 set c 0
945 set n [string length $buf_rdi]
946 while {$c < $n} {
947 set z1 [string first "\0" $buf_rdi $c]
948 if {$z1 == -1} break
949 incr z1
950 set z2 [string first "\0" $buf_rdi $z1]
951 if {$z2 == -1} break
952
953 incr c
954 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
955 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
956 merge_state \
957 [encoding convertfrom $p] \
958 [lindex $i 4]? \
959 [list [lindex $i 0] [lindex $i 2]] \
960 [list]
961 set c $z2
962 incr c
963 }
964 if {$c < $n} {
965 set buf_rdi [string range $buf_rdi $c end]
966 } else {
967 set buf_rdi {}
968 }
969
970 rescan_done $fd buf_rdi $after
971}
972
973proc read_diff_files {fd after} {
974 global buf_rdf
975
976 append buf_rdf [read $fd]
977 set c 0
978 set n [string length $buf_rdf]
979 while {$c < $n} {
980 set z1 [string first "\0" $buf_rdf $c]
981 if {$z1 == -1} break
982 incr z1
983 set z2 [string first "\0" $buf_rdf $z1]
984 if {$z2 == -1} break
985
986 incr c
987 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
988 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
989 merge_state \
990 [encoding convertfrom $p] \
991 ?[lindex $i 4] \
992 [list] \
993 [list [lindex $i 0] [lindex $i 2]]
994 set c $z2
995 incr c
996 }
997 if {$c < $n} {
998 set buf_rdf [string range $buf_rdf $c end]
999 } else {
1000 set buf_rdf {}
1001 }
1002
1003 rescan_done $fd buf_rdf $after
1004}
1005
1006proc read_ls_others {fd after} {
1007 global buf_rlo
1008
1009 append buf_rlo [read $fd]
1010 set pck [split $buf_rlo "\0"]
1011 set buf_rlo [lindex $pck end]
1012 foreach p [lrange $pck 0 end-1] {
1013 merge_state [encoding convertfrom $p] ?O
1014 }
1015 rescan_done $fd buf_rlo $after
1016}
1017
1018proc rescan_done {fd buf after} {
1019 global rescan_active current_diff_path
1020 global file_states repo_config
1021 upvar $buf to_clear
1022
1023 if {![eof $fd]} return
1024 set to_clear {}
1025 close $fd
1026 if {[incr rescan_active -1] > 0} return
1027
1028 prune_selection
1029 unlock_index
1030 display_all_files
1031 if {$current_diff_path ne {}} reshow_diff
1032 uplevel #0 $after
1033}
1034
1035proc prune_selection {} {
1036 global file_states selected_paths
1037
1038 foreach path [array names selected_paths] {
1039 if {[catch {set still_here $file_states($path)}]} {
1040 unset selected_paths($path)
1041 }
1042 }
1043}
1044
1045######################################################################
1046##
1047## ui helpers
1048
1049proc mapicon {w state path} {
1050 global all_icons
1051
1052 if {[catch {set r $all_icons($state$w)}]} {
1053 puts "error: no icon for $w state={$state} $path"
1054 return file_plain
1055 }
1056 return $r
1057}
1058
1059proc mapdesc {state path} {
1060 global all_descs
1061
1062 if {[catch {set r $all_descs($state)}]} {
1063 puts "error: no desc for state={$state} $path"
1064 return $state
1065 }
1066 return $r
1067}
1068
1069proc ui_status {msg} {
1070 $::main_status show $msg
1071}
1072
1073proc ui_ready {{test {}}} {
1074 $::main_status show {Ready.} $test
1075}
1076
1077proc escape_path {path} {
1078 regsub -all {\\} $path "\\\\" path
1079 regsub -all "\n" $path "\\n" path
1080 return $path
1081}
1082
1083proc short_path {path} {
1084 return [escape_path [lindex [file split $path] end]]
1085}
1086
1087set next_icon_id 0
1088set null_sha1 [string repeat 0 40]
1089
1090proc merge_state {path new_state {head_info {}} {index_info {}}} {
1091 global file_states next_icon_id null_sha1
1092
1093 set s0 [string index $new_state 0]
1094 set s1 [string index $new_state 1]
1095
1096 if {[catch {set info $file_states($path)}]} {
1097 set state __
1098 set icon n[incr next_icon_id]
1099 } else {
1100 set state [lindex $info 0]
1101 set icon [lindex $info 1]
1102 if {$head_info eq {}} {set head_info [lindex $info 2]}
1103 if {$index_info eq {}} {set index_info [lindex $info 3]}
1104 }
1105
1106 if {$s0 eq {?}} {set s0 [string index $state 0]} \
1107 elseif {$s0 eq {_}} {set s0 _}
1108
1109 if {$s1 eq {?}} {set s1 [string index $state 1]} \
1110 elseif {$s1 eq {_}} {set s1 _}
1111
1112 if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1113 set head_info [list 0 $null_sha1]
1114 } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1115 && $head_info eq {}} {
1116 set head_info $index_info
1117 }
1118
1119 set file_states($path) [list $s0$s1 $icon \
1120 $head_info $index_info \
1121 ]
1122 return $state
1123}
1124
1125proc display_file_helper {w path icon_name old_m new_m} {
1126 global file_lists
1127
1128 if {$new_m eq {_}} {
1129 set lno [lsearch -sorted -exact $file_lists($w) $path]
1130 if {$lno >= 0} {
1131 set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1132 incr lno
1133 $w conf -state normal
1134 $w delete $lno.0 [expr {$lno + 1}].0
1135 $w conf -state disabled
1136 }
1137 } elseif {$old_m eq {_} && $new_m ne {_}} {
1138 lappend file_lists($w) $path
1139 set file_lists($w) [lsort -unique $file_lists($w)]
1140 set lno [lsearch -sorted -exact $file_lists($w) $path]
1141 incr lno
1142 $w conf -state normal
1143 $w image create $lno.0 \
1144 -align center -padx 5 -pady 1 \
1145 -name $icon_name \
1146 -image [mapicon $w $new_m $path]
1147 $w insert $lno.1 "[escape_path $path]\n"
1148 $w conf -state disabled
1149 } elseif {$old_m ne $new_m} {
1150 $w conf -state normal
1151 $w image conf $icon_name -image [mapicon $w $new_m $path]
1152 $w conf -state disabled
1153 }
1154}
1155
1156proc display_file {path state} {
1157 global file_states selected_paths
1158 global ui_index ui_workdir
1159
1160 set old_m [merge_state $path $state]
1161 set s $file_states($path)
1162 set new_m [lindex $s 0]
1163 set icon_name [lindex $s 1]
1164
1165 set o [string index $old_m 0]
1166 set n [string index $new_m 0]
1167 if {$o eq {U}} {
1168 set o _
1169 }
1170 if {$n eq {U}} {
1171 set n _
1172 }
1173 display_file_helper $ui_index $path $icon_name $o $n
1174
1175 if {[string index $old_m 0] eq {U}} {
1176 set o U
1177 } else {
1178 set o [string index $old_m 1]
1179 }
1180 if {[string index $new_m 0] eq {U}} {
1181 set n U
1182 } else {
1183 set n [string index $new_m 1]
1184 }
1185 display_file_helper $ui_workdir $path $icon_name $o $n
1186
1187 if {$new_m eq {__}} {
1188 unset file_states($path)
1189 catch {unset selected_paths($path)}
1190 }
1191}
1192
1193proc display_all_files_helper {w path icon_name m} {
1194 global file_lists
1195
1196 lappend file_lists($w) $path
1197 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1198 $w image create end \
1199 -align center -padx 5 -pady 1 \
1200 -name $icon_name \
1201 -image [mapicon $w $m $path]
1202 $w insert end "[escape_path $path]\n"
1203}
1204
1205proc display_all_files {} {
1206 global ui_index ui_workdir
1207 global file_states file_lists
1208 global last_clicked
1209
1210 $ui_index conf -state normal
1211 $ui_workdir conf -state normal
1212
1213 $ui_index delete 0.0 end
1214 $ui_workdir delete 0.0 end
1215 set last_clicked {}
1216
1217 set file_lists($ui_index) [list]
1218 set file_lists($ui_workdir) [list]
1219
1220 foreach path [lsort [array names file_states]] {
1221 set s $file_states($path)
1222 set m [lindex $s 0]
1223 set icon_name [lindex $s 1]
1224
1225 set s [string index $m 0]
1226 if {$s ne {U} && $s ne {_}} {
1227 display_all_files_helper $ui_index $path \
1228 $icon_name $s
1229 }
1230
1231 if {[string index $m 0] eq {U}} {
1232 set s U
1233 } else {
1234 set s [string index $m 1]
1235 }
1236 if {$s ne {_}} {
1237 display_all_files_helper $ui_workdir $path \
1238 $icon_name $s
1239 }
1240 }
1241
1242 $ui_index conf -state disabled
1243 $ui_workdir conf -state disabled
1244}
1245
1246######################################################################
1247##
1248## icons
1249
1250set filemask {
1251#define mask_width 14
1252#define mask_height 15
1253static unsigned char mask_bits[] = {
1254 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1255 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1256 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1257}
1258
1259image create bitmap file_plain -background white -foreground black -data {
1260#define plain_width 14
1261#define plain_height 15
1262static unsigned char plain_bits[] = {
1263 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1264 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1265 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1266} -maskdata $filemask
1267
1268image create bitmap file_mod -background white -foreground blue -data {
1269#define mod_width 14
1270#define mod_height 15
1271static unsigned char mod_bits[] = {
1272 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1273 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1274 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1275} -maskdata $filemask
1276
1277image create bitmap file_fulltick -background white -foreground "#007000" -data {
1278#define file_fulltick_width 14
1279#define file_fulltick_height 15
1280static unsigned char file_fulltick_bits[] = {
1281 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1282 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1283 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1284} -maskdata $filemask
1285
1286image create bitmap file_parttick -background white -foreground "#005050" -data {
1287#define parttick_width 14
1288#define parttick_height 15
1289static unsigned char parttick_bits[] = {
1290 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1291 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1292 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1293} -maskdata $filemask
1294
1295image create bitmap file_question -background white -foreground black -data {
1296#define file_question_width 14
1297#define file_question_height 15
1298static unsigned char file_question_bits[] = {
1299 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1300 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1301 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1302} -maskdata $filemask
1303
1304image create bitmap file_removed -background white -foreground red -data {
1305#define file_removed_width 14
1306#define file_removed_height 15
1307static unsigned char file_removed_bits[] = {
1308 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1309 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1310 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1311} -maskdata $filemask
1312
1313image create bitmap file_merge -background white -foreground blue -data {
1314#define file_merge_width 14
1315#define file_merge_height 15
1316static unsigned char file_merge_bits[] = {
1317 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1318 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1319 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1320} -maskdata $filemask
1321
1322set ui_index .vpane.files.index.list
1323set ui_workdir .vpane.files.workdir.list
1324
1325set all_icons(_$ui_index) file_plain
1326set all_icons(A$ui_index) file_fulltick
1327set all_icons(M$ui_index) file_fulltick
1328set all_icons(D$ui_index) file_removed
1329set all_icons(U$ui_index) file_merge
1330
1331set all_icons(_$ui_workdir) file_plain
1332set all_icons(M$ui_workdir) file_mod
1333set all_icons(D$ui_workdir) file_question
1334set all_icons(U$ui_workdir) file_merge
1335set all_icons(O$ui_workdir) file_plain
1336
1337set max_status_desc 0
1338foreach i {
1339 {__ "Unmodified"}
1340
1341 {_M "Modified, not staged"}
1342 {M_ "Staged for commit"}
1343 {MM "Portions staged for commit"}
1344 {MD "Staged for commit, missing"}
1345
1346 {_O "Untracked, not staged"}
1347 {A_ "Staged for commit"}
1348 {AM "Portions staged for commit"}
1349 {AD "Staged for commit, missing"}
1350
1351 {_D "Missing"}
1352 {D_ "Staged for removal"}
1353 {DO "Staged for removal, still present"}
1354
1355 {U_ "Requires merge resolution"}
1356 {UU "Requires merge resolution"}
1357 {UM "Requires merge resolution"}
1358 {UD "Requires merge resolution"}
1359 } {
1360 if {$max_status_desc < [string length [lindex $i 1]]} {
1361 set max_status_desc [string length [lindex $i 1]]
1362 }
1363 set all_descs([lindex $i 0]) [lindex $i 1]
1364}
1365unset i
1366
1367######################################################################
1368##
1369## util
1370
1371proc bind_button3 {w cmd} {
1372 bind $w <Any-Button-3> $cmd
1373 if {[is_MacOSX]} {
1374 # Mac OS X sends Button-2 on right click through three-button mouse,
1375 # or through trackpad right-clicking (two-finger touch + click).
1376 bind $w <Any-Button-2> $cmd
1377 bind $w <Control-Button-1> $cmd
1378 }
1379}
1380
1381proc scrollbar2many {list mode args} {
1382 foreach w $list {eval $w $mode $args}
1383}
1384
1385proc many2scrollbar {list mode sb top bottom} {
1386 $sb set $top $bottom
1387 foreach w $list {$w $mode moveto $top}
1388}
1389
1390proc incr_font_size {font {amt 1}} {
1391 set sz [font configure $font -size]
1392 incr sz $amt
1393 font configure $font -size $sz
1394 font configure ${font}bold -size $sz
1395 font configure ${font}italic -size $sz
1396}
1397
1398######################################################################
1399##
1400## ui commands
1401
1402set starting_gitk_msg {Starting gitk... please wait...}
1403
1404proc do_gitk {revs} {
1405 # -- Always start gitk through whatever we were loaded with. This
1406 # lets us bypass using shell process on Windows systems.
1407 #
1408 set exe [file join [file dirname $::_git] gitk]
1409 set cmd [list [info nameofexecutable] $exe]
1410 if {! [file exists $exe]} {
1411 error_popup "Unable to start gitk:\n\n$exe does not exist"
1412 } else {
1413 eval exec $cmd $revs &
1414 ui_status $::starting_gitk_msg
1415 after 10000 {
1416 ui_ready $starting_gitk_msg
1417 }
1418 }
1419}
1420
1421set is_quitting 0
1422
1423proc do_quit {} {
1424 global ui_comm is_quitting repo_config commit_type
1425 global GITGUI_BCK_exists GITGUI_BCK_i
1426
1427 if {$is_quitting} return
1428 set is_quitting 1
1429
1430 if {[winfo exists $ui_comm]} {
1431 # -- Stash our current commit buffer.
1432 #
1433 set save [gitdir GITGUI_MSG]
1434 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1435 file rename -force [gitdir GITGUI_BCK] $save
1436 set GITGUI_BCK_exists 0
1437 } else {
1438 set msg [string trim [$ui_comm get 0.0 end]]
1439 regsub -all -line {[ \r\t]+$} $msg {} msg
1440 if {(![string match amend* $commit_type]
1441 || [$ui_comm edit modified])
1442 && $msg ne {}} {
1443 catch {
1444 set fd [open $save w]
1445 puts -nonewline $fd $msg
1446 close $fd
1447 }
1448 } else {
1449 catch {file delete $save}
1450 }
1451 }
1452
1453 # -- Remove our editor backup, its not needed.
1454 #
1455 after cancel $GITGUI_BCK_i
1456 if {$GITGUI_BCK_exists} {
1457 catch {file delete [gitdir GITGUI_BCK]}
1458 }
1459
1460 # -- Stash our current window geometry into this repository.
1461 #
1462 set cfg_geometry [list]
1463 lappend cfg_geometry [wm geometry .]
1464 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1465 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1466 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1467 set rc_geometry {}
1468 }
1469 if {$cfg_geometry ne $rc_geometry} {
1470 catch {git config gui.geometry $cfg_geometry}
1471 }
1472 }
1473
1474 destroy .
1475}
1476
1477proc do_rescan {} {
1478 rescan ui_ready
1479}
1480
1481proc do_commit {} {
1482 commit_tree
1483}
1484
1485proc toggle_or_diff {w x y} {
1486 global file_states file_lists current_diff_path ui_index ui_workdir
1487 global last_clicked selected_paths
1488
1489 set pos [split [$w index @$x,$y] .]
1490 set lno [lindex $pos 0]
1491 set col [lindex $pos 1]
1492 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1493 if {$path eq {}} {
1494 set last_clicked {}
1495 return
1496 }
1497
1498 set last_clicked [list $w $lno]
1499 array unset selected_paths
1500 $ui_index tag remove in_sel 0.0 end
1501 $ui_workdir tag remove in_sel 0.0 end
1502
1503 if {$col == 0} {
1504 if {$current_diff_path eq $path} {
1505 set after {reshow_diff;}
1506 } else {
1507 set after {}
1508 }
1509 if {$w eq $ui_index} {
1510 update_indexinfo \
1511 "Unstaging [short_path $path] from commit" \
1512 [list $path] \
1513 [concat $after [list ui_ready]]
1514 } elseif {$w eq $ui_workdir} {
1515 update_index \
1516 "Adding [short_path $path]" \
1517 [list $path] \
1518 [concat $after [list ui_ready]]
1519 }
1520 } else {
1521 show_diff $path $w $lno
1522 }
1523}
1524
1525proc add_one_to_selection {w x y} {
1526 global file_lists last_clicked selected_paths
1527
1528 set lno [lindex [split [$w index @$x,$y] .] 0]
1529 set path [lindex $file_lists($w) [expr {$lno - 1}]]
1530 if {$path eq {}} {
1531 set last_clicked {}
1532 return
1533 }
1534
1535 if {$last_clicked ne {}
1536 && [lindex $last_clicked 0] ne $w} {
1537 array unset selected_paths
1538 [lindex $last_clicked 0] tag remove in_sel 0.0 end
1539 }
1540
1541 set last_clicked [list $w $lno]
1542 if {[catch {set in_sel $selected_paths($path)}]} {
1543 set in_sel 0
1544 }
1545 if {$in_sel} {
1546 unset selected_paths($path)
1547 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1548 } else {
1549 set selected_paths($path) 1
1550 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1551 }
1552}
1553
1554proc add_range_to_selection {w x y} {
1555 global file_lists last_clicked selected_paths
1556
1557 if {[lindex $last_clicked 0] ne $w} {
1558 toggle_or_diff $w $x $y
1559 return
1560 }
1561
1562 set lno [lindex [split [$w index @$x,$y] .] 0]
1563 set lc [lindex $last_clicked 1]
1564 if {$lc < $lno} {
1565 set begin $lc
1566 set end $lno
1567 } else {
1568 set begin $lno
1569 set end $lc
1570 }
1571
1572 foreach path [lrange $file_lists($w) \
1573 [expr {$begin - 1}] \
1574 [expr {$end - 1}]] {
1575 set selected_paths($path) 1
1576 }
1577 $w tag add in_sel $begin.0 [expr {$end + 1}].0
1578}
1579
1580######################################################################
1581##
1582## config defaults
1583
1584set cursor_ptr arrow
1585font create font_diff -family Courier -size 10
1586font create font_ui
1587catch {
1588 label .dummy
1589 eval font configure font_ui [font actual [.dummy cget -font]]
1590 destroy .dummy
1591}
1592
1593font create font_uiitalic
1594font create font_uibold
1595font create font_diffbold
1596font create font_diffitalic
1597
1598foreach class {Button Checkbutton Entry Label
1599 Labelframe Listbox Menu Message
1600 Radiobutton Spinbox Text} {
1601 option add *$class.font font_ui
1602}
1603unset class
1604
1605if {[is_Windows] || [is_MacOSX]} {
1606 option add *Menu.tearOff 0
1607}
1608
1609if {[is_MacOSX]} {
1610 set M1B M1
1611 set M1T Cmd
1612} else {
1613 set M1B Control
1614 set M1T Ctrl
1615}
1616
1617proc apply_config {} {
1618 global repo_config font_descs
1619
1620 foreach option $font_descs {
1621 set name [lindex $option 0]
1622 set font [lindex $option 1]
1623 if {[catch {
1624 foreach {cn cv} $repo_config(gui.$name) {
1625 font configure $font $cn $cv
1626 }
1627 } err]} {
1628 error_popup "Invalid font specified in gui.$name:\n\n$err"
1629 }
1630 foreach {cn cv} [font configure $font] {
1631 font configure ${font}bold $cn $cv
1632 font configure ${font}italic $cn $cv
1633 }
1634 font configure ${font}bold -weight bold
1635 font configure ${font}italic -slant italic
1636 }
1637}
1638
1639set default_config(merge.diffstat) true
1640set default_config(merge.summary) false
1641set default_config(merge.verbosity) 2
1642set default_config(user.name) {}
1643set default_config(user.email) {}
1644
1645set default_config(gui.matchtrackingbranch) false
1646set default_config(gui.pruneduringfetch) false
1647set default_config(gui.trustmtime) false
1648set default_config(gui.diffcontext) 5
1649set default_config(gui.newbranchtemplate) {}
1650set default_config(gui.fontui) [font configure font_ui]
1651set default_config(gui.fontdiff) [font configure font_diff]
1652set font_descs {
1653 {fontui font_ui {Main Font}}
1654 {fontdiff font_diff {Diff/Console Font}}
1655}
1656load_config 0
1657apply_config
1658
1659######################################################################
1660##
1661## ui construction
1662
1663set ui_comm {}
1664
1665# -- Menu Bar
1666#
1667menu .mbar -tearoff 0
1668.mbar add cascade -label Repository -menu .mbar.repository
1669.mbar add cascade -label Edit -menu .mbar.edit
1670if {[is_enabled branch]} {
1671 .mbar add cascade -label Branch -menu .mbar.branch
1672}
1673if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1674 .mbar add cascade -label Commit -menu .mbar.commit
1675}
1676if {[is_enabled transport]} {
1677 .mbar add cascade -label Merge -menu .mbar.merge
1678 .mbar add cascade -label Fetch -menu .mbar.fetch
1679 .mbar add cascade -label Push -menu .mbar.push
1680}
1681. configure -menu .mbar
1682
1683# -- Repository Menu
1684#
1685menu .mbar.repository
1686
1687.mbar.repository add command \
1688 -label {Browse Current Branch's Files} \
1689 -command {browser::new $current_branch}
1690set ui_browse_current [.mbar.repository index last]
1691.mbar.repository add command \
1692 -label {Browse Branch Files...} \
1693 -command browser_open::dialog
1694.mbar.repository add separator
1695
1696.mbar.repository add command \
1697 -label {Visualize Current Branch's History} \
1698 -command {do_gitk $current_branch}
1699set ui_visualize_current [.mbar.repository index last]
1700.mbar.repository add command \
1701 -label {Visualize All Branch History} \
1702 -command {do_gitk --all}
1703.mbar.repository add separator
1704
1705proc current_branch_write {args} {
1706 global current_branch
1707 .mbar.repository entryconf $::ui_browse_current \
1708 -label "Browse $current_branch's Files"
1709 .mbar.repository entryconf $::ui_visualize_current \
1710 -label "Visualize $current_branch's History"
1711}
1712trace add variable current_branch write current_branch_write
1713
1714if {[is_enabled multicommit]} {
1715 .mbar.repository add command -label {Database Statistics} \
1716 -command do_stats
1717
1718 .mbar.repository add command -label {Compress Database} \
1719 -command do_gc
1720
1721 .mbar.repository add command -label {Verify Database} \
1722 -command do_fsck_objects
1723
1724 .mbar.repository add separator
1725
1726 if {[is_Cygwin]} {
1727 .mbar.repository add command \
1728 -label {Create Desktop Icon} \
1729 -command do_cygwin_shortcut
1730 } elseif {[is_Windows]} {
1731 .mbar.repository add command \
1732 -label {Create Desktop Icon} \
1733 -command do_windows_shortcut
1734 } elseif {[is_MacOSX]} {
1735 .mbar.repository add command \
1736 -label {Create Desktop Icon} \
1737 -command do_macosx_app
1738 }
1739}
1740
1741.mbar.repository add command -label Quit \
1742 -command do_quit \
1743 -accelerator $M1T-Q
1744
1745# -- Edit Menu
1746#
1747menu .mbar.edit
1748.mbar.edit add command -label Undo \
1749 -command {catch {[focus] edit undo}} \
1750 -accelerator $M1T-Z
1751.mbar.edit add command -label Redo \
1752 -command {catch {[focus] edit redo}} \
1753 -accelerator $M1T-Y
1754.mbar.edit add separator
1755.mbar.edit add command -label Cut \
1756 -command {catch {tk_textCut [focus]}} \
1757 -accelerator $M1T-X
1758.mbar.edit add command -label Copy \
1759 -command {catch {tk_textCopy [focus]}} \
1760 -accelerator $M1T-C
1761.mbar.edit add command -label Paste \
1762 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1763 -accelerator $M1T-V
1764.mbar.edit add command -label Delete \
1765 -command {catch {[focus] delete sel.first sel.last}} \
1766 -accelerator Del
1767.mbar.edit add separator
1768.mbar.edit add command -label {Select All} \
1769 -command {catch {[focus] tag add sel 0.0 end}} \
1770 -accelerator $M1T-A
1771
1772# -- Branch Menu
1773#
1774if {[is_enabled branch]} {
1775 menu .mbar.branch
1776
1777 .mbar.branch add command -label {Create...} \
1778 -command branch_create::dialog \
1779 -accelerator $M1T-N
1780 lappend disable_on_lock [list .mbar.branch entryconf \
1781 [.mbar.branch index last] -state]
1782
1783 .mbar.branch add command -label {Checkout...} \
1784 -command branch_checkout::dialog \
1785 -accelerator $M1T-O
1786 lappend disable_on_lock [list .mbar.branch entryconf \
1787 [.mbar.branch index last] -state]
1788
1789 .mbar.branch add command -label {Rename...} \
1790 -command branch_rename::dialog
1791 lappend disable_on_lock [list .mbar.branch entryconf \
1792 [.mbar.branch index last] -state]
1793
1794 .mbar.branch add command -label {Delete...} \
1795 -command branch_delete::dialog
1796 lappend disable_on_lock [list .mbar.branch entryconf \
1797 [.mbar.branch index last] -state]
1798
1799 .mbar.branch add command -label {Reset...} \
1800 -command merge::reset_hard
1801 lappend disable_on_lock [list .mbar.branch entryconf \
1802 [.mbar.branch index last] -state]
1803}
1804
1805# -- Commit Menu
1806#
1807if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1808 menu .mbar.commit
1809
1810 .mbar.commit add radiobutton \
1811 -label {New Commit} \
1812 -command do_select_commit_type \
1813 -variable selected_commit_type \
1814 -value new
1815 lappend disable_on_lock \
1816 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1817
1818 .mbar.commit add radiobutton \
1819 -label {Amend Last Commit} \
1820 -command do_select_commit_type \
1821 -variable selected_commit_type \
1822 -value amend
1823 lappend disable_on_lock \
1824 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1825
1826 .mbar.commit add separator
1827
1828 .mbar.commit add command -label Rescan \
1829 -command do_rescan \
1830 -accelerator F5
1831 lappend disable_on_lock \
1832 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1833
1834 .mbar.commit add command -label {Stage To Commit} \
1835 -command do_add_selection
1836 lappend disable_on_lock \
1837 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1838
1839 .mbar.commit add command -label {Stage Changed Files To Commit} \
1840 -command do_add_all \
1841 -accelerator $M1T-I
1842 lappend disable_on_lock \
1843 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1844
1845 .mbar.commit add command -label {Unstage From Commit} \
1846 -command do_unstage_selection
1847 lappend disable_on_lock \
1848 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1849
1850 .mbar.commit add command -label {Revert Changes} \
1851 -command do_revert_selection
1852 lappend disable_on_lock \
1853 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1854
1855 .mbar.commit add separator
1856
1857 .mbar.commit add command -label {Sign Off} \
1858 -command do_signoff \
1859 -accelerator $M1T-S
1860
1861 .mbar.commit add command -label Commit \
1862 -command do_commit \
1863 -accelerator $M1T-Return
1864 lappend disable_on_lock \
1865 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1866}
1867
1868# -- Merge Menu
1869#
1870if {[is_enabled branch]} {
1871 menu .mbar.merge
1872 .mbar.merge add command -label {Local Merge...} \
1873 -command merge::dialog \
1874 -accelerator $M1T-M
1875 lappend disable_on_lock \
1876 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1877 .mbar.merge add command -label {Abort Merge...} \
1878 -command merge::reset_hard
1879 lappend disable_on_lock \
1880 [list .mbar.merge entryconf [.mbar.merge index last] -state]
1881}
1882
1883# -- Transport Menu
1884#
1885if {[is_enabled transport]} {
1886 menu .mbar.fetch
1887
1888 menu .mbar.push
1889 .mbar.push add command -label {Push...} \
1890 -command do_push_anywhere \
1891 -accelerator $M1T-P
1892 .mbar.push add command -label {Delete...} \
1893 -command remote_branch_delete::dialog
1894}
1895
1896if {[is_MacOSX]} {
1897 # -- Apple Menu (Mac OS X only)
1898 #
1899 .mbar add cascade -label Apple -menu .mbar.apple
1900 menu .mbar.apple
1901
1902 .mbar.apple add command -label "About [appname]" \
1903 -command do_about
1904 .mbar.apple add command -label "Options..." \
1905 -command do_options
1906} else {
1907 # -- Edit Menu
1908 #
1909 .mbar.edit add separator
1910 .mbar.edit add command -label {Options...} \
1911 -command do_options
1912}
1913
1914# -- Help Menu
1915#
1916.mbar add cascade -label Help -menu .mbar.help
1917menu .mbar.help
1918
1919if {![is_MacOSX]} {
1920 .mbar.help add command -label "About [appname]" \
1921 -command do_about
1922}
1923
1924set browser {}
1925catch {set browser $repo_config(instaweb.browser)}
1926set doc_path [file dirname [gitexec]]
1927set doc_path [file join $doc_path Documentation index.html]
1928
1929if {[is_Cygwin]} {
1930 set doc_path [exec cygpath --mixed $doc_path]
1931}
1932
1933if {$browser eq {}} {
1934 if {[is_MacOSX]} {
1935 set browser open
1936 } elseif {[is_Cygwin]} {
1937 set program_files [file dirname [exec cygpath --windir]]
1938 set program_files [file join $program_files {Program Files}]
1939 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1940 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1941 if {[file exists $firefox]} {
1942 set browser $firefox
1943 } elseif {[file exists $ie]} {
1944 set browser $ie
1945 }
1946 unset program_files firefox ie
1947 }
1948}
1949
1950if {[file isfile $doc_path]} {
1951 set doc_url "file:$doc_path"
1952} else {
1953 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1954}
1955
1956if {$browser ne {}} {
1957 .mbar.help add command -label {Online Documentation} \
1958 -command [list exec $browser $doc_url &]
1959}
1960unset browser doc_path doc_url
1961
1962set root_exists 0
1963bind . <Visibility> {
1964 bind . <Visibility> {}
1965 set root_exists 1
1966}
1967
1968# -- Standard bindings
1969#
1970wm protocol . WM_DELETE_WINDOW do_quit
1971bind all <$M1B-Key-q> do_quit
1972bind all <$M1B-Key-Q> do_quit
1973bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1974bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1975
1976set subcommand_args {}
1977proc usage {} {
1978 puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1979 exit 1
1980}
1981
1982# -- Not a normal commit type invocation? Do that instead!
1983#
1984switch -- $subcommand {
1985browser -
1986blame {
1987 set subcommand_args {rev? path}
1988 if {$argv eq {}} usage
1989 set head {}
1990 set path {}
1991 set is_path 0
1992 foreach a $argv {
1993 if {$is_path || [file exists $_prefix$a]} {
1994 if {$path ne {}} usage
1995 set path $_prefix$a
1996 break
1997 } elseif {$a eq {--}} {
1998 if {$path ne {}} {
1999 if {$head ne {}} usage
2000 set head $path
2001 set path {}
2002 }
2003 set is_path 1
2004 } elseif {$head eq {}} {
2005 if {$head ne {}} usage
2006 set head $a
2007 set is_path 1
2008 } else {
2009 usage
2010 }
2011 }
2012 unset is_path
2013
2014 if {$head ne {} && $path eq {}} {
2015 set path $_prefix$head
2016 set head {}
2017 }
2018
2019 if {$head eq {}} {
2020 load_current_branch
2021 } else {
2022 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2023 if {[catch {
2024 set head [git rev-parse --verify $head]
2025 } err]} {
2026 puts stderr $err
2027 exit 1
2028 }
2029 }
2030 set current_branch $head
2031 }
2032
2033 switch -- $subcommand {
2034 browser {
2035 if {$head eq {}} {
2036 if {$path ne {} && [file isdirectory $path]} {
2037 set head $current_branch
2038 } else {
2039 set head $path
2040 set path {}
2041 }
2042 }
2043 browser::new $head $path
2044 }
2045 blame {
2046 if {$head eq {} && ![file exists $path]} {
2047 puts stderr "fatal: cannot stat path $path: No such file or directory"
2048 exit 1
2049 }
2050 blame::new $head $path
2051 }
2052 }
2053 return
2054}
2055citool -
2056gui {
2057 if {[llength $argv] != 0} {
2058 puts -nonewline stderr "usage: $argv0"
2059 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2060 puts -nonewline stderr " $subcommand"
2061 }
2062 puts stderr {}
2063 exit 1
2064 }
2065 # fall through to setup UI for commits
2066}
2067default {
2068 puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2069 exit 1
2070}
2071}
2072
2073# -- Branch Control
2074#
2075frame .branch \
2076 -borderwidth 1 \
2077 -relief sunken
2078label .branch.l1 \
2079 -text {Current Branch:} \
2080 -anchor w \
2081 -justify left
2082label .branch.cb \
2083 -textvariable current_branch \
2084 -anchor w \
2085 -justify left
2086pack .branch.l1 -side left
2087pack .branch.cb -side left -fill x
2088pack .branch -side top -fill x
2089
2090# -- Main Window Layout
2091#
2092panedwindow .vpane -orient vertical
2093panedwindow .vpane.files -orient horizontal
2094.vpane add .vpane.files -sticky nsew -height 100 -width 200
2095pack .vpane -anchor n -side top -fill both -expand 1
2096
2097# -- Index File List
2098#
2099frame .vpane.files.index -height 100 -width 200
2100label .vpane.files.index.title -text {Staged Changes (Will Be Committed)} \
2101 -background lightgreen
2102text $ui_index -background white -borderwidth 0 \
2103 -width 20 -height 10 \
2104 -wrap none \
2105 -cursor $cursor_ptr \
2106 -xscrollcommand {.vpane.files.index.sx set} \
2107 -yscrollcommand {.vpane.files.index.sy set} \
2108 -state disabled
2109scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2110scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2111pack .vpane.files.index.title -side top -fill x
2112pack .vpane.files.index.sx -side bottom -fill x
2113pack .vpane.files.index.sy -side right -fill y
2114pack $ui_index -side left -fill both -expand 1
2115.vpane.files add .vpane.files.index -sticky nsew
2116
2117# -- Working Directory File List
2118#
2119frame .vpane.files.workdir -height 100 -width 200
2120label .vpane.files.workdir.title -text {Unstaged Changes (Will Not Be Committed)} \
2121 -background lightsalmon
2122text $ui_workdir -background white -borderwidth 0 \
2123 -width 20 -height 10 \
2124 -wrap none \
2125 -cursor $cursor_ptr \
2126 -xscrollcommand {.vpane.files.workdir.sx set} \
2127 -yscrollcommand {.vpane.files.workdir.sy set} \
2128 -state disabled
2129scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2130scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2131pack .vpane.files.workdir.title -side top -fill x
2132pack .vpane.files.workdir.sx -side bottom -fill x
2133pack .vpane.files.workdir.sy -side right -fill y
2134pack $ui_workdir -side left -fill both -expand 1
2135.vpane.files add .vpane.files.workdir -sticky nsew
2136
2137foreach i [list $ui_index $ui_workdir] {
2138 $i tag conf in_diff -background lightgray
2139 $i tag conf in_sel -background lightgray
2140}
2141unset i
2142
2143# -- Diff and Commit Area
2144#
2145frame .vpane.lower -height 300 -width 400
2146frame .vpane.lower.commarea
2147frame .vpane.lower.diff -relief sunken -borderwidth 1
2148pack .vpane.lower.commarea -side top -fill x
2149pack .vpane.lower.diff -side bottom -fill both -expand 1
2150.vpane add .vpane.lower -sticky nsew
2151
2152# -- Commit Area Buttons
2153#
2154frame .vpane.lower.commarea.buttons
2155label .vpane.lower.commarea.buttons.l -text {} \
2156 -anchor w \
2157 -justify left
2158pack .vpane.lower.commarea.buttons.l -side top -fill x
2159pack .vpane.lower.commarea.buttons -side left -fill y
2160
2161button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2162 -command do_rescan
2163pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2164lappend disable_on_lock \
2165 {.vpane.lower.commarea.buttons.rescan conf -state}
2166
2167button .vpane.lower.commarea.buttons.incall -text {Stage Changed} \
2168 -command do_add_all
2169pack .vpane.lower.commarea.buttons.incall -side top -fill x
2170lappend disable_on_lock \
2171 {.vpane.lower.commarea.buttons.incall conf -state}
2172
2173button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2174 -command do_signoff
2175pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2176
2177button .vpane.lower.commarea.buttons.commit -text {Commit} \
2178 -command do_commit
2179pack .vpane.lower.commarea.buttons.commit -side top -fill x
2180lappend disable_on_lock \
2181 {.vpane.lower.commarea.buttons.commit conf -state}
2182
2183button .vpane.lower.commarea.buttons.push -text {Push} \
2184 -command do_push_anywhere
2185pack .vpane.lower.commarea.buttons.push -side top -fill x
2186
2187# -- Commit Message Buffer
2188#
2189frame .vpane.lower.commarea.buffer
2190frame .vpane.lower.commarea.buffer.header
2191set ui_comm .vpane.lower.commarea.buffer.t
2192set ui_coml .vpane.lower.commarea.buffer.header.l
2193radiobutton .vpane.lower.commarea.buffer.header.new \
2194 -text {New Commit} \
2195 -command do_select_commit_type \
2196 -variable selected_commit_type \
2197 -value new
2198lappend disable_on_lock \
2199 [list .vpane.lower.commarea.buffer.header.new conf -state]
2200radiobutton .vpane.lower.commarea.buffer.header.amend \
2201 -text {Amend Last Commit} \
2202 -command do_select_commit_type \
2203 -variable selected_commit_type \
2204 -value amend
2205lappend disable_on_lock \
2206 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2207label $ui_coml \
2208 -anchor w \
2209 -justify left
2210proc trace_commit_type {varname args} {
2211 global ui_coml commit_type
2212 switch -glob -- $commit_type {
2213 initial {set txt {Initial Commit Message:}}
2214 amend {set txt {Amended Commit Message:}}
2215 amend-initial {set txt {Amended Initial Commit Message:}}
2216 amend-merge {set txt {Amended Merge Commit Message:}}
2217 merge {set txt {Merge Commit Message:}}
2218 * {set txt {Commit Message:}}
2219 }
2220 $ui_coml conf -text $txt
2221}
2222trace add variable commit_type write trace_commit_type
2223pack $ui_coml -side left -fill x
2224pack .vpane.lower.commarea.buffer.header.amend -side right
2225pack .vpane.lower.commarea.buffer.header.new -side right
2226
2227text $ui_comm -background white -borderwidth 1 \
2228 -undo true \
2229 -maxundo 20 \
2230 -autoseparators true \
2231 -relief sunken \
2232 -width 75 -height 9 -wrap none \
2233 -font font_diff \
2234 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2235scrollbar .vpane.lower.commarea.buffer.sby \
2236 -command [list $ui_comm yview]
2237pack .vpane.lower.commarea.buffer.header -side top -fill x
2238pack .vpane.lower.commarea.buffer.sby -side right -fill y
2239pack $ui_comm -side left -fill y
2240pack .vpane.lower.commarea.buffer -side left -fill y
2241
2242# -- Commit Message Buffer Context Menu
2243#
2244set ctxm .vpane.lower.commarea.buffer.ctxm
2245menu $ctxm -tearoff 0
2246$ctxm add command \
2247 -label {Cut} \
2248 -command {tk_textCut $ui_comm}
2249$ctxm add command \
2250 -label {Copy} \
2251 -command {tk_textCopy $ui_comm}
2252$ctxm add command \
2253 -label {Paste} \
2254 -command {tk_textPaste $ui_comm}
2255$ctxm add command \
2256 -label {Delete} \
2257 -command {$ui_comm delete sel.first sel.last}
2258$ctxm add separator
2259$ctxm add command \
2260 -label {Select All} \
2261 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2262$ctxm add command \
2263 -label {Copy All} \
2264 -command {
2265 $ui_comm tag add sel 0.0 end
2266 tk_textCopy $ui_comm
2267 $ui_comm tag remove sel 0.0 end
2268 }
2269$ctxm add separator
2270$ctxm add command \
2271 -label {Sign Off} \
2272 -command do_signoff
2273bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2274
2275# -- Diff Header
2276#
2277proc trace_current_diff_path {varname args} {
2278 global current_diff_path diff_actions file_states
2279 if {$current_diff_path eq {}} {
2280 set s {}
2281 set f {}
2282 set p {}
2283 set o disabled
2284 } else {
2285 set p $current_diff_path
2286 set s [mapdesc [lindex $file_states($p) 0] $p]
2287 set f {File:}
2288 set p [escape_path $p]
2289 set o normal
2290 }
2291
2292 .vpane.lower.diff.header.status configure -text $s
2293 .vpane.lower.diff.header.file configure -text $f
2294 .vpane.lower.diff.header.path configure -text $p
2295 foreach w $diff_actions {
2296 uplevel #0 $w $o
2297 }
2298}
2299trace add variable current_diff_path write trace_current_diff_path
2300
2301frame .vpane.lower.diff.header -background gold
2302label .vpane.lower.diff.header.status \
2303 -background gold \
2304 -width $max_status_desc \
2305 -anchor w \
2306 -justify left
2307label .vpane.lower.diff.header.file \
2308 -background gold \
2309 -anchor w \
2310 -justify left
2311label .vpane.lower.diff.header.path \
2312 -background gold \
2313 -anchor w \
2314 -justify left
2315pack .vpane.lower.diff.header.status -side left
2316pack .vpane.lower.diff.header.file -side left
2317pack .vpane.lower.diff.header.path -fill x
2318set ctxm .vpane.lower.diff.header.ctxm
2319menu $ctxm -tearoff 0
2320$ctxm add command \
2321 -label {Copy} \
2322 -command {
2323 clipboard clear
2324 clipboard append \
2325 -format STRING \
2326 -type STRING \
2327 -- $current_diff_path
2328 }
2329lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2330bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2331
2332# -- Diff Body
2333#
2334frame .vpane.lower.diff.body
2335set ui_diff .vpane.lower.diff.body.t
2336text $ui_diff -background white -borderwidth 0 \
2337 -width 80 -height 15 -wrap none \
2338 -font font_diff \
2339 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2340 -yscrollcommand {.vpane.lower.diff.body.sby set} \
2341 -state disabled
2342scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2343 -command [list $ui_diff xview]
2344scrollbar .vpane.lower.diff.body.sby -orient vertical \
2345 -command [list $ui_diff yview]
2346pack .vpane.lower.diff.body.sbx -side bottom -fill x
2347pack .vpane.lower.diff.body.sby -side right -fill y
2348pack $ui_diff -side left -fill both -expand 1
2349pack .vpane.lower.diff.header -side top -fill x
2350pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2351
2352$ui_diff tag conf d_cr -elide true
2353$ui_diff tag conf d_@ -foreground blue -font font_diffbold
2354$ui_diff tag conf d_+ -foreground {#00a000}
2355$ui_diff tag conf d_- -foreground red
2356
2357$ui_diff tag conf d_++ -foreground {#00a000}
2358$ui_diff tag conf d_-- -foreground red
2359$ui_diff tag conf d_+s \
2360 -foreground {#00a000} \
2361 -background {#e2effa}
2362$ui_diff tag conf d_-s \
2363 -foreground red \
2364 -background {#e2effa}
2365$ui_diff tag conf d_s+ \
2366 -foreground {#00a000} \
2367 -background ivory1
2368$ui_diff tag conf d_s- \
2369 -foreground red \
2370 -background ivory1
2371
2372$ui_diff tag conf d<<<<<<< \
2373 -foreground orange \
2374 -font font_diffbold
2375$ui_diff tag conf d======= \
2376 -foreground orange \
2377 -font font_diffbold
2378$ui_diff tag conf d>>>>>>> \
2379 -foreground orange \
2380 -font font_diffbold
2381
2382$ui_diff tag raise sel
2383
2384# -- Diff Body Context Menu
2385#
2386set ctxm .vpane.lower.diff.body.ctxm
2387menu $ctxm -tearoff 0
2388$ctxm add command \
2389 -label {Refresh} \
2390 -command reshow_diff
2391lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2392$ctxm add command \
2393 -label {Copy} \
2394 -command {tk_textCopy $ui_diff}
2395lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2396$ctxm add command \
2397 -label {Select All} \
2398 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2399lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2400$ctxm add command \
2401 -label {Copy All} \
2402 -command {
2403 $ui_diff tag add sel 0.0 end
2404 tk_textCopy $ui_diff
2405 $ui_diff tag remove sel 0.0 end
2406 }
2407lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2408$ctxm add separator
2409$ctxm add command \
2410 -label {Apply/Reverse Hunk} \
2411 -command {apply_hunk $cursorX $cursorY}
2412set ui_diff_applyhunk [$ctxm index last]
2413lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2414$ctxm add separator
2415$ctxm add command \
2416 -label {Decrease Font Size} \
2417 -command {incr_font_size font_diff -1}
2418lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2419$ctxm add command \
2420 -label {Increase Font Size} \
2421 -command {incr_font_size font_diff 1}
2422lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2423$ctxm add separator
2424$ctxm add command \
2425 -label {Show Less Context} \
2426 -command {if {$repo_config(gui.diffcontext) >= 1} {
2427 incr repo_config(gui.diffcontext) -1
2428 reshow_diff
2429 }}
2430lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2431$ctxm add command \
2432 -label {Show More Context} \
2433 -command {if {$repo_config(gui.diffcontext) < 99} {
2434 incr repo_config(gui.diffcontext)
2435 reshow_diff
2436 }}
2437lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2438$ctxm add separator
2439$ctxm add command -label {Options...} \
2440 -command do_options
2441proc popup_diff_menu {ctxm x y X Y} {
2442 global current_diff_path file_states
2443 set ::cursorX $x
2444 set ::cursorY $y
2445 if {$::ui_index eq $::current_diff_side} {
2446 set l "Unstage Hunk From Commit"
2447 } else {
2448 set l "Stage Hunk For Commit"
2449 }
2450 if {$::is_3way_diff
2451 || $current_diff_path eq {}
2452 || ![info exists file_states($current_diff_path)]
2453 || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2454 set s disabled
2455 } else {
2456 set s normal
2457 }
2458 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2459 tk_popup $ctxm $X $Y
2460}
2461bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2462
2463# -- Status Bar
2464#
2465set main_status [::status_bar::new .status]
2466pack .status -anchor w -side bottom -fill x
2467$main_status show {Initializing...}
2468
2469# -- Load geometry
2470#
2471catch {
2472set gm $repo_config(gui.geometry)
2473wm geometry . [lindex $gm 0]
2474.vpane sash place 0 \
2475 [lindex [.vpane sash coord 0] 0] \
2476 [lindex $gm 1]
2477.vpane.files sash place 0 \
2478 [lindex $gm 2] \
2479 [lindex [.vpane.files sash coord 0] 1]
2480unset gm
2481}
2482
2483# -- Key Bindings
2484#
2485bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2486bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2487bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2488bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2489bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2490bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2491bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2492bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2493bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2494bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2495bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2496
2497bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2498bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2499bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2500bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2501bind $ui_diff <$M1B-Key-v> {break}
2502bind $ui_diff <$M1B-Key-V> {break}
2503bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2504bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2505bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
2506bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
2507bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
2508bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
2509bind $ui_diff <Key-k> {catch {%W yview scroll -1 units};break}
2510bind $ui_diff <Key-j> {catch {%W yview scroll 1 units};break}
2511bind $ui_diff <Key-h> {catch {%W xview scroll -1 units};break}
2512bind $ui_diff <Key-l> {catch {%W xview scroll 1 units};break}
2513bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2514bind $ui_diff <Control-Key-f> {catch {%W yview scroll 1 pages};break}
2515bind $ui_diff <Button-1> {focus %W}
2516
2517if {[is_enabled branch]} {
2518 bind . <$M1B-Key-n> branch_create::dialog
2519 bind . <$M1B-Key-N> branch_create::dialog
2520 bind . <$M1B-Key-o> branch_checkout::dialog
2521 bind . <$M1B-Key-O> branch_checkout::dialog
2522 bind . <$M1B-Key-m> merge::dialog
2523 bind . <$M1B-Key-M> merge::dialog
2524}
2525if {[is_enabled transport]} {
2526 bind . <$M1B-Key-p> do_push_anywhere
2527 bind . <$M1B-Key-P> do_push_anywhere
2528}
2529
2530bind . <Key-F5> do_rescan
2531bind . <$M1B-Key-r> do_rescan
2532bind . <$M1B-Key-R> do_rescan
2533bind . <$M1B-Key-s> do_signoff
2534bind . <$M1B-Key-S> do_signoff
2535bind . <$M1B-Key-i> do_add_all
2536bind . <$M1B-Key-I> do_add_all
2537bind . <$M1B-Key-Return> do_commit
2538foreach i [list $ui_index $ui_workdir] {
2539 bind $i <Button-1> "toggle_or_diff $i %x %y; break"
2540 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2541 bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2542}
2543unset i
2544
2545set file_lists($ui_index) [list]
2546set file_lists($ui_workdir) [list]
2547
2548wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2549focus -force $ui_comm
2550
2551# -- Warn the user about environmental problems. Cygwin's Tcl
2552# does *not* pass its env array onto any processes it spawns.
2553# This means that git processes get none of our environment.
2554#
2555if {[is_Cygwin]} {
2556 set ignored_env 0
2557 set suggest_user {}
2558 set msg "Possible environment issues exist.
2559
2560The following environment variables are probably
2561going to be ignored by any Git subprocess run
2562by [appname]:
2563
2564"
2565 foreach name [array names env] {
2566 switch -regexp -- $name {
2567 {^GIT_INDEX_FILE$} -
2568 {^GIT_OBJECT_DIRECTORY$} -
2569 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2570 {^GIT_DIFF_OPTS$} -
2571 {^GIT_EXTERNAL_DIFF$} -
2572 {^GIT_PAGER$} -
2573 {^GIT_TRACE$} -
2574 {^GIT_CONFIG$} -
2575 {^GIT_CONFIG_LOCAL$} -
2576 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2577 append msg " - $name\n"
2578 incr ignored_env
2579 }
2580 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2581 append msg " - $name\n"
2582 incr ignored_env
2583 set suggest_user $name
2584 }
2585 }
2586 }
2587 if {$ignored_env > 0} {
2588 append msg "
2589This is due to a known issue with the
2590Tcl binary distributed by Cygwin."
2591
2592 if {$suggest_user ne {}} {
2593 append msg "
2594
2595A good replacement for $suggest_user
2596is placing values for the user.name and
2597user.email settings into your personal
2598~/.gitconfig file.
2599"
2600 }
2601 warn_popup $msg
2602 }
2603 unset ignored_env msg suggest_user name
2604}
2605
2606# -- Only initialize complex UI if we are going to stay running.
2607#
2608if {[is_enabled transport]} {
2609 load_all_remotes
2610
2611 populate_fetch_menu
2612 populate_push_menu
2613}
2614
2615if {[winfo exists $ui_comm]} {
2616 set GITGUI_BCK_exists [load_message GITGUI_BCK]
2617
2618 # -- If both our backup and message files exist use the
2619 # newer of the two files to initialize the buffer.
2620 #
2621 if {$GITGUI_BCK_exists} {
2622 set m [gitdir GITGUI_MSG]
2623 if {[file isfile $m]} {
2624 if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2625 catch {file delete [gitdir GITGUI_MSG]}
2626 } else {
2627 $ui_comm delete 0.0 end
2628 $ui_comm edit reset
2629 $ui_comm edit modified false
2630 catch {file delete [gitdir GITGUI_BCK]}
2631 set GITGUI_BCK_exists 0
2632 }
2633 }
2634 unset m
2635 }
2636
2637 proc backup_commit_buffer {} {
2638 global ui_comm GITGUI_BCK_exists
2639
2640 set m [$ui_comm edit modified]
2641 if {$m || $GITGUI_BCK_exists} {
2642 set msg [string trim [$ui_comm get 0.0 end]]
2643 regsub -all -line {[ \r\t]+$} $msg {} msg
2644
2645 if {$msg eq {}} {
2646 if {$GITGUI_BCK_exists} {
2647 catch {file delete [gitdir GITGUI_BCK]}
2648 set GITGUI_BCK_exists 0
2649 }
2650 } elseif {$m} {
2651 catch {
2652 set fd [open [gitdir GITGUI_BCK] w]
2653 puts -nonewline $fd $msg
2654 close $fd
2655 set GITGUI_BCK_exists 1
2656 }
2657 }
2658
2659 $ui_comm edit modified false
2660 }
2661
2662 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2663 }
2664
2665 backup_commit_buffer
2666}
2667
2668lock_index begin-read
2669if {![winfo ismapped .]} {
2670 wm deiconify .
2671}
2672after 1 do_rescan
2673if {[is_enabled multicommit]} {
2674 after 1000 hint_gc
2675}