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