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 error
"No [gitexec git-$name]"
320 set _git_cmd_path
($name) $v
326 global env _search_exe _search_path
328 if {$_search_path eq
{}} {
330 set _search_path
[split [exec cygpath \
336 } elseif
{[is_Windows
]} {
337 set _search_path
[split $env(PATH
) {;}]
340 set _search_path
[split $env(PATH
) :]
345 foreach p
$_search_path {
346 set p
[file join $p $what$_search_exe]
347 if {[file exists
$p]} {
348 return [file normalize
$p]
358 switch
-- [lindex
$args 0] {
372 set args
[lrange
$args 1 end
]
375 set cmdp
[_git_cmd
[lindex
$args 0]]
376 set args
[lrange
$args 1 end
]
378 return [eval $opt $cmdp $args]
381 proc git_read
{args
} {
385 switch
-- [lindex
$args 0] {
403 set args
[lrange
$args 1 end
]
406 set cmdp
[_git_cmd
[lindex
$args 0]]
407 set args
[lrange
$args 1 end
]
410 set fd
[open
[concat
$opt $cmdp $args] r
]
412 if { [lindex
$args end
] eq
{2>@
1}
413 && $err eq
{can not
find channel named
"1"}
415 # Older versions of Tcl 8.4 don't have this 2>@1 IO
416 # redirect operator. Fallback to |& cat for those.
417 # The command was not actually started, so its safe
418 # to try to start it a second time.
420 set fd
[open
[concat \
423 [lrange
$args 0 end-1
] \
433 proc git_write
{args
} {
437 switch
-- [lindex
$args 0] {
451 set args
[lrange
$args 1 end
]
454 set cmdp
[_git_cmd
[lindex
$args 0]]
455 set args
[lrange
$args 1 end
]
457 return [open
[concat
$opt $cmdp $args] w
]
460 proc load_current_branch
{} {
461 global current_branch is_detached
463 set fd
[open
[gitdir HEAD
] r
]
464 if {[gets
$fd ref
] < 1} {
469 set pfx
{ref
: refs
/heads
/}
470 set len
[string length
$pfx]
471 if {[string equal
-length $len $pfx $ref]} {
472 # We're on a branch. It might not exist. But
473 # HEAD looks good enough to be a branch.
475 set current_branch
[string range
$ref $len end
]
478 # Assume this is a detached head.
480 set current_branch HEAD
485 auto_load tk_optionMenu
486 rename tk_optionMenu real__tkOptionMenu
487 proc tk_optionMenu
{w varName args
} {
488 set m
[eval real__tkOptionMenu
$w $varName $args]
489 $m configure
-font font_ui
490 $w configure
-font font_ui
494 ######################################################################
498 set _git
[_which git
]
500 catch
{wm withdraw .
}
501 error_popup
"Cannot find git in PATH."
504 set _nice
[_which nice
]
507 ######################################################################
511 if {[catch
{set _git_version
[git
--version]} err
]} {
512 catch
{wm withdraw .
}
513 error_popup
"Cannot determine Git version:
517 [appname] requires Git 1.5.0 or later."
520 if {![regsub
{^git version
} $_git_version {} _git_version
]} {
521 catch
{wm withdraw .
}
522 error_popup
"Cannot parse Git version string:\n\n$_git_version"
525 regsub
{\.
[0-9]+\.g
[0-9a-f]+$
} $_git_version {} _git_version
526 regsub
{\.rc
[0-9]+$
} $_git_version {} _git_version
528 proc git-version
{args
} {
531 switch
[llength
$args] {
537 set op
[lindex
$args 0]
538 set vr
[lindex
$args 1]
539 set cm
[package vcompare
$_git_version $vr]
540 return [expr $cm $op 0]
544 set type [lindex
$args 0]
545 set name
[lindex
$args 1]
546 set parm
[lindex
$args 2]
547 set body
[lindex
$args 3]
549 if {($type ne
{proc
} && $type ne
{method
})} {
550 error
"Invalid arguments to git-version"
552 if {[llength
$body] < 2 ||
[lindex
$body end-1
] ne
{default
}} {
553 error
"Last arm of $type $name must be default"
556 foreach
{op vr cb
} [lrange
$body 0 end-2
] {
557 if {[git-version
$op $vr]} {
558 return [uplevel
[list
$type $name $parm $cb]]
562 return [uplevel
[list
$type $name $parm [lindex
$body end
]]]
566 error
"git-version >= x"
572 if {[git-version
< 1.5]} {
573 catch
{wm withdraw .
}
574 error_popup
"[appname] requires Git 1.5.0 or later.
576 You are using [git-version]:
582 ######################################################################
587 set _gitdir
$env(GIT_DIR
)
591 set _gitdir
[git rev-parse
--git-dir]
592 set _prefix
[git rev-parse
--show-prefix]
594 catch
{wm withdraw .
}
595 error_popup
"Cannot find the git directory:\n\n$err"
598 if {![file isdirectory
$_gitdir] && [is_Cygwin
]} {
599 catch
{set _gitdir
[exec cygpath
--unix $_gitdir]}
601 if {![file isdirectory
$_gitdir]} {
602 catch
{wm withdraw .
}
603 error_popup
"Git directory not found:\n\n$_gitdir"
606 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
607 catch
{wm withdraw .
}
608 error_popup
"Cannot use funny .git directory:\n\n$_gitdir"
611 if {[catch
{cd [file dirname $_gitdir]} err
]} {
612 catch
{wm withdraw .
}
613 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
616 set _reponame
[lindex
[file split \
617 [file normalize
[file dirname $_gitdir]]] \
620 ######################################################################
624 set current_diff_path
{}
625 set current_diff_side
{}
626 set diff_actions
[list
]
630 set MERGE_HEAD
[list
]
633 set current_branch
{}
635 set current_diff_path
{}
636 set selected_commit_type new
638 ######################################################################
646 set disable_on_lock
[list
]
647 set index_lock_type none
649 proc lock_index
{type} {
650 global index_lock_type disable_on_lock
652 if {$index_lock_type eq
{none
}} {
653 set index_lock_type
$type
654 foreach w
$disable_on_lock {
655 uplevel
#0 $w disabled
658 } elseif
{$index_lock_type eq
"begin-$type"} {
659 set index_lock_type
$type
665 proc unlock_index
{} {
666 global index_lock_type disable_on_lock
668 set index_lock_type none
669 foreach w
$disable_on_lock {
674 ######################################################################
678 proc repository_state
{ctvar hdvar mhvar
} {
679 global current_branch
680 upvar
$ctvar ct
$hdvar hd
$mhvar mh
685 if {[catch
{set hd
[git rev-parse
--verify HEAD
]}]} {
691 set merge_head
[gitdir MERGE_HEAD
]
692 if {[file exists
$merge_head]} {
694 set fd_mh
[open
$merge_head r
]
695 while {[gets
$fd_mh line
] >= 0} {
706 global PARENT empty_tree
708 set p
[lindex
$PARENT 0]
712 if {$empty_tree eq
{}} {
713 set empty_tree
[git mktree
<< {}]
718 proc rescan
{after
{honor_trustmtime
1}} {
719 global HEAD PARENT MERGE_HEAD commit_type
720 global ui_index ui_workdir ui_comm
721 global rescan_active file_states
724 if {$rescan_active > 0 ||
![lock_index
read]} return
726 repository_state newType newHEAD newMERGE_HEAD
727 if {[string match amend
* $commit_type]
728 && $newType eq
{normal
}
729 && $newHEAD eq
$HEAD} {
733 set MERGE_HEAD
$newMERGE_HEAD
734 set commit_type
$newType
737 array
unset file_states
739 if {![$ui_comm edit modified
]
740 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
741 if {[string match amend
* $commit_type]} {
742 } elseif
{[load_message GITGUI_MSG
]} {
743 } elseif
{[load_message MERGE_MSG
]} {
744 } elseif
{[load_message SQUASH_MSG
]} {
747 $ui_comm edit modified false
750 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
751 rescan_stage2
{} $after
754 ui_status
{Refreshing
file status...
}
755 set fd_rf
[git_read update-index \
761 fconfigure
$fd_rf -blocking 0 -translation binary
762 fileevent
$fd_rf readable \
763 [list rescan_stage2
$fd_rf $after]
767 proc rescan_stage2
{fd after
} {
768 global rescan_active buf_rdi buf_rdf buf_rlo
772 if {![eof
$fd]} return
776 set ls_others
[list
--exclude-per-directory=.gitignore
]
777 set info_exclude
[gitdir info exclude
]
778 if {[file readable
$info_exclude]} {
779 lappend ls_others
"--exclude-from=$info_exclude"
787 ui_status
{Scanning
for modified files ...
}
788 set fd_di
[git_read diff-index
--cached -z [PARENT
]]
789 set fd_df
[git_read diff-files
-z]
790 set fd_lo
[eval git_read ls-files
--others -z $ls_others]
792 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
793 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
794 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
795 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
796 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
797 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
800 proc load_message
{file} {
804 if {[file isfile
$f]} {
805 if {[catch
{set fd
[open
$f r
]}]} {
808 set content
[string trim
[read $fd]]
810 regsub
-all -line {[ \r\t]+$
} $content {} content
811 $ui_comm delete
0.0 end
812 $ui_comm insert end
$content
818 proc read_diff_index
{fd after
} {
821 append buf_rdi
[read $fd]
823 set n
[string length
$buf_rdi]
825 set z1
[string first
"\0" $buf_rdi $c]
828 set z2
[string first
"\0" $buf_rdi $z1]
832 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
833 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
835 [encoding convertfrom
$p] \
837 [list
[lindex
$i 0] [lindex
$i 2]] \
843 set buf_rdi
[string range
$buf_rdi $c end
]
848 rescan_done
$fd buf_rdi
$after
851 proc read_diff_files
{fd after
} {
854 append buf_rdf
[read $fd]
856 set n
[string length
$buf_rdf]
858 set z1
[string first
"\0" $buf_rdf $c]
861 set z2
[string first
"\0" $buf_rdf $z1]
865 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
866 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
868 [encoding convertfrom
$p] \
871 [list
[lindex
$i 0] [lindex
$i 2]]
876 set buf_rdf
[string range
$buf_rdf $c end
]
881 rescan_done
$fd buf_rdf
$after
884 proc read_ls_others
{fd after
} {
887 append buf_rlo
[read $fd]
888 set pck
[split $buf_rlo "\0"]
889 set buf_rlo
[lindex
$pck end
]
890 foreach p
[lrange
$pck 0 end-1
] {
891 merge_state
[encoding convertfrom
$p] ?O
893 rescan_done
$fd buf_rlo
$after
896 proc rescan_done
{fd buf after
} {
897 global rescan_active current_diff_path
898 global file_states repo_config
901 if {![eof
$fd]} return
904 if {[incr rescan_active
-1] > 0} return
909 if {$current_diff_path ne
{}} reshow_diff
913 proc prune_selection
{} {
914 global file_states selected_paths
916 foreach path
[array names selected_paths
] {
917 if {[catch
{set still_here
$file_states($path)}]} {
918 unset selected_paths
($path)
923 ######################################################################
927 proc mapicon
{w state path
} {
930 if {[catch
{set r
$all_icons($state$w)}]} {
931 puts
"error: no icon for $w state={$state} $path"
937 proc mapdesc
{state path
} {
940 if {[catch
{set r
$all_descs($state)}]} {
941 puts
"error: no desc for state={$state} $path"
947 proc ui_status
{msg
} {
948 $
::main_status show
$msg
951 proc ui_ready
{{test {}}} {
952 $
::main_status show
{Ready.
} $test
955 proc escape_path
{path
} {
956 regsub
-all {\\} $path "\\\\" path
957 regsub
-all "\n" $path "\\n" path
961 proc short_path
{path
} {
962 return [escape_path
[lindex
[file split $path] end
]]
966 set null_sha1
[string repeat
0 40]
968 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
969 global file_states next_icon_id null_sha1
971 set s0
[string index
$new_state 0]
972 set s1
[string index
$new_state 1]
974 if {[catch
{set info
$file_states($path)}]} {
976 set icon n
[incr next_icon_id
]
978 set state
[lindex
$info 0]
979 set icon
[lindex
$info 1]
980 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
981 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
984 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
985 elseif
{$s0 eq
{_
}} {set s0 _
}
987 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
988 elseif
{$s1 eq
{_
}} {set s1 _
}
990 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
991 set head_info
[list
0 $null_sha1]
992 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
993 && $head_info eq
{}} {
994 set head_info
$index_info
997 set file_states
($path) [list
$s0$s1 $icon \
998 $head_info $index_info \
1003 proc display_file_helper
{w path icon_name old_m new_m
} {
1006 if {$new_m eq
{_
}} {
1007 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1009 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1011 $w conf
-state normal
1012 $w delete
$lno.0 [expr {$lno + 1}].0
1013 $w conf
-state disabled
1015 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1016 lappend file_lists
($w) $path
1017 set file_lists
($w) [lsort
-unique $file_lists($w)]
1018 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1020 $w conf
-state normal
1021 $w image create
$lno.0 \
1022 -align center
-padx 5 -pady 1 \
1024 -image [mapicon
$w $new_m $path]
1025 $w insert
$lno.1 "[escape_path $path]\n"
1026 $w conf
-state disabled
1027 } elseif
{$old_m ne
$new_m} {
1028 $w conf
-state normal
1029 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1030 $w conf
-state disabled
1034 proc display_file
{path state
} {
1035 global file_states selected_paths
1036 global ui_index ui_workdir
1038 set old_m
[merge_state
$path $state]
1039 set s
$file_states($path)
1040 set new_m
[lindex
$s 0]
1041 set icon_name
[lindex
$s 1]
1043 set o
[string index
$old_m 0]
1044 set n
[string index
$new_m 0]
1051 display_file_helper
$ui_index $path $icon_name $o $n
1053 if {[string index
$old_m 0] eq
{U
}} {
1056 set o
[string index
$old_m 1]
1058 if {[string index
$new_m 0] eq
{U
}} {
1061 set n
[string index
$new_m 1]
1063 display_file_helper
$ui_workdir $path $icon_name $o $n
1065 if {$new_m eq
{__
}} {
1066 unset file_states
($path)
1067 catch
{unset selected_paths
($path)}
1071 proc display_all_files_helper
{w path icon_name m
} {
1074 lappend file_lists
($w) $path
1075 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1076 $w image create end \
1077 -align center
-padx 5 -pady 1 \
1079 -image [mapicon
$w $m $path]
1080 $w insert end
"[escape_path $path]\n"
1083 proc display_all_files
{} {
1084 global ui_index ui_workdir
1085 global file_states file_lists
1088 $ui_index conf
-state normal
1089 $ui_workdir conf
-state normal
1091 $ui_index delete
0.0 end
1092 $ui_workdir delete
0.0 end
1095 set file_lists
($ui_index) [list
]
1096 set file_lists
($ui_workdir) [list
]
1098 foreach path
[lsort
[array names file_states
]] {
1099 set s
$file_states($path)
1101 set icon_name
[lindex
$s 1]
1103 set s
[string index
$m 0]
1104 if {$s ne
{U
} && $s ne
{_
}} {
1105 display_all_files_helper
$ui_index $path \
1109 if {[string index
$m 0] eq
{U
}} {
1112 set s
[string index
$m 1]
1115 display_all_files_helper
$ui_workdir $path \
1120 $ui_index conf
-state disabled
1121 $ui_workdir conf
-state disabled
1124 ######################################################################
1129 #define mask_width 14
1130 #define mask_height 15
1131 static unsigned char mask_bits
[] = {
1132 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1133 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1134 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1137 image create bitmap file_plain
-background white
-foreground black
-data {
1138 #define plain_width 14
1139 #define plain_height 15
1140 static unsigned char plain_bits
[] = {
1141 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1142 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1143 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1144 } -maskdata $filemask
1146 image create bitmap file_mod
-background white
-foreground blue
-data {
1147 #define mod_width 14
1148 #define mod_height 15
1149 static unsigned char mod_bits
[] = {
1150 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1151 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1152 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1153 } -maskdata $filemask
1155 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
1156 #define file_fulltick_width 14
1157 #define file_fulltick_height 15
1158 static unsigned char file_fulltick_bits
[] = {
1159 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1160 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1161 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1162 } -maskdata $filemask
1164 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1165 #define parttick_width 14
1166 #define parttick_height 15
1167 static unsigned char parttick_bits
[] = {
1168 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1169 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1170 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1171 } -maskdata $filemask
1173 image create bitmap file_question
-background white
-foreground black
-data {
1174 #define file_question_width 14
1175 #define file_question_height 15
1176 static unsigned char file_question_bits
[] = {
1177 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1178 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1179 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1180 } -maskdata $filemask
1182 image create bitmap file_removed
-background white
-foreground red
-data {
1183 #define file_removed_width 14
1184 #define file_removed_height 15
1185 static unsigned char file_removed_bits
[] = {
1186 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1187 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1188 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1189 } -maskdata $filemask
1191 image create bitmap file_merge
-background white
-foreground blue
-data {
1192 #define file_merge_width 14
1193 #define file_merge_height 15
1194 static unsigned char file_merge_bits
[] = {
1195 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1196 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1197 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1198 } -maskdata $filemask
1201 #define file_width 18
1202 #define file_height 18
1203 static unsigned char file_bits
[] = {
1204 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
1205 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
1206 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
1207 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
1208 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
1210 image create bitmap file_dir
-background white
-foreground blue \
1211 -data $file_dir_data -maskdata $file_dir_data
1214 set file_uplevel_data
{
1216 #define up_height 15
1217 static unsigned char up_bits
[] = {
1218 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
1219 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
1220 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
1222 image create bitmap file_uplevel
-background white
-foreground red \
1223 -data $file_uplevel_data -maskdata $file_uplevel_data
1224 unset file_uplevel_data
1226 set ui_index .vpane.files.index.list
1227 set ui_workdir .vpane.files.workdir.list
1229 set all_icons
(_
$ui_index) file_plain
1230 set all_icons
(A
$ui_index) file_fulltick
1231 set all_icons
(M
$ui_index) file_fulltick
1232 set all_icons
(D
$ui_index) file_removed
1233 set all_icons
(U
$ui_index) file_merge
1235 set all_icons
(_
$ui_workdir) file_plain
1236 set all_icons
(M
$ui_workdir) file_mod
1237 set all_icons
(D
$ui_workdir) file_question
1238 set all_icons
(U
$ui_workdir) file_merge
1239 set all_icons
(O
$ui_workdir) file_plain
1241 set max_status_desc
0
1245 {_M
"Modified, not staged"}
1246 {M_
"Staged for commit"}
1247 {MM
"Portions staged for commit"}
1248 {MD
"Staged for commit, missing"}
1250 {_O
"Untracked, not staged"}
1251 {A_
"Staged for commit"}
1252 {AM
"Portions staged for commit"}
1253 {AD
"Staged for commit, missing"}
1256 {D_
"Staged for removal"}
1257 {DO
"Staged for removal, still present"}
1259 {U_
"Requires merge resolution"}
1260 {UU
"Requires merge resolution"}
1261 {UM
"Requires merge resolution"}
1262 {UD
"Requires merge resolution"}
1264 if {$max_status_desc < [string length
[lindex
$i 1]]} {
1265 set max_status_desc
[string length
[lindex
$i 1]]
1267 set all_descs
([lindex
$i 0]) [lindex
$i 1]
1271 ######################################################################
1275 proc bind_button3
{w cmd
} {
1276 bind $w <Any-Button-3
> $cmd
1278 bind $w <Control-Button-1
> $cmd
1282 proc scrollbar2many
{list mode args
} {
1283 foreach w
$list {eval $w $mode $args}
1286 proc many2scrollbar
{list mode sb top bottom
} {
1287 $sb set $top $bottom
1288 foreach w
$list {$w $mode moveto
$top}
1291 proc incr_font_size
{font
{amt
1}} {
1292 set sz
[font configure
$font -size]
1294 font configure
$font -size $sz
1295 font configure
${font}bold
-size $sz
1296 font configure
${font}italic
-size $sz
1299 ######################################################################
1303 set starting_gitk_msg
{Starting gitk... please
wait...
}
1305 proc do_gitk
{revs
} {
1306 global env starting_gitk_msg
1308 # -- Always start gitk through whatever we were loaded with. This
1309 # lets us bypass using shell process on Windows systems.
1311 set cmd
[list
[info nameofexecutable
]]
1312 set exe
[gitexec gitk
]
1319 if {! [file exists
$exe]} {
1320 error_popup
"Unable to start gitk:\n\n$exe does not exist"
1323 ui_status
$starting_gitk_msg
1325 ui_ready
$starting_gitk_msg
1333 global ui_comm is_quitting repo_config commit_type
1335 if {$is_quitting} return
1338 if {[winfo exists
$ui_comm]} {
1339 # -- Stash our current commit buffer.
1341 set save
[gitdir GITGUI_MSG
]
1342 set msg
[string trim
[$ui_comm get
0.0 end
]]
1343 regsub
-all -line {[ \r\t]+$
} $msg {} msg
1344 if {(![string match amend
* $commit_type]
1345 ||
[$ui_comm edit modified
])
1348 set fd
[open
$save w
]
1349 puts
-nonewline $fd $msg
1353 catch
{file delete
$save}
1356 # -- Stash our current window geometry into this repository.
1358 set cfg_geometry
[list
]
1359 lappend cfg_geometry
[wm geometry .
]
1360 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1361 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1362 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1365 if {$cfg_geometry ne
$rc_geometry} {
1366 catch
{git config gui.geometry
$cfg_geometry}
1381 proc toggle_or_diff
{w x y
} {
1382 global file_states file_lists current_diff_path ui_index ui_workdir
1383 global last_clicked selected_paths
1385 set pos
[split [$w index @
$x,$y] .
]
1386 set lno
[lindex
$pos 0]
1387 set col [lindex
$pos 1]
1388 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1394 set last_clicked
[list
$w $lno]
1395 array
unset selected_paths
1396 $ui_index tag remove in_sel
0.0 end
1397 $ui_workdir tag remove in_sel
0.0 end
1400 if {$current_diff_path eq
$path} {
1401 set after
{reshow_diff
;}
1405 if {$w eq
$ui_index} {
1407 "Unstaging [short_path $path] from commit" \
1409 [concat
$after [list ui_ready
]]
1410 } elseif
{$w eq
$ui_workdir} {
1412 "Adding [short_path $path]" \
1414 [concat
$after [list ui_ready
]]
1417 show_diff
$path $w $lno
1421 proc add_one_to_selection
{w x y
} {
1422 global file_lists last_clicked selected_paths
1424 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1425 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1431 if {$last_clicked ne
{}
1432 && [lindex
$last_clicked 0] ne
$w} {
1433 array
unset selected_paths
1434 [lindex
$last_clicked 0] tag remove in_sel
0.0 end
1437 set last_clicked
[list
$w $lno]
1438 if {[catch
{set in_sel
$selected_paths($path)}]} {
1442 unset selected_paths
($path)
1443 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
1445 set selected_paths
($path) 1
1446 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1450 proc add_range_to_selection
{w x y
} {
1451 global file_lists last_clicked selected_paths
1453 if {[lindex
$last_clicked 0] ne
$w} {
1454 toggle_or_diff
$w $x $y
1458 set lno
[lindex
[split [$w index @
$x,$y] .
] 0]
1459 set lc
[lindex
$last_clicked 1]
1468 foreach path
[lrange
$file_lists($w) \
1469 [expr {$begin - 1}] \
1470 [expr {$end - 1}]] {
1471 set selected_paths
($path) 1
1473 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
1476 ######################################################################
1480 set cursor_ptr arrow
1481 font create font_diff
-family Courier
-size 10
1485 eval font configure font_ui
[font actual
[.dummy cget
-font]]
1489 font create font_uiitalic
1490 font create font_uibold
1491 font create font_diffbold
1492 font create font_diffitalic
1494 foreach class
{Button Checkbutton Entry Label
1495 Labelframe Listbox Menu Message
1496 Radiobutton Spinbox Text
} {
1497 option add
*$class.font font_ui
1501 if {[is_Windows
] ||
[is_MacOSX
]} {
1502 option add
*Menu.tearOff
0
1513 proc apply_config
{} {
1514 global repo_config font_descs
1516 foreach option
$font_descs {
1517 set name
[lindex
$option 0]
1518 set font
[lindex
$option 1]
1520 foreach
{cn cv
} $repo_config(gui.
$name) {
1521 font configure
$font $cn $cv
1524 error_popup
"Invalid font specified in gui.$name:\n\n$err"
1526 foreach
{cn cv
} [font configure
$font] {
1527 font configure
${font}bold
$cn $cv
1528 font configure
${font}italic
$cn $cv
1530 font configure
${font}bold
-weight bold
1531 font configure
${font}italic
-slant italic
1535 set default_config
(merge.diffstat
) true
1536 set default_config
(merge.summary
) false
1537 set default_config
(merge.verbosity
) 2
1538 set default_config
(user.name
) {}
1539 set default_config
(user.email
) {}
1541 set default_config
(gui.matchtrackingbranch
) false
1542 set default_config
(gui.pruneduringfetch
) false
1543 set default_config
(gui.trustmtime
) false
1544 set default_config
(gui.diffcontext
) 5
1545 set default_config
(gui.newbranchtemplate
) {}
1546 set default_config
(gui.fontui
) [font configure font_ui
]
1547 set default_config
(gui.fontdiff
) [font configure font_diff
]
1549 {fontui font_ui
{Main Font
}}
1550 {fontdiff font_diff
{Diff
/Console Font
}}
1555 ######################################################################
1557 ## feature option selection
1559 if {[regexp
{^git-
(.
+)$
} [appname
] _junk subcommand
]} {
1564 if {$subcommand eq
{gui.sh
}} {
1567 if {$subcommand eq
{gui
} && [llength
$argv] > 0} {
1568 set subcommand
[lindex
$argv 0]
1569 set argv
[lrange
$argv 1 end
]
1572 enable_option multicommit
1573 enable_option branch
1574 enable_option transport
1576 switch
-- $subcommand {
1579 disable_option multicommit
1580 disable_option branch
1581 disable_option transport
1584 enable_option singlecommit
1586 disable_option multicommit
1587 disable_option branch
1588 disable_option transport
1592 ######################################################################
1600 menu .mbar
-tearoff 0
1601 .mbar add cascade
-label Repository
-menu .mbar.repository
1602 .mbar add cascade
-label Edit
-menu .mbar.edit
1603 if {[is_enabled branch
]} {
1604 .mbar add cascade
-label Branch
-menu .mbar.branch
1606 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1607 .mbar add cascade
-label Commit
-menu .mbar.commit
1609 if {[is_enabled transport
]} {
1610 .mbar add cascade
-label Merge
-menu .mbar.merge
1611 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1612 .mbar add cascade
-label Push
-menu .mbar.push
1614 . configure
-menu .mbar
1616 # -- Repository Menu
1618 menu .mbar.repository
1620 .mbar.repository add
command \
1621 -label {Browse Current Branch
} \
1622 -command {browser
::new
$current_branch}
1623 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
1624 .mbar.repository add separator
1626 .mbar.repository add
command \
1627 -label {Visualize Current Branch
} \
1628 -command {do_gitk
$current_branch}
1629 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
1630 .mbar.repository add
command \
1631 -label {Visualize All Branches
} \
1632 -command {do_gitk
--all}
1633 .mbar.repository add separator
1635 if {[is_enabled multicommit
]} {
1636 .mbar.repository add
command -label {Database Statistics
} \
1639 .mbar.repository add
command -label {Compress Database
} \
1642 .mbar.repository add
command -label {Verify Database
} \
1643 -command do_fsck_objects
1645 .mbar.repository add separator
1648 .mbar.repository add
command \
1649 -label {Create Desktop Icon
} \
1650 -command do_cygwin_shortcut
1651 } elseif
{[is_Windows
]} {
1652 .mbar.repository add
command \
1653 -label {Create Desktop Icon
} \
1654 -command do_windows_shortcut
1655 } elseif
{[is_MacOSX
]} {
1656 .mbar.repository add
command \
1657 -label {Create Desktop Icon
} \
1658 -command do_macosx_app
1662 .mbar.repository add
command -label Quit \
1669 .mbar.edit add
command -label Undo \
1670 -command {catch
{[focus
] edit undo
}} \
1672 .mbar.edit add
command -label Redo \
1673 -command {catch
{[focus
] edit redo
}} \
1675 .mbar.edit add separator
1676 .mbar.edit add
command -label Cut \
1677 -command {catch
{tk_textCut
[focus
]}} \
1679 .mbar.edit add
command -label Copy \
1680 -command {catch
{tk_textCopy
[focus
]}} \
1682 .mbar.edit add
command -label Paste \
1683 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1685 .mbar.edit add
command -label Delete \
1686 -command {catch
{[focus
] delete sel.first sel.last
}} \
1688 .mbar.edit add separator
1689 .mbar.edit add
command -label {Select All
} \
1690 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1695 if {[is_enabled branch
]} {
1698 .mbar.branch add
command -label {Create...
} \
1699 -command branch_create
::dialog \
1701 lappend disable_on_lock
[list .mbar.branch entryconf \
1702 [.mbar.branch index last
] -state]
1704 .mbar.branch add
command -label {Checkout...
} \
1705 -command branch_checkout
::dialog \
1707 lappend disable_on_lock
[list .mbar.branch entryconf \
1708 [.mbar.branch index last
] -state]
1710 .mbar.branch add
command -label {Rename...
} \
1711 -command branch_rename
::dialog
1712 lappend disable_on_lock
[list .mbar.branch entryconf \
1713 [.mbar.branch index last
] -state]
1715 .mbar.branch add
command -label {Delete...
} \
1716 -command branch_delete
::dialog
1717 lappend disable_on_lock
[list .mbar.branch entryconf \
1718 [.mbar.branch index last
] -state]
1720 .mbar.branch add
command -label {Reset...
} \
1721 -command merge
::reset_hard
1722 lappend disable_on_lock
[list .mbar.branch entryconf \
1723 [.mbar.branch index last
] -state]
1728 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
1731 .mbar.commit add radiobutton \
1732 -label {New Commit
} \
1733 -command do_select_commit_type \
1734 -variable selected_commit_type \
1736 lappend disable_on_lock \
1737 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1739 .mbar.commit add radiobutton \
1740 -label {Amend Last Commit
} \
1741 -command do_select_commit_type \
1742 -variable selected_commit_type \
1744 lappend disable_on_lock \
1745 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1747 .mbar.commit add separator
1749 .mbar.commit add
command -label Rescan \
1750 -command do_rescan \
1752 lappend disable_on_lock \
1753 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1755 .mbar.commit add
command -label {Add To Commit
} \
1756 -command do_add_selection
1757 lappend disable_on_lock \
1758 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1760 .mbar.commit add
command -label {Add Existing To Commit
} \
1761 -command do_add_all \
1763 lappend disable_on_lock \
1764 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1766 .mbar.commit add
command -label {Unstage From Commit
} \
1767 -command do_unstage_selection
1768 lappend disable_on_lock \
1769 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1771 .mbar.commit add
command -label {Revert Changes
} \
1772 -command do_revert_selection
1773 lappend disable_on_lock \
1774 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1776 .mbar.commit add separator
1778 .mbar.commit add
command -label {Sign Off
} \
1779 -command do_signoff \
1782 .mbar.commit add
command -label Commit \
1783 -command do_commit \
1784 -accelerator $M1T-Return
1785 lappend disable_on_lock \
1786 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1791 if {[is_enabled branch
]} {
1793 .mbar.merge add
command -label {Local Merge...
} \
1794 -command merge
::dialog
1795 lappend disable_on_lock \
1796 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1797 .mbar.merge add
command -label {Abort Merge...
} \
1798 -command merge
::reset_hard
1799 lappend disable_on_lock \
1800 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
1806 if {[is_enabled transport
]} {
1810 .mbar.push add
command -label {Push...
} \
1811 -command do_push_anywhere \
1813 .mbar.push add
command -label {Delete...
} \
1814 -command remote_branch_delete
::dialog
1818 # -- Apple Menu (Mac OS X only)
1820 .mbar add cascade
-label Apple
-menu .mbar.apple
1823 .mbar.apple add
command -label "About [appname]" \
1825 .mbar.apple add
command -label "Options..." \
1830 .mbar.edit add separator
1831 .mbar.edit add
command -label {Options...
} \
1836 if {[is_Cygwin
] && [file exists
/usr
/local
/miga
/lib
/gui-miga
]} {
1838 if {![lock_index update
]} return
1839 set cmd
[list sh
--login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
1840 set miga_fd
[open
"|$cmd" r
]
1841 fconfigure
$miga_fd -blocking 0
1842 fileevent
$miga_fd readable
[list miga_done
$miga_fd]
1843 ui_status
{Running miga...
}
1845 proc miga_done
{fd
} {
1853 .mbar add cascade
-label Tools
-menu .mbar.tools
1855 .mbar.tools add
command -label "Migrate" \
1857 lappend disable_on_lock \
1858 [list .mbar.tools entryconf
[.mbar.tools index last
] -state]
1864 .mbar add cascade
-label Help
-menu .mbar.
help
1868 .mbar.
help add
command -label "About [appname]" \
1873 catch
{set browser
$repo_config(instaweb.browser
)}
1874 set doc_path
[file dirname [gitexec
]]
1875 set doc_path
[file join $doc_path Documentation index.html
]
1878 set doc_path
[exec cygpath
--mixed $doc_path]
1881 if {$browser eq
{}} {
1884 } elseif
{[is_Cygwin
]} {
1885 set program_files
[file dirname [exec cygpath
--windir]]
1886 set program_files
[file join $program_files {Program Files
}]
1887 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
1888 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
1889 if {[file exists
$firefox]} {
1890 set browser
$firefox
1891 } elseif
{[file exists
$ie]} {
1894 unset program_files firefox ie
1898 if {[file isfile
$doc_path]} {
1899 set doc_url
"file:$doc_path"
1901 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
1904 if {$browser ne
{}} {
1905 .mbar.
help add
command -label {Online Documentation
} \
1906 -command [list
exec $browser $doc_url &]
1908 unset browser doc_path doc_url
1910 # -- Standard bindings
1912 wm protocol . WM_DELETE_WINDOW do_quit
1913 bind all
<$M1B-Key-q> do_quit
1914 bind all
<$M1B-Key-Q> do_quit
1915 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1916 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1918 set subcommand_args
{}
1920 puts stderr
"usage: $::argv0 $::subcommand $::subcommand_args"
1924 # -- Not a normal commit type invocation? Do that instead!
1926 switch
-- $subcommand {
1928 set subcommand_args
{rev?
}
1929 switch
[llength
$argv] {
1930 0 { load_current_branch
}
1932 set current_branch
[lindex
$argv 0]
1933 if {[regexp
{^
[0-9a-f]{1,39}$
} $current_branch]} {
1935 set current_branch \
1936 [git rev-parse
--verify $current_branch]
1945 browser
::new
$current_branch
1949 set subcommand_args
{rev? path?
}
1954 if {$is_path ||
[file exists
$_prefix$a]} {
1955 if {$path ne
{}} usage
1958 } elseif
{$a eq
{--}} {
1960 if {$head ne
{}} usage
1965 } elseif
{$head eq
{}} {
1966 if {$head ne
{}} usage
1977 if {[regexp
{^
[0-9a-f]{1,39}$
} $head]} {
1979 set head [git rev-parse
--verify $head]
1985 set current_branch
$head
1988 if {$path eq
{}} usage
1989 blame
::new
$head $path
1994 if {[llength
$argv] != 0} {
1995 puts
-nonewline stderr
"usage: $argv0"
1996 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
1997 puts
-nonewline stderr
" $subcommand"
2002 # fall through to setup UI for commits
2005 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
2016 -text {Current Branch
:} \
2020 -textvariable current_branch \
2023 pack .branch.l1
-side left
2024 pack .branch.cb
-side left
-fill x
2025 pack .branch
-side top
-fill x
2027 # -- Main Window Layout
2029 panedwindow .vpane
-orient vertical
2030 panedwindow .vpane.files
-orient horizontal
2031 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
2032 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2034 # -- Index File List
2036 frame .vpane.files.index
-height 100 -width 200
2037 label .vpane.files.index.title
-text {Staged Changes
(Will Be Committed
)} \
2038 -background lightgreen
2039 text
$ui_index -background white
-borderwidth 0 \
2040 -width 20 -height 10 \
2042 -cursor $cursor_ptr \
2043 -xscrollcommand {.vpane.files.index.sx
set} \
2044 -yscrollcommand {.vpane.files.index.sy
set} \
2046 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
2047 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
2048 pack .vpane.files.index.title
-side top
-fill x
2049 pack .vpane.files.index.sx
-side bottom
-fill x
2050 pack .vpane.files.index.sy
-side right
-fill y
2051 pack
$ui_index -side left
-fill both
-expand 1
2052 .vpane.files add .vpane.files.index
-sticky nsew
2054 # -- Working Directory File List
2056 frame .vpane.files.workdir
-height 100 -width 200
2057 label .vpane.files.workdir.title
-text {Unstaged Changes
(Will Not Be Committed
)} \
2058 -background lightsalmon
2059 text
$ui_workdir -background white
-borderwidth 0 \
2060 -width 20 -height 10 \
2062 -cursor $cursor_ptr \
2063 -xscrollcommand {.vpane.files.workdir.sx
set} \
2064 -yscrollcommand {.vpane.files.workdir.sy
set} \
2066 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
2067 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
2068 pack .vpane.files.workdir.title
-side top
-fill x
2069 pack .vpane.files.workdir.sx
-side bottom
-fill x
2070 pack .vpane.files.workdir.sy
-side right
-fill y
2071 pack
$ui_workdir -side left
-fill both
-expand 1
2072 .vpane.files add .vpane.files.workdir
-sticky nsew
2074 foreach i
[list
$ui_index $ui_workdir] {
2075 $i tag conf in_diff
-background lightgray
2076 $i tag conf in_sel
-background lightgray
2080 # -- Diff and Commit Area
2082 frame .vpane.lower
-height 300 -width 400
2083 frame .vpane.lower.commarea
2084 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2085 pack .vpane.lower.commarea
-side top
-fill x
2086 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
2087 .vpane add .vpane.lower
-sticky nsew
2089 # -- Commit Area Buttons
2091 frame .vpane.lower.commarea.buttons
2092 label .vpane.lower.commarea.buttons.l
-text {} \
2095 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2096 pack .vpane.lower.commarea.buttons
-side left
-fill y
2098 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
2100 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2101 lappend disable_on_lock \
2102 {.vpane.lower.commarea.buttons.rescan conf
-state}
2104 button .vpane.lower.commarea.buttons.incall
-text {Add Existing
} \
2106 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2107 lappend disable_on_lock \
2108 {.vpane.lower.commarea.buttons.incall conf
-state}
2110 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
2112 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2114 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
2116 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2117 lappend disable_on_lock \
2118 {.vpane.lower.commarea.buttons.commit conf
-state}
2120 button .vpane.lower.commarea.buttons.push
-text {Push
} \
2121 -command do_push_anywhere
2122 pack .vpane.lower.commarea.buttons.push
-side top
-fill x
2124 # -- Commit Message Buffer
2126 frame .vpane.lower.commarea.buffer
2127 frame .vpane.lower.commarea.buffer.header
2128 set ui_comm .vpane.lower.commarea.buffer.t
2129 set ui_coml .vpane.lower.commarea.buffer.header.l
2130 radiobutton .vpane.lower.commarea.buffer.header.new \
2131 -text {New Commit
} \
2132 -command do_select_commit_type \
2133 -variable selected_commit_type \
2135 lappend disable_on_lock \
2136 [list .vpane.lower.commarea.buffer.header.new conf
-state]
2137 radiobutton .vpane.lower.commarea.buffer.header.amend \
2138 -text {Amend Last Commit
} \
2139 -command do_select_commit_type \
2140 -variable selected_commit_type \
2142 lappend disable_on_lock \
2143 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
2147 proc trace_commit_type
{varname args
} {
2148 global ui_coml commit_type
2149 switch
-glob -- $commit_type {
2150 initial
{set txt
{Initial Commit Message
:}}
2151 amend
{set txt
{Amended Commit Message
:}}
2152 amend-initial
{set txt
{Amended Initial Commit Message
:}}
2153 amend-merge
{set txt
{Amended Merge Commit Message
:}}
2154 merge
{set txt
{Merge Commit Message
:}}
2155 * {set txt
{Commit Message
:}}
2157 $ui_coml conf
-text $txt
2159 trace add variable commit_type
write trace_commit_type
2160 pack
$ui_coml -side left
-fill x
2161 pack .vpane.lower.commarea.buffer.header.amend
-side right
2162 pack .vpane.lower.commarea.buffer.header.new
-side right
2164 text
$ui_comm -background white
-borderwidth 1 \
2167 -autoseparators true \
2169 -width 75 -height 9 -wrap none \
2171 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2172 scrollbar .vpane.lower.commarea.buffer.sby \
2173 -command [list
$ui_comm yview
]
2174 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
2175 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2176 pack
$ui_comm -side left
-fill y
2177 pack .vpane.lower.commarea.buffer
-side left
-fill y
2179 # -- Commit Message Buffer Context Menu
2181 set ctxm .vpane.lower.commarea.buffer.ctxm
2182 menu
$ctxm -tearoff 0
2185 -command {tk_textCut
$ui_comm}
2188 -command {tk_textCopy
$ui_comm}
2191 -command {tk_textPaste
$ui_comm}
2194 -command {$ui_comm delete sel.first sel.last
}
2197 -label {Select All
} \
2198 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
2202 $ui_comm tag add sel
0.0 end
2203 tk_textCopy
$ui_comm
2204 $ui_comm tag remove sel
0.0 end
2210 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
2214 proc trace_current_diff_path
{varname args
} {
2215 global current_diff_path diff_actions file_states
2216 if {$current_diff_path eq
{}} {
2222 set p
$current_diff_path
2223 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
2225 set p
[escape_path
$p]
2229 .vpane.lower.
diff.header.status configure
-text $s
2230 .vpane.lower.
diff.header.
file configure
-text $f
2231 .vpane.lower.
diff.header.path configure
-text $p
2232 foreach w
$diff_actions {
2236 trace add variable current_diff_path
write trace_current_diff_path
2238 frame .vpane.lower.
diff.header
-background gold
2239 label .vpane.lower.
diff.header.status \
2241 -width $max_status_desc \
2244 label .vpane.lower.
diff.header.
file \
2248 label .vpane.lower.
diff.header.path \
2252 pack .vpane.lower.
diff.header.status
-side left
2253 pack .vpane.lower.
diff.header.
file -side left
2254 pack .vpane.lower.
diff.header.path
-fill x
2255 set ctxm .vpane.lower.
diff.header.ctxm
2256 menu
$ctxm -tearoff 0
2264 -- $current_diff_path
2266 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2267 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
2271 frame .vpane.lower.
diff.body
2272 set ui_diff .vpane.lower.
diff.body.t
2273 text
$ui_diff -background white
-borderwidth 0 \
2274 -width 80 -height 15 -wrap none \
2276 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2277 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2279 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2280 -command [list
$ui_diff xview
]
2281 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2282 -command [list
$ui_diff yview
]
2283 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2284 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2285 pack
$ui_diff -side left
-fill both
-expand 1
2286 pack .vpane.lower.
diff.header
-side top
-fill x
2287 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2289 $ui_diff tag conf d_cr
-elide true
2290 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
2291 $ui_diff tag conf d_
+ -foreground {#00a000}
2292 $ui_diff tag conf d_-
-foreground red
2294 $ui_diff tag conf d_
++ -foreground {#00a000}
2295 $ui_diff tag conf d_--
-foreground red
2296 $ui_diff tag conf d_
+s \
2297 -foreground {#00a000} \
2298 -background {#e2effa}
2299 $ui_diff tag conf d_-s \
2301 -background {#e2effa}
2302 $ui_diff tag conf d_s
+ \
2303 -foreground {#00a000} \
2305 $ui_diff tag conf d_s- \
2309 $ui_diff tag conf d
<<<<<<< \
2310 -foreground orange \
2312 $ui_diff tag conf d
======= \
2313 -foreground orange \
2315 $ui_diff tag conf d
>>>>>>> \
2316 -foreground orange \
2319 $ui_diff tag raise sel
2321 # -- Diff Body Context Menu
2323 set ctxm .vpane.lower.
diff.body.ctxm
2324 menu
$ctxm -tearoff 0
2327 -command reshow_diff
2328 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2331 -command {tk_textCopy
$ui_diff}
2332 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2334 -label {Select All
} \
2335 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
2336 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2340 $ui_diff tag add sel
0.0 end
2341 tk_textCopy
$ui_diff
2342 $ui_diff tag remove sel
0.0 end
2344 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2347 -label {Apply
/Reverse Hunk
} \
2348 -command {apply_hunk
$cursorX $cursorY}
2349 set ui_diff_applyhunk
[$ctxm index last
]
2350 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
2353 -label {Decrease Font Size
} \
2354 -command {incr_font_size font_diff
-1}
2355 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2357 -label {Increase Font Size
} \
2358 -command {incr_font_size font_diff
1}
2359 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2362 -label {Show Less Context
} \
2363 -command {if {$repo_config(gui.diffcontext
) >= 1} {
2364 incr repo_config
(gui.diffcontext
) -1
2367 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2369 -label {Show More Context
} \
2370 -command {if {$repo_config(gui.diffcontext
) < 99} {
2371 incr repo_config
(gui.diffcontext
)
2374 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
2376 $ctxm add
command -label {Options...
} \
2378 bind_button3
$ui_diff "
2381 if {\$ui_index eq \$current_diff_side} {
2382 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
2384 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
2386 tk_popup $ctxm %X %Y
2388 unset ui_diff_applyhunk
2392 set main_status
[::status_bar
::new .status
]
2393 pack .status
-anchor w
-side bottom
-fill x
2394 $main_status show
{Initializing...
}
2399 set gm
$repo_config(gui.geometry
)
2400 wm geometry .
[lindex
$gm 0]
2401 .vpane sash place
0 \
2402 [lindex
[.vpane sash coord
0] 0] \
2404 .vpane.files sash place
0 \
2406 [lindex
[.vpane.files sash coord
0] 1]
2412 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2413 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
2414 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
2415 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2416 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2417 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2418 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2419 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2420 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2421 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2422 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2424 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2425 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2426 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2427 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2428 bind $ui_diff <$M1B-Key-v> {break}
2429 bind $ui_diff <$M1B-Key-V> {break}
2430 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2431 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2432 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2433 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2434 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2435 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2436 bind $ui_diff <Key-k
> {catch
{%W yview scroll
-1 units
};break}
2437 bind $ui_diff <Key-j
> {catch
{%W yview scroll
1 units
};break}
2438 bind $ui_diff <Key-h
> {catch
{%W xview scroll
-1 units
};break}
2439 bind $ui_diff <Key-l
> {catch
{%W xview scroll
1 units
};break}
2440 bind $ui_diff <Control-Key-b
> {catch
{%W yview scroll
-1 pages
};break}
2441 bind $ui_diff <Control-Key-f
> {catch
{%W yview scroll
1 pages
};break}
2442 bind $ui_diff <Button-1
> {focus
%W
}
2444 if {[is_enabled branch
]} {
2445 bind .
<$M1B-Key-n> branch_create
::dialog
2446 bind .
<$M1B-Key-N> branch_create
::dialog
2447 bind .
<$M1B-Key-o> branch_checkout
::dialog
2448 bind .
<$M1B-Key-O> branch_checkout
::dialog
2450 if {[is_enabled transport
]} {
2451 bind .
<$M1B-Key-p> do_push_anywhere
2452 bind .
<$M1B-Key-P> do_push_anywhere
2455 bind .
<Key-F5
> do_rescan
2456 bind .
<$M1B-Key-r> do_rescan
2457 bind .
<$M1B-Key-R> do_rescan
2458 bind .
<$M1B-Key-s> do_signoff
2459 bind .
<$M1B-Key-S> do_signoff
2460 bind .
<$M1B-Key-i> do_add_all
2461 bind .
<$M1B-Key-I> do_add_all
2462 bind .
<$M1B-Key-Return> do_commit
2463 foreach i
[list
$ui_index $ui_workdir] {
2464 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2465 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2466 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2470 set file_lists
($ui_index) [list
]
2471 set file_lists
($ui_workdir) [list
]
2473 wm title .
"[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2474 focus
-force $ui_comm
2476 # -- Warn the user about environmental problems. Cygwin's Tcl
2477 # does *not* pass its env array onto any processes it spawns.
2478 # This means that git processes get none of our environment.
2483 set msg
"Possible environment issues exist.
2485 The following environment variables are probably
2486 going to be ignored by any Git subprocess run
2490 foreach name
[array names env
] {
2491 switch
-regexp -- $name {
2492 {^GIT_INDEX_FILE$
} -
2493 {^GIT_OBJECT_DIRECTORY$
} -
2494 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
2496 {^GIT_EXTERNAL_DIFF$
} -
2500 {^GIT_CONFIG_LOCAL$
} -
2501 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
2502 append msg
" - $name\n"
2505 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
2506 append msg
" - $name\n"
2508 set suggest_user
$name
2512 if {$ignored_env > 0} {
2514 This is due to a known issue with the
2515 Tcl binary distributed by Cygwin."
2517 if {$suggest_user ne
{}} {
2520 A good replacement for $suggest_user
2521 is placing values for the user.name and
2522 user.email settings into your personal
2528 unset ignored_env msg suggest_user name
2531 # -- Only initialize complex UI if we are going to stay running.
2533 if {[is_enabled transport
]} {
2540 # -- Only suggest a gc run if we are going to stay running.
2542 if {[is_enabled multicommit
]} {
2543 set object_limit
2000
2544 if {[is_Windows
]} {set object_limit
200}
2545 regexp
{^
([0-9]+) objects
,} [git count-objects
] _junk objects_current
2546 if {$objects_current >= $object_limit} {
2548 "This repository currently has $objects_current loose objects.
2550 To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2552 Compress the database now?"] eq
yes} {
2556 unset object_limit _junk objects_current
2559 lock_index begin-read