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