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