2 # Tcl ignores the next line -*- tcl -*- \
3 if test "z$*" = zversion \
4 ||
test "z$*" = z--version
; \
6 echo 'git-gui version @@GITGUI_VERSION@@'; \
11 set appvers
{@@GITGUI_VERSION@@
}
13 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
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.
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.
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
}
29 ######################################################################
31 ## Tcl/Tk sanity check
33 if {[catch
{package require Tcl
8.4} err
]
34 ||
[catch
{package require Tk
8.4} err
]
40 -title "git-gui: fatal error" \
45 ######################################################################
47 ## enable verbose loading?
49 if {![catch
{set _verbose
$env(GITGUI_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]
56 rename
source real__source
58 puts stderr
"source $name"
59 uplevel
1 real__source
$name
63 ######################################################################
65 ## configure our library
67 set oguilib
{@@GITGUI_LIBDIR@@
}
68 set oguirel
{@@GITGUI_RELATIVE@@
}
69 if {$oguirel eq
{1}} {
70 set oguilib
[file dirname [file dirname [file normalize
$argv0]]]
71 set oguilib
[file join $oguilib share git-gui lib
]
72 } elseif
{[string match @@
* $oguirel]} {
73 set oguilib
[file join [file dirname [file normalize
$argv0]] lib
]
76 set idx
[file join $oguilib tclIndex
]
77 if {[catch
{set fd
[open
$idx r
]} err
]} {
82 -title "git-gui: fatal error" \
86 if {[gets
$fd] eq
{# Autogenerated by git-gui Makefile}} {
88 while {[gets
$fd n
] >= 0} {
89 if {$n ne
{} && ![string match
#* $n]} {
101 if {[lsearch
-exact $loaded $p] >= 0} continue
102 source [file join $oguilib $p]
107 set auto_path
[concat
[list
$oguilib] $auto_path]
109 unset -nocomplain oguirel idx fd
111 ######################################################################
115 set _appname
[lindex
[file split $argv0] end
]
132 return [eval [list
file join $_gitdir] $args]
135 proc gitexec
{args
} {
137 if {$_gitexec eq
{}} {
138 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
139 error
"Git not installed?\n\n$err"
142 set _gitexec
[exec cygpath \
147 set _gitexec
[file normalize
$_gitexec]
153 return [eval [list
file join $_gitexec] $args]
162 global tcl_platform tk_library
163 if {[tk windowingsystem
] eq
{aqua
}} {
171 if {$tcl_platform(platform
) eq
{windows
}} {
178 global tcl_platform _iscygwin
179 if {$_iscygwin eq
{}} {
180 if {$tcl_platform(platform
) eq
{windows
}} {
181 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
193 proc is_enabled
{option
} {
194 global enabled_options
195 if {[catch
{set on
$enabled_options($option)}]} {return 0}
199 proc enable_option
{option
} {
200 global enabled_options
201 set enabled_options
($option) 1
204 proc disable_option
{option
} {
205 global enabled_options
206 set enabled_options
($option) 0
209 ######################################################################
213 proc is_many_config
{name
} {
214 switch
-glob -- $name {
223 proc is_config_true
{name
} {
225 if {[catch
{set v
$repo_config($name)}]} {
227 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
234 proc get_config
{name
} {
236 if {[catch
{set v
$repo_config($name)}]} {
243 proc load_config
{include_global
} {
244 global repo_config global_config default_config
246 array
unset global_config
247 if {$include_global} {
249 set fd_rc
[git_read config
--global --list]
250 while {[gets
$fd_rc line
] >= 0} {
251 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
252 if {[is_many_config
$name]} {
253 lappend global_config
($name) $value
255 set global_config
($name) $value
263 array
unset repo_config
265 set fd_rc
[git_read config
--list]
266 while {[gets
$fd_rc line
] >= 0} {
267 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
268 if {[is_many_config
$name]} {
269 lappend repo_config
($name) $value
271 set repo_config
($name) $value
278 foreach name
[array names default_config
] {
279 if {[catch
{set v
$global_config($name)}]} {
280 set global_config
($name) $default_config($name)
282 if {[catch
{set v
$repo_config($name)}]} {
283 set repo_config
($name) $default_config($name)
288 ######################################################################
292 proc _git_cmd
{name
} {
295 if {[catch
{set v
$_git_cmd_path($name)}]} {
298 --exec-path { return [list $
::_git
$name] }
301 set p
[gitexec git-
$name$
::_search_exe
]
302 if {[file exists
$p]} {
304 } elseif
{[is_Cygwin
]} {
305 # On Cygwin git is a proper Cygwin program and knows
306 # how to properly restart the Cygwin environment and
307 # spawn its non-.exe support program.
309 set v
[list $
::_git
$name]
310 } elseif
{[is_Windows
]
312 && [file exists
[gitexec git-
$name]]} {
313 # Assume this is a UNIX shell script. We can
314 # probably execute it through a Bourne shell.
316 set v
[list $
::_sh
[gitexec git-
$name]]
318 # Assume it is builtin to git somehow and we
319 # aren't actually able to see a file for it.
321 set v
[list $
::_git
$name]
323 set _git_cmd_path
($name) $v
329 global env _search_exe _search_path
331 if {$_search_path eq
{}} {
333 set _search_path
[split [exec cygpath \
339 } elseif
{[is_Windows
]} {
340 set _search_path
[split $env(PATH
) {;}]
343 set _search_path
[split $env(PATH
) :]
348 foreach p
$_search_path {
349 set p
[file join $p $what$_search_exe]
350 if {[file exists
$p]} {
351 return [file normalize
$p]
361 switch
-- [lindex
$args 0] {
375 set args
[lrange
$args 1 end
]
378 set cmdp
[_git_cmd
[lindex
$args 0]]
379 set args
[lrange
$args 1 end
]
381 return [eval $opt $cmdp $args]
384 proc git_read
{args
} {
388 switch
-- [lindex
$args 0] {
406 set args
[lrange
$args 1 end
]
409 set cmdp
[_git_cmd
[lindex
$args 0]]
410 set args
[lrange
$args 1 end
]
413 set fd
[open
[concat
$opt $cmdp $args] r
]
415 if { [lindex
$args end
] eq
{2>@
1}
416 && $err eq
{can not
find channel named
"1"}
418 # Older versions of Tcl 8.4 don't have this 2>@1 IO
419 # redirect operator. Fallback to |& cat for those.
420 # The command was not actually started, so its safe
421 # to try to start it a second time.
423 set fd
[open
[concat \
426 [lrange
$args 0 end-1
] \
436 proc git_write
{args
} {
440 switch
-- [lindex
$args 0] {
454 set args
[lrange
$args 1 end
]
457 set cmdp
[_git_cmd
[lindex
$args 0]]
458 set args
[lrange
$args 1 end
]
460 return [open
[concat
$opt $cmdp $args] w
]
463 proc load_current_branch
{} {
464 global current_branch is_detached
466 set fd
[open
[gitdir HEAD
] r
]
467 if {[gets
$fd ref
] < 1} {
472 set pfx
{ref
: refs
/heads
/}
473 set len
[string length
$pfx]
474 if {[string equal
-length $len $pfx $ref]} {
475 # We're on a branch. It might not exist. But
476 # HEAD looks good enough to be a branch.
478 set current_branch
[string range
$ref $len end
]
481 # Assume this is a detached head.
483 set current_branch HEAD
488 auto_load tk_optionMenu
489 rename tk_optionMenu real__tkOptionMenu
490 proc tk_optionMenu
{w varName args
} {
491 set m
[eval real__tkOptionMenu
$w $varName $args]
492 $m configure
-font font_ui
493 $w configure
-font font_ui
497 ######################################################################
501 set _git
[_which git
]
503 catch
{wm withdraw .
}
504 error_popup
"Cannot find git in PATH."
507 set _nice
[_which nice
]
510 ######################################################################
514 if {[catch
{set _git_version
[git
--version]} err
]} {
515 catch
{wm withdraw .
}
516 error_popup
"Cannot determine Git version:
520 [appname] requires Git 1.5.0 or later."
523 if {![regsub
{^git version
} $_git_version {} _git_version
]} {
524 catch
{wm withdraw .
}
525 error_popup
"Cannot parse Git version string:\n\n$_git_version"
528 regsub
{\.
[0-9]+\.g
[0-9a-f]+$
} $_git_version {} _git_version
529 regsub
{\.rc
[0-9]+$
} $_git_version {} _git_version
531 proc git-version
{args
} {
534 switch
[llength
$args] {
540 set op
[lindex
$args 0]
541 set vr
[lindex
$args 1]
542 set cm
[package vcompare
$_git_version $vr]
543 return [expr $cm $op 0]
547 set type [lindex
$args 0]
548 set name
[lindex
$args 1]
549 set parm
[lindex
$args 2]
550 set body
[lindex
$args 3]
552 if {($type ne
{proc
} && $type ne
{method
})} {
553 error
"Invalid arguments to git-version"
555 if {[llength
$body] < 2 ||
[lindex
$body end-1
] ne
{default
}} {
556 error
"Last arm of $type $name must be default"
559 foreach
{op vr cb
} [lrange
$body 0 end-2
] {
560 if {[git-version
$op $vr]} {
561 return [uplevel
[list
$type $name $parm $cb]]
565 return [uplevel
[list
$type $name $parm [lindex
$body end
]]]
569 error
"git-version >= x"
575 if {[git-version
< 1.5]} {
576 catch
{wm withdraw .
}
577 error_popup
"[appname] requires Git 1.5.0 or later.
579 You are using [git-version]:
585 ######################################################################
590 set _gitdir
$env(GIT_DIR
)
594 set _gitdir
[git rev-parse
--git-dir]
595 set _prefix
[git rev-parse
--show-prefix]
597 catch
{wm withdraw .
}
598 error_popup
"Cannot find the git directory:\n\n$err"
601 if {![file isdirectory
$_gitdir] && [is_Cygwin
]} {
602 catch
{set _gitdir
[exec cygpath
--unix $_gitdir]}
604 if {![file isdirectory
$_gitdir]} {
605 catch
{wm withdraw .
}
606 error_popup
"Git directory not found:\n\n$_gitdir"
609 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
610 catch
{wm withdraw .
}
611 error_popup
"Cannot use funny .git directory:\n\n$_gitdir"
614 if {[catch
{cd [file dirname $_gitdir]} err
]} {
615 catch
{wm withdraw .
}
616 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
619 set _reponame
[lindex
[file split \
620 [file normalize
[file dirname $_gitdir]]] \
623 ######################################################################
627 set current_diff_path
{}
628 set current_diff_side
{}
629 set diff_actions
[list
]
633 set MERGE_HEAD
[list
]
636 set current_branch
{}
638 set current_diff_path
{}
639 set selected_commit_type new
641 ######################################################################
649 set disable_on_lock
[list
]
650 set index_lock_type none
652 proc lock_index
{type} {
653 global index_lock_type disable_on_lock
655 if {$index_lock_type eq
{none
}} {
656 set index_lock_type
$type
657 foreach w
$disable_on_lock {
658 uplevel
#0 $w disabled
661 } elseif
{$index_lock_type eq
"begin-$type"} {
662 set index_lock_type
$type
668 proc unlock_index
{} {
669 global index_lock_type disable_on_lock
671 set index_lock_type none
672 foreach w
$disable_on_lock {
677 ######################################################################
681 proc repository_state
{ctvar hdvar mhvar
} {
682 global current_branch
683 upvar
$ctvar ct
$hdvar hd
$mhvar mh
688 if {[catch
{set hd
[git rev-parse
--verify HEAD
]}]} {
694 set merge_head
[gitdir MERGE_HEAD
]
695 if {[file exists
$merge_head]} {
697 set fd_mh
[open
$merge_head r
]
698 while {[gets
$fd_mh line
] >= 0} {
709 global PARENT empty_tree
711 set p
[lindex
$PARENT 0]
715 if {$empty_tree eq
{}} {
716 set empty_tree
[git mktree
<< {}]
721 proc rescan
{after
{honor_trustmtime
1}} {
722 global HEAD PARENT MERGE_HEAD commit_type
723 global ui_index ui_workdir ui_comm
724 global rescan_active file_states
727 if {$rescan_active > 0 ||
![lock_index
read]} return
729 repository_state newType newHEAD newMERGE_HEAD
730 if {[string match amend
* $commit_type]
731 && $newType eq
{normal
}
732 && $newHEAD eq
$HEAD} {
736 set MERGE_HEAD
$newMERGE_HEAD
737 set commit_type
$newType
740 array
unset file_states
742 if {![$ui_comm edit modified
]
743 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
744 if {[string match amend
* $commit_type]} {
745 } elseif
{[load_message GITGUI_MSG
]} {
746 } elseif
{[load_message MERGE_MSG
]} {
747 } elseif
{[load_message SQUASH_MSG
]} {
750 $ui_comm edit modified false
753 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
754 rescan_stage2
{} $after
757 ui_status
{Refreshing
file status...
}
758 set fd_rf
[git_read update-index \
764 fconfigure
$fd_rf -blocking 0 -translation binary
765 fileevent
$fd_rf readable \
766 [list rescan_stage2
$fd_rf $after]
770 proc rescan_stage2
{fd after
} {
771 global rescan_active buf_rdi buf_rdf buf_rlo
775 if {![eof
$fd]} return
779 set ls_others
[list
--exclude-per-directory=.gitignore
]
780 set info_exclude
[gitdir info exclude
]
781 if {[file readable
$info_exclude]} {
782 lappend ls_others
"--exclude-from=$info_exclude"
790 ui_status
{Scanning
for modified files ...
}
791 set fd_di
[git_read diff-index
--cached -z [PARENT
]]
792 set fd_df
[git_read diff-files
-z]
793 set fd_lo
[eval git_read ls-files
--others -z $ls_others]
795 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
796 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
797 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
798 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
799 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
800 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
803 proc load_message
{file} {
807 if {[file isfile
$f]} {
808 if {[catch
{set fd
[open
$f r
]}]} {
811 set content
[string trim
[read $fd]]
813 regsub
-all -line {[ \r\t]+$
} $content {} content
814 $ui_comm delete
0.0 end
815 $ui_comm insert end
$content
821 proc read_diff_index
{fd after
} {
824 append buf_rdi
[read $fd]
826 set n
[string length
$buf_rdi]
828 set z1
[string first
"\0" $buf_rdi $c]
831 set z2
[string first
"\0" $buf_rdi $z1]
835 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
836 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
838 [encoding convertfrom
$p] \
840 [list
[lindex
$i 0] [lindex
$i 2]] \
846 set buf_rdi
[string range
$buf_rdi $c end
]
851 rescan_done
$fd buf_rdi
$after
854 proc read_diff_files
{fd after
} {
857 append buf_rdf
[read $fd]
859 set n
[string length
$buf_rdf]
861 set z1
[string first
"\0" $buf_rdf $c]
864 set z2
[string first
"\0" $buf_rdf $z1]
868 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
869 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
871 [encoding convertfrom
$p] \
874 [list
[lindex
$i 0] [lindex
$i 2]]
879 set buf_rdf
[string range
$buf_rdf $c end
]
884 rescan_done
$fd buf_rdf
$after
887 proc read_ls_others
{fd after
} {
890 append buf_rlo
[read $fd]
891 set pck
[split $buf_rlo "\0"]
892 set buf_rlo
[lindex
$pck end
]
893 foreach p
[lrange
$pck 0 end-1
] {
894 merge_state
[encoding convertfrom
$p] ?O
896 rescan_done
$fd buf_rlo
$after
899 proc rescan_done
{fd buf after
} {
900 global rescan_active current_diff_path
901 global file_states repo_config
904 if {![eof
$fd]} return
907 if {[incr rescan_active
-1] > 0} return
912 if {$current_diff_path ne
{}} reshow_diff
916 proc prune_selection
{} {
917 global file_states selected_paths
919 foreach path
[array names selected_paths
] {
920 if {[catch
{set still_here
$file_states($path)}]} {
921 unset selected_paths
($path)
926 ######################################################################
930 proc mapicon
{w state path
} {
933 if {[catch
{set r
$all_icons($state$w)}]} {
934 puts
"error: no icon for $w state={$state} $path"
940 proc mapdesc
{state path
} {
943 if {[catch
{set r
$all_descs($state)}]} {
944 puts
"error: no desc for state={$state} $path"
950 proc ui_status
{msg
} {
951 $
::main_status show
$msg
954 proc ui_ready
{{test {}}} {
955 $
::main_status show
{Ready.
} $test
958 proc escape_path
{path
} {
959 regsub
-all {\\} $path "\\\\" path
960 regsub
-all "\n" $path "\\n" path
964 proc short_path
{path
} {
965 return [escape_path
[lindex
[file split $path] end
]]
969 set null_sha1
[string repeat
0 40]
971 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
972 global file_states next_icon_id null_sha1
974 set s0
[string index
$new_state 0]
975 set s1
[string index
$new_state 1]
977 if {[catch
{set info
$file_states($path)}]} {
979 set icon n
[incr next_icon_id
]
981 set state
[lindex
$info 0]
982 set icon
[lindex
$info 1]
983 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
984 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
987 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
988 elseif
{$s0 eq
{_
}} {set s0 _
}
990 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
991 elseif
{$s1 eq
{_
}} {set s1 _
}
993 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
994 set head_info
[list
0 $null_sha1]
995 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
996 && $head_info eq
{}} {
997 set head_info
$index_info
1000 set file_states
($path) [list
$s0$s1 $icon \
1001 $head_info $index_info \
1006 proc display_file_helper
{w path icon_name old_m new_m
} {
1009 if {$new_m eq
{_
}} {
1010 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1012 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1014 $w conf
-state normal
1015 $w delete
$lno.0 [expr {$lno + 1}].0
1016 $w conf
-state disabled
1018 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1019 lappend file_lists
($w) $path
1020 set file_lists
($w) [lsort
-unique $file_lists($w)]
1021 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1023 $w conf
-state normal
1024 $w image create
$lno.0 \
1025 -align center
-padx 5 -pady 1 \
1027 -image [mapicon
$w $new_m $path]
1028 $w insert
$lno.1 "[escape_path $path]\n"
1029 $w conf
-state disabled
1030 } elseif
{$old_m ne
$new_m} {
1031 $w conf
-state normal
1032 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1033 $w conf
-state disabled
1037 proc display_file
{path state
} {
1038 global file_states selected_paths
1039 global ui_index ui_workdir
1041 set old_m
[merge_state
$path $state]
1042 set s
$file_states($path)
1043 set new_m
[lindex
$s 0]
1044 set icon_name
[lindex
$s 1]
1046 set o
[string index
$old_m 0]
1047 set n
[string index
$new_m 0]
1054 display_file_helper
$ui_index $path $icon_name $o $n
1056 if {[string index
$old_m 0] eq
{U
}} {
1059 set o
[string index
$old_m 1]
1061 if {[string index
$new_m 0] eq
{U
}} {
1064 set n
[string index
$new_m 1]
1066 display_file_helper
$ui_workdir $path $icon_name $o $n
1068 if {$new_m eq
{__
}} {
1069 unset file_states
($path)
1070 catch
{unset selected_paths
($path)}
1074 proc display_all_files_helper
{w path icon_name m
} {
1077 lappend file_lists
($w) $path
1078 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1079 $w image create end \
1080 -align center
-padx 5 -pady 1 \
1082 -image [mapicon
$w $m $path]
1083 $w insert end
"[escape_path $path]\n"
1086 proc display_all_files
{} {
1087 global ui_index ui_workdir
1088 global file_states file_lists
1091 $ui_index conf
-state normal
1092 $ui_workdir conf
-state normal
1094 $ui_index delete
0.0 end
1095 $ui_workdir delete
0.0 end
1098 set file_lists
($ui_index) [list
]
1099 set file_lists
($ui_workdir) [list
]
1101 foreach path
[lsort
[array names file_states
]] {
1102 set s
$file_states($path)
1104 set icon_name
[lindex
$s 1]
1106 set s
[string index
$m 0]
1107 if {$s ne
{U
} && $s ne
{_
}} {
1108 display_all_files_helper
$ui_index $path \
1112 if {[string index
$m 0] eq
{U
}} {
1115 set s
[string index
$m 1]
1118 display_all_files_helper
$ui_workdir $path \
1123 $ui_index conf
-state disabled
1124 $ui_workdir conf
-state disabled
1127 ######################################################################
1132 #define mask_width 14
1133 #define mask_height 15
1134 static unsigned char mask_bits
[] = {
1135 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1136 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1137 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1140 image create bitmap file_plain
-background white
-foreground black
-data {
1141 #define plain_width 14
1142 #define plain_height 15
1143 static unsigned char plain_bits
[] = {
1144 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1145 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1146 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1147 } -maskdata $filemask
1149 image create bitmap file_mod
-background white
-foreground blue
-data {
1150 #define mod_width 14
1151 #define mod_height 15
1152 static unsigned char mod_bits
[] = {
1153 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1154 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1155 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1156 } -maskdata $filemask
1158 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
1159 #define file_fulltick_width 14
1160 #define file_fulltick_height 15
1161 static unsigned char file_fulltick_bits
[] = {
1162 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1163 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1164 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1165 } -maskdata $filemask
1167 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1168 #define parttick_width 14
1169 #define parttick_height 15
1170 static unsigned char parttick_bits
[] = {
1171 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1172 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1173 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1174 } -maskdata $filemask
1176 image create bitmap file_question
-background white
-foreground black
-data {
1177 #define file_question_width 14
1178 #define file_question_height 15
1179 static unsigned char file_question_bits
[] = {
1180 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1181 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1182 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1183 } -maskdata $filemask
1185 image create bitmap file_removed
-background white
-foreground red
-data {
1186 #define file_removed_width 14
1187 #define file_removed_height 15
1188 static unsigned char file_removed_bits
[] = {
1189 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1190 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1191 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1192 } -maskdata $filemask
1194 image create bitmap file_merge
-background white
-foreground blue
-data {
1195 #define file_merge_width 14
1196 #define file_merge_height 15
1197 static unsigned char file_merge_bits
[] = {
1198 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1199 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1200 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1201 } -maskdata $filemask
1204 #define file_width 18
1205 #define file_height 18
1206 static unsigned char file_bits
[] = {
1207 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
1208 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
1209 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
1210 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
1211 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
1213 image create bitmap file_dir
-background white
-foreground blue \
1214 -data $file_dir_data -maskdata $file_dir_data
1217 set file_uplevel_data
{
1219 #define up_height 15
1220 static unsigned char up_bits
[] = {
1221 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
1222 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
1223 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
1225 image create bitmap file_uplevel
-background white
-foreground red \
1226 -data $file_uplevel_data -maskdata $file_uplevel_data
1227 unset file_uplevel_data
1229 set ui_index .vpane.files.index.list
1230 set ui_workdir .vpane.files.workdir.list
1232 set all_icons
(_
$ui_index) file_plain
1233 set all_icons
(A
$ui_index) file_fulltick
1234 set all_icons
(M
$ui_index) file_fulltick
1235 set all_icons
(D
$ui_index) file_removed
1236 set all_icons
(U
$ui_index) file_merge
1238 set all_icons
(_
$ui_workdir) file_plain
1239 set all_icons
(M
$ui_workdir) file_mod
1240 set all_icons
(D
$ui_workdir) file_question
1241 set all_icons
(U
$ui_workdir) file_merge
1242 set all_icons
(O
$ui_workdir) file_plain
1244 set max_status_desc
0
1248 {_M
"Modified, not staged"}
1249 {M_
"Staged for commit"}
1250 {MM
"Portions staged for commit"}
1251 {MD
"Staged for commit, missing"}
1253 {_O
"Untracked, not staged"}
1254 {A_
"Staged for commit"}
1255 {AM
"Portions staged for commit"}
1256 {AD
"Staged for commit, missing"}
1259 {D_
"Staged for removal"}
1260 {DO
"Staged for removal, still present"}
1262 {U_
"Requires merge resolution"}
1263 {UU
"Requires merge resolution"}
1264 {UM
"Requires merge resolution"}
1265 {UD
"Requires merge resolution"}
1267 if {$max_status_desc < [string length
[lindex
$i 1]]} {
1268 set max_status_desc
[string length
[lindex
$i 1]]
1270 set all_descs
([lindex
$i 0]) [lindex
$i 1]
1274 ######################################################################
1278 proc bind_button3
{w cmd
} {
1279 bind $w <Any-Button-3
> $cmd
1281 bind $w <Control-Button-1
> $cmd
1285 proc scrollbar2many
{list mode args
} {
1286 foreach w
$list {eval $w $mode $args}
1289 proc many2scrollbar
{list mode sb top bottom
} {
1290 $sb set $top $bottom
1291 foreach w
$list {$w $mode moveto
$top}
1294 proc incr_font_size
{font
{amt
1}} {
1295 set sz
[font configure
$font -size]
1297 font configure
$font -size $sz
1298 font configure
${font}bold
-size $sz
1299 font configure
${font}italic
-size $sz
1302 ######################################################################
1306 set starting_gitk_msg
{Starting gitk... please
wait...
}
1308 proc do_gitk
{revs
} {
1309 # -- Always start gitk through whatever we were loaded with. This
1310 # lets us bypass using shell process on Windows systems.
1312 set exe
[file join [file dirname $
::_git
] gitk
]
1313 set cmd
[list
[info nameofexecutable
] $exe]
1314 if {! [file exists
$exe]} {
1315 error_popup
"Unable to start gitk:\n\n$exe does not exist"
1317 eval exec $cmd $revs &
1318 ui_status $
::starting_gitk_msg
1320 ui_ready
$starting_gitk_msg
1328 global ui_comm is_quitting repo_config commit_type
1330 if {$is_quitting} return
1333 if {[winfo exists
$ui_comm]} {
1334 # -- Stash our current commit buffer.
1336 set save
[gitdir GITGUI_MSG
]
1337 set msg
[string trim
[$ui_comm get
0.0 end
]]
1338 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1339 if {(![string match amend
* $commit_type]
1340 ||
[$ui_comm edit modified
])
1343 set fd
[open
$save w
]
1344 puts
-nonewline $fd $msg
1348 catch
{file delete
$save}
1351 # -- Stash our current window geometry into this repository.
1353 set cfg_geometry
[list
]
1354 lappend cfg_geometry
[wm geometry .
]
1355 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1356 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1357 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1360 if {$cfg_geometry ne
$rc_geometry} {
1361 catch
{git config gui.geometry
$cfg_geometry}
1376 proc toggle_or_diff
{w x y
} {
1377 global file_states file_lists current_diff_path ui_index ui_workdir
1378 global last_clicked selected_paths
1380 set pos
[split [$w index @
$x,$y] .
]
1381 set lno
[lindex
$pos 0]
1382 set col [lindex
$pos 1]
1383 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1389 set last_clicked
[list
$w $lno]
1390 array
unset selected_paths
1391 $ui_index tag remove in_sel
0.0 end
1392 $ui_workdir tag remove in_sel
0.0 end
1395 if {$current_diff_path eq
$path} {
1396 set after
{reshow_diff
;}
1400 if {$w eq
$ui_index} {
1402 "Unstaging [short_path $path] from commit" \
1404 [concat
$after [list ui_ready
]]
1405 } elseif
{$w eq
$ui_workdir} {
1407 "Adding [short_path $path]" \
1409 [concat
$after [list ui_ready
]]
1412 show_diff
$path $w $lno
1416 proc add_one_to_selection
{w x y
} {
1417 global file_lists last_clicked selected_paths
1419 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1420 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1426 if {$last_clicked ne
{}
1427 && [lindex
$last_clicked 0] ne
$w} {
1428 array
unset selected_paths
1429 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1432 set last_clicked
[list
$w $lno]
1433 if {[catch
{set in_sel
$selected_paths($path)}]} {
1437 unset selected_paths
($path)
1438 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1440 set selected_paths
($path) 1
1441 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1445 proc add_range_to_selection
{w x y
} {
1446 global file_lists last_clicked selected_paths
1448 if {[lindex
$last_clicked 0] ne
$w} {
1449 toggle_or_diff
$w $x $y
1453 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1454 set lc
[lindex
$last_clicked 1]
1463 foreach path
[lrange
$file_lists($w) \
1464 [expr {$begin - 1}] \
1465 [expr {$end - 1}]] {
1466 set selected_paths
($path) 1
1468 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1471 ######################################################################
1475 set cursor_ptr arrow
1476 font create font_diff
-family Courier
-size 10
1480 eval font configure font_ui
[font actual
[.dummy cget
-font]]
1484 font create font_uiitalic
1485 font create font_uibold
1486 font create font_diffbold
1487 font create font_diffitalic
1489 foreach class
{Button Checkbutton Entry Label
1490 Labelframe Listbox Menu Message
1491 Radiobutton Spinbox Text
} {
1492 option add
*$class.font font_ui
1496 if {[is_Windows
] ||
[is_MacOSX
]} {
1497 option add
*Menu.tearOff
0
1508 proc apply_config
{} {
1509 global repo_config font_descs
1511 foreach option
$font_descs {
1512 set name
[lindex
$option 0]
1513 set font
[lindex
$option 1]
1515 foreach
{cn cv
} $repo_config(gui.
$name) {
1516 font configure
$font $cn $cv
1519 error_popup
"Invalid font specified in gui.$name:\n\n$err"
1521 foreach
{cn cv
} [font configure
$font] {
1522 font configure
${font}bold
$cn $cv
1523 font configure
${font}italic
$cn $cv
1525 font configure
${font}bold
-weight bold
1526 font configure
${font}italic
-slant italic
1530 set default_config
(merge.diffstat
) true
1531 set default_config
(merge.summary
) false
1532 set default_config
(merge.verbosity
) 2
1533 set default_config
(user.name
) {}
1534 set default_config
(user.email
) {}
1536 set default_config
(gui.matchtrackingbranch
) false
1537 set default_config
(gui.pruneduringfetch
) false
1538 set default_config
(gui.trustmtime
) false
1539 set default_config
(gui.diffcontext
) 5
1540 set default_config
(gui.newbranchtemplate
) {}
1541 set default_config
(gui.fontui
) [font configure font_ui
]
1542 set default_config
(gui.fontdiff
) [font configure font_diff
]
1544 {fontui font_ui
{Main Font
}}
1545 {fontdiff font_diff
{Diff
/Console Font
}}
1550 ######################################################################
1552 ## feature option selection
1554 if {[regexp
{^git-
(.
+)$
} [appname
] _junk subcommand
]} {
1559 if {$subcommand eq
{gui.sh
}} {
1562 if {$subcommand eq
{gui
} && [llength
$argv] > 0} {
1563 set subcommand
[lindex
$argv 0]
1564 set argv
[lrange
$argv 1 end
]
1567 enable_option multicommit
1568 enable_option branch
1569 enable_option transport
1571 switch
-- $subcommand {
1574 disable_option multicommit
1575 disable_option branch
1576 disable_option transport
1579 enable_option singlecommit
1581 disable_option multicommit
1582 disable_option branch
1583 disable_option transport
1587 ######################################################################
1595 menu .mbar
-tearoff 0
1596 .mbar add cascade
-label Repository
-menu .mbar.repository
1597 .mbar add cascade
-label Edit
-menu .mbar.edit
1598 if {[is_enabled branch
]} {
1599 .mbar add cascade
-label Branch
-menu .mbar.branch
1601 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1602 .mbar add cascade
-label Commit
-menu .mbar.commit
1604 if {[is_enabled transport
]} {
1605 .mbar add cascade
-label Merge
-menu .mbar.merge
1606 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1607 .mbar add cascade
-label Push
-menu .mbar.push
1609 . configure
-menu .mbar
1611 # -- Repository Menu
1613 menu .mbar.repository
1615 .mbar.repository add
command \
1616 -label {Browse Current Branch
} \
1617 -command {browser
::new
$current_branch}
1618 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1619 .mbar.repository add separator
1621 .mbar.repository add
command \
1622 -label {Visualize Current Branch
} \
1623 -command {do_gitk
$current_branch}
1624 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1625 .mbar.repository add
command \
1626 -label {Visualize All Branches
} \
1627 -command {do_gitk
--all}
1628 .mbar.repository add separator
1630 if {[is_enabled multicommit
]} {
1631 .mbar.repository add
command -label {Database Statistics
} \
1634 .mbar.repository add
command -label {Compress Database
} \
1637 .mbar.repository add
command -label {Verify Database
} \
1638 -command do_fsck_objects
1640 .mbar.repository add separator
1643 .mbar.repository add
command \
1644 -label {Create Desktop Icon
} \
1645 -command do_cygwin_shortcut
1646 } elseif
{[is_Windows
]} {
1647 .mbar.repository add
command \
1648 -label {Create Desktop Icon
} \
1649 -command do_windows_shortcut
1650 } elseif
{[is_MacOSX
]} {
1651 .mbar.repository add
command \
1652 -label {Create Desktop Icon
} \
1653 -command do_macosx_app
1657 .mbar.repository add
command -label Quit \
1664 .mbar.edit add
command -label Undo \
1665 -command {catch
{[focus
] edit undo
}} \
1667 .mbar.edit add
command -label Redo \
1668 -command {catch
{[focus
] edit redo
}} \
1670 .mbar.edit add separator
1671 .mbar.edit add
command -label Cut \
1672 -command {catch
{tk_textCut
[focus
]}} \
1674 .mbar.edit add
command -label Copy \
1675 -command {catch
{tk_textCopy
[focus
]}} \
1677 .mbar.edit add
command -label Paste \
1678 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1680 .mbar.edit add
command -label Delete \
1681 -command {catch
{[focus
] delete sel.first sel.last
}} \
1683 .mbar.edit add separator
1684 .mbar.edit add
command -label {Select All
} \
1685 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1690 if {[is_enabled branch
]} {
1693 .mbar.branch add
command -label {Create...
} \
1694 -command branch_create
::dialog \
1696 lappend disable_on_lock
[list .mbar.branch entryconf \
1697 [.mbar.branch index last
] -state]
1699 .mbar.branch add
command -label {Checkout...
} \
1700 -command branch_checkout
::dialog \
1702 lappend disable_on_lock
[list .mbar.branch entryconf \
1703 [.mbar.branch index last
] -state]
1705 .mbar.branch add
command -label {Rename...
} \
1706 -command branch_rename
::dialog
1707 lappend disable_on_lock
[list .mbar.branch entryconf \
1708 [.mbar.branch index last
] -state]
1710 .mbar.branch add
command -label {Delete...
} \
1711 -command branch_delete
::dialog
1712 lappend disable_on_lock
[list .mbar.branch entryconf \
1713 [.mbar.branch index last
] -state]
1715 .mbar.branch add
command -label {Reset...
} \
1716 -command merge
::reset_hard
1717 lappend disable_on_lock
[list .mbar.branch entryconf \
1718 [.mbar.branch index last
] -state]
1723 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1726 .mbar.commit add radiobutton \
1727 -label {New Commit
} \
1728 -command do_select_commit_type \
1729 -variable selected_commit_type \
1731 lappend disable_on_lock \
1732 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1734 .mbar.commit add radiobutton \
1735 -label {Amend Last Commit
} \
1736 -command do_select_commit_type \
1737 -variable selected_commit_type \
1739 lappend disable_on_lock \
1740 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1742 .mbar.commit add separator
1744 .mbar.commit add
command -label Rescan \
1745 -command do_rescan \
1747 lappend disable_on_lock \
1748 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1750 .mbar.commit add
command -label {Add To Commit
} \
1751 -command do_add_selection
1752 lappend disable_on_lock \
1753 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1755 .mbar.commit add
command -label {Add Existing To Commit
} \
1756 -command do_add_all \
1758 lappend disable_on_lock \
1759 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1761 .mbar.commit add
command -label {Unstage From Commit
} \
1762 -command do_unstage_selection
1763 lappend disable_on_lock \
1764 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1766 .mbar.commit add
command -label {Revert Changes
} \
1767 -command do_revert_selection
1768 lappend disable_on_lock \
1769 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1771 .mbar.commit add separator
1773 .mbar.commit add
command -label {Sign Off
} \
1774 -command do_signoff \
1777 .mbar.commit add
command -label Commit \
1778 -command do_commit \
1779 -accelerator $M1T-Return
1780 lappend disable_on_lock \
1781 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1786 if {[is_enabled branch
]} {
1788 .mbar.merge add
command -label {Local Merge...
} \
1789 -command merge
::dialog
1790 lappend disable_on_lock \
1791 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1792 .mbar.merge add
command -label {Abort Merge...
} \
1793 -command merge
::reset_hard
1794 lappend disable_on_lock \
1795 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1801 if {[is_enabled transport
]} {
1805 .mbar.push add
command -label {Push...
} \
1806 -command do_push_anywhere \
1808 .mbar.push add
command -label {Delete...
} \
1809 -command remote_branch_delete
::dialog
1813 # -- Apple Menu (Mac OS X only)
1815 .mbar add cascade
-label Apple
-menu .mbar.apple
1818 .mbar.apple add
command -label "About [appname]" \
1820 .mbar.apple add
command -label "Options..." \
1825 .mbar.edit add separator
1826 .mbar.edit add
command -label {Options...
} \
1831 if {[is_Cygwin
] && [file exists
/usr
/local
/miga
/lib
/gui-miga
]} {
1833 if {![lock_index update
]} return
1834 set cmd
[list sh
--login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1835 set miga_fd
[open
"|$cmd" r
]
1836 fconfigure
$miga_fd -blocking 0
1837 fileevent
$miga_fd readable
[list miga_done
$miga_fd]
1838 ui_status
{Running miga...
}
1840 proc miga_done
{fd
} {
1848 .mbar add cascade
-label Tools
-menu .mbar.tools
1850 .mbar.tools add
command -label "Migrate" \
1852 lappend disable_on_lock \
1853 [list .mbar.tools entryconf
[.mbar.tools index last
] -state]
1859 .mbar add cascade
-label Help
-menu .mbar.
help
1863 .mbar.
help add
command -label "About [appname]" \
1868 catch
{set browser
$repo_config(instaweb.browser
)}
1869 set doc_path
[file dirname [gitexec
]]
1870 set doc_path
[file join $doc_path Documentation index.html
]
1873 set doc_path
[exec cygpath
--mixed $doc_path]
1876 if {$browser eq
{}} {
1879 } elseif
{[is_Cygwin
]} {
1880 set program_files
[file dirname [exec cygpath
--windir]]
1881 set program_files
[file join $program_files {Program Files
}]
1882 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
1883 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
1884 if {[file exists
$firefox]} {
1885 set browser
$firefox
1886 } elseif
{[file exists
$ie]} {
1889 unset program_files firefox ie
1893 if {[file isfile
$doc_path]} {
1894 set doc_url
"file:$doc_path"
1896 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
1899 if {$browser ne
{}} {
1900 .mbar.
help add
command -label {Online Documentation
} \
1901 -command [list
exec $browser $doc_url &]
1903 unset browser doc_path doc_url
1905 # -- Standard bindings
1907 wm protocol . WM_DELETE_WINDOW do_quit
1908 bind all
<$M1B-Key-q> do_quit
1909 bind all
<$M1B-Key-Q> do_quit
1910 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1911 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1913 set subcommand_args
{}
1915 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
1919 # -- Not a normal commit type invocation? Do that instead!
1921 switch
-- $subcommand {
1923 set subcommand_args
{rev?
}
1924 switch
[llength
$argv] {
1925 0 { load_current_branch
}
1927 set current_branch
[lindex
$argv 0]
1928 if {[regexp
{^
[0-9a-f]{1,39}$
} $current_branch]} {
1930 set current_branch \
1931 [git rev-parse
--verify $current_branch]
1940 browser
::new
$current_branch
1944 set subcommand_args
{rev? path?
}
1949 if {$is_path ||
[file exists
$_prefix$a]} {
1950 if {$path ne
{}} usage
1953 } elseif
{$a eq
{--}} {
1955 if {$head ne
{}} usage
1960 } elseif
{$head eq
{}} {
1961 if {$head ne
{}} usage
1972 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
1974 set head [git rev-parse
--verify $head]
1980 set current_branch
$head
1983 if {$path eq
{}} usage
1984 blame
::new
$head $path
1989 if {[llength
$argv] != 0} {
1990 puts
-nonewline stderr
"usage: $argv0"
1991 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
1992 puts
-nonewline stderr
" $subcommand"
1997 # fall through to setup UI for commits
2000 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2011 -text {Current Branch
:} \
2015 -textvariable current_branch \
2018 pack .branch.l1
-side left
2019 pack .branch.cb
-side left
-fill x
2020 pack .branch
-side top
-fill x
2022 # -- Main Window Layout
2024 panedwindow .vpane
-orient vertical
2025 panedwindow .vpane.files
-orient horizontal
2026 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2027 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2029 # -- Index File List
2031 frame .vpane.files.index
-height 100 -width 200
2032 label .vpane.files.index.title
-text {Staged Changes
(Will Be Committed
)} \
2033 -background lightgreen
2034 text
$ui_index -background white
-borderwidth 0 \
2035 -width 20 -height 10 \
2037 -cursor $cursor_ptr \
2038 -xscrollcommand {.vpane.files.index.sx
set} \
2039 -yscrollcommand {.vpane.files.index.sy
set} \
2041 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2042 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2043 pack .vpane.files.index.title
-side top
-fill x
2044 pack .vpane.files.index.sx
-side bottom
-fill x
2045 pack .vpane.files.index.sy
-side right
-fill y
2046 pack
$ui_index -side left
-fill both
-expand 1
2047 .vpane.files add .vpane.files.index
-sticky nsew
2049 # -- Working Directory File List
2051 frame .vpane.files.workdir
-height 100 -width 200
2052 label .vpane.files.workdir.title
-text {Unstaged Changes
(Will Not Be Committed
)} \
2053 -background lightsalmon
2054 text
$ui_workdir -background white
-borderwidth 0 \
2055 -width 20 -height 10 \
2057 -cursor $cursor_ptr \
2058 -xscrollcommand {.vpane.files.workdir.sx
set} \
2059 -yscrollcommand {.vpane.files.workdir.sy
set} \
2061 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2062 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2063 pack .vpane.files.workdir.title
-side top
-fill x
2064 pack .vpane.files.workdir.sx
-side bottom
-fill x
2065 pack .vpane.files.workdir.sy
-side right
-fill y
2066 pack
$ui_workdir -side left
-fill both
-expand 1
2067 .vpane.files add .vpane.files.workdir
-sticky nsew
2069 foreach i
[list
$ui_index $ui_workdir] {
2070 $i tag conf in_diff
-background lightgray
2071 $i tag conf in_sel
-background lightgray
2075 # -- Diff and Commit Area
2077 frame .vpane.lower
-height 300 -width 400
2078 frame .vpane.lower.commarea
2079 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2080 pack .vpane.lower.commarea
-side top
-fill x
2081 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
2082 .vpane add .vpane.lower
-sticky nsew
2084 # -- Commit Area Buttons
2086 frame .vpane.lower.commarea.buttons
2087 label .vpane.lower.commarea.buttons.l
-text {} \
2090 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2091 pack .vpane.lower.commarea.buttons
-side left
-fill y
2093 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
2095 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2096 lappend disable_on_lock \
2097 {.vpane.lower.commarea.buttons.rescan conf
-state}
2099 button .vpane.lower.commarea.buttons.incall
-text {Add Existing
} \
2101 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2102 lappend disable_on_lock \
2103 {.vpane.lower.commarea.buttons.incall conf
-state}
2105 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
2107 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2109 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
2111 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2112 lappend disable_on_lock \
2113 {.vpane.lower.commarea.buttons.commit conf
-state}
2115 button .vpane.lower.commarea.buttons.push
-text {Push
} \
2116 -command do_push_anywhere
2117 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2119 # -- Commit Message Buffer
2121 frame .vpane.lower.commarea.buffer
2122 frame .vpane.lower.commarea.buffer.header
2123 set ui_comm .vpane.lower.commarea.buffer.t
2124 set ui_coml .vpane.lower.commarea.buffer.header.l
2125 radiobutton .vpane.lower.commarea.buffer.header.new \
2126 -text {New Commit
} \
2127 -command do_select_commit_type \
2128 -variable selected_commit_type \
2130 lappend disable_on_lock \
2131 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2132 radiobutton .vpane.lower.commarea.buffer.header.amend \
2133 -text {Amend Last Commit
} \
2134 -command do_select_commit_type \
2135 -variable selected_commit_type \
2137 lappend disable_on_lock \
2138 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2142 proc trace_commit_type
{varname args
} {
2143 global ui_coml commit_type
2144 switch
-glob -- $commit_type {
2145 initial
{set txt
{Initial Commit Message
:}}
2146 amend
{set txt
{Amended Commit Message
:}}
2147 amend-initial
{set txt
{Amended Initial Commit Message
:}}
2148 amend-merge
{set txt
{Amended Merge Commit Message
:}}
2149 merge
{set txt
{Merge Commit Message
:}}
2150 * {set txt
{Commit Message
:}}
2152 $ui_coml conf
-text $txt
2154 trace add variable commit_type
write trace_commit_type
2155 pack
$ui_coml -side left
-fill x
2156 pack .vpane.lower.commarea.buffer.header.amend
-side right
2157 pack .vpane.lower.commarea.buffer.header.new
-side right
2159 text
$ui_comm -background white
-borderwidth 1 \
2162 -autoseparators true \
2164 -width 75 -height 9 -wrap none \
2166 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2167 scrollbar .vpane.lower.commarea.buffer.sby \
2168 -command [list
$ui_comm yview
]
2169 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2170 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2171 pack
$ui_comm -side left
-fill y
2172 pack .vpane.lower.commarea.buffer
-side left
-fill y
2174 # -- Commit Message Buffer Context Menu
2176 set ctxm .vpane.lower.commarea.buffer.ctxm
2177 menu
$ctxm -tearoff 0
2180 -command {tk_textCut
$ui_comm}
2183 -command {tk_textCopy
$ui_comm}
2186 -command {tk_textPaste
$ui_comm}
2189 -command {$ui_comm delete sel.first sel.last
}
2192 -label {Select All
} \
2193 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2197 $ui_comm tag add sel
0.0 end
2198 tk_textCopy
$ui_comm
2199 $ui_comm tag remove sel
0.0 end
2205 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
2209 proc trace_current_diff_path
{varname args
} {
2210 global current_diff_path diff_actions file_states
2211 if {$current_diff_path eq
{}} {
2217 set p
$current_diff_path
2218 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2220 set p
[escape_path
$p]
2224 .vpane.lower.
diff.header.status configure
-text $s
2225 .vpane.lower.
diff.header.
file configure
-text $f
2226 .vpane.lower.
diff.header.path configure
-text $p
2227 foreach w
$diff_actions {
2231 trace add variable current_diff_path
write trace_current_diff_path
2233 frame .vpane.lower.
diff.header
-background gold
2234 label .vpane.lower.
diff.header.status \
2236 -width $max_status_desc \
2239 label .vpane.lower.
diff.header.
file \
2243 label .vpane.lower.
diff.header.path \
2247 pack .vpane.lower.
diff.header.status
-side left
2248 pack .vpane.lower.
diff.header.
file -side left
2249 pack .vpane.lower.
diff.header.path
-fill x
2250 set ctxm .vpane.lower.
diff.header.ctxm
2251 menu
$ctxm -tearoff 0
2259 -- $current_diff_path
2261 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2262 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2266 frame .vpane.lower.
diff.body
2267 set ui_diff .vpane.lower.
diff.body.t
2268 text
$ui_diff -background white
-borderwidth 0 \
2269 -width 80 -height 15 -wrap none \
2271 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2272 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2274 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2275 -command [list
$ui_diff xview
]
2276 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2277 -command [list
$ui_diff yview
]
2278 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2279 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2280 pack
$ui_diff -side left
-fill both
-expand 1
2281 pack .vpane.lower.
diff.header
-side top
-fill x
2282 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2284 $ui_diff tag conf d_cr
-elide true
2285 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2286 $ui_diff tag conf d_
+ -foreground {#00a000}
2287 $ui_diff tag conf d_-
-foreground red
2289 $ui_diff tag conf d_
++ -foreground {#00a000}
2290 $ui_diff tag conf d_--
-foreground red
2291 $ui_diff tag conf d_
+s \
2292 -foreground {#00a000} \
2293 -background {#e2effa}
2294 $ui_diff tag conf d_-s \
2296 -background {#e2effa}
2297 $ui_diff tag conf d_s
+ \
2298 -foreground {#00a000} \
2300 $ui_diff tag conf d_s- \
2304 $ui_diff tag conf d
<<<<<<< \
2305 -foreground orange \
2307 $ui_diff tag conf d
======= \
2308 -foreground orange \
2310 $ui_diff tag conf d
>>>>>>> \
2311 -foreground orange \
2314 $ui_diff tag raise sel
2316 # -- Diff Body Context Menu
2318 set ctxm .vpane.lower.
diff.body.ctxm
2319 menu
$ctxm -tearoff 0
2322 -command reshow_diff
2323 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2326 -command {tk_textCopy
$ui_diff}
2327 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2329 -label {Select All
} \
2330 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2331 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2335 $ui_diff tag add sel
0.0 end
2336 tk_textCopy
$ui_diff
2337 $ui_diff tag remove sel
0.0 end
2339 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2342 -label {Apply
/Reverse Hunk
} \
2343 -command {apply_hunk
$cursorX $cursorY}
2344 set ui_diff_applyhunk
[$ctxm index last
]
2345 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2348 -label {Decrease Font Size
} \
2349 -command {incr_font_size font_diff
-1}
2350 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2352 -label {Increase Font Size
} \
2353 -command {incr_font_size font_diff
1}
2354 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2357 -label {Show Less Context
} \
2358 -command {if {$repo_config(gui.diffcontext
) >= 1} {
2359 incr repo_config
(gui.diffcontext
) -1
2362 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2364 -label {Show More Context
} \
2365 -command {if {$repo_config(gui.diffcontext
) < 99} {
2366 incr repo_config
(gui.diffcontext
)
2369 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2371 $ctxm add
command -label {Options...
} \
2373 bind_button3
$ui_diff "
2376 if {\$ui_index eq \$current_diff_side} {
2377 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2379 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2381 tk_popup $ctxm %X %Y
2383 unset ui_diff_applyhunk
2387 set main_status
[::status_bar
::new .status
]
2388 pack .status
-anchor w
-side bottom
-fill x
2389 $main_status show
{Initializing...
}
2394 set gm
$repo_config(gui.geometry
)
2395 wm geometry .
[lindex
$gm 0]
2396 .vpane sash place
0 \
2397 [lindex
[.vpane sash coord
0] 0] \
2399 .vpane.files sash place
0 \
2401 [lindex
[.vpane.files sash coord
0] 1]
2407 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2408 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2409 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2410 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2411 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2412 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2413 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2414 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2415 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2416 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2417 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2419 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2420 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2421 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2422 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2423 bind $ui_diff <$M1B-Key-v> {break}
2424 bind $ui_diff <$M1B-Key-V> {break}
2425 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2426 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2427 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2428 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2429 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2430 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2431 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2432 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2433 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2434 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2435 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2436 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2437 bind $ui_diff <Button-1
> {focus
%W
}
2439 if {[is_enabled branch
]} {
2440 bind .
<$M1B-Key-n> branch_create
::dialog
2441 bind .
<$M1B-Key-N> branch_create
::dialog
2442 bind .
<$M1B-Key-o> branch_checkout
::dialog
2443 bind .
<$M1B-Key-O> branch_checkout
::dialog
2445 if {[is_enabled transport
]} {
2446 bind .
<$M1B-Key-p> do_push_anywhere
2447 bind .
<$M1B-Key-P> do_push_anywhere
2450 bind .
<Key-F5
> do_rescan
2451 bind .
<$M1B-Key-r> do_rescan
2452 bind .
<$M1B-Key-R> do_rescan
2453 bind .
<$M1B-Key-s> do_signoff
2454 bind .
<$M1B-Key-S> do_signoff
2455 bind .
<$M1B-Key-i> do_add_all
2456 bind .
<$M1B-Key-I> do_add_all
2457 bind .
<$M1B-Key-Return> do_commit
2458 foreach i
[list
$ui_index $ui_workdir] {
2459 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2460 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2461 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2465 set file_lists
($ui_index) [list
]
2466 set file_lists
($ui_workdir) [list
]
2468 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2469 focus
-force $ui_comm
2471 # -- Warn the user about environmental problems. Cygwin's Tcl
2472 # does *not* pass its env array onto any processes it spawns.
2473 # This means that git processes get none of our environment.
2478 set msg
"Possible environment issues exist.
2480 The following environment variables are probably
2481 going to be ignored by any Git subprocess run
2485 foreach name
[array names env
] {
2486 switch
-regexp -- $name {
2487 {^GIT_INDEX_FILE$
} -
2488 {^GIT_OBJECT_DIRECTORY$
} -
2489 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2491 {^GIT_EXTERNAL_DIFF$
} -
2495 {^GIT_CONFIG_LOCAL$
} -
2496 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2497 append msg
" - $name\n"
2500 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2501 append msg
" - $name\n"
2503 set suggest_user
$name
2507 if {$ignored_env > 0} {
2509 This is due to a known issue with the
2510 Tcl binary distributed by Cygwin."
2512 if {$suggest_user ne
{}} {
2515 A good replacement for $suggest_user
2516 is placing values for the user.name and
2517 user.email settings into your personal
2523 unset ignored_env msg suggest_user name
2526 # -- Only initialize complex UI if we are going to stay running.
2528 if {[is_enabled transport
]} {
2535 # -- Only suggest a gc run if we are going to stay running.
2537 if {[is_enabled multicommit
]} {
2538 set object_limit
2000
2539 if {[is_Windows
]} {set object_limit
200}
2540 regexp
{^
([0-9]+) objects
,} [git count-objects
] _junk objects_current
2541 if {$objects_current >= $object_limit} {
2543 "This repository currently has $objects_current loose objects.
2545 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2547 Compress the database now?"] eq
yes} {
2551 unset object_limit _junk objects_current
2554 lock_index begin-read