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