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