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