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