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