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