2006-11-19 07:57:58 +00:00
#!/bin/sh
2006-11-06 19:20:27 +00:00
# Tcl ignores the next line -*- tcl -*- \
exec wish " $0 " -- " $@ "
2007-02-12 21:12:04 +00:00
set appvers { @@GITGUI_VERSION@@}
2006-11-21 07:36:55 +00:00
set copyright {
2007-02-19 02:06:48 +00:00
Copyright <20> 2006, 2007 Shawn Pearce, et. al.
2006-11-21 07:36:55 +00:00
2007-01-21 01:08:20 +00:00
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
( at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA}
2006-11-06 19:20:27 +00:00
2007-01-21 02:48:56 +00:00
######################################################################
##
## read only globals
set _appname [ lindex [ file split $argv0 ] end]
set _gitdir { }
2007-01-29 01:58:47 +00:00
set _gitexec { }
2007-01-21 02:48:56 +00:00
set _reponame { }
2007-01-29 01:58:47 +00:00
set _iscygwin { }
2007-01-21 02:48:56 +00:00
proc appname { } {
global _appname
return $_appname
}
2007-01-21 02:55:05 +00:00
proc gitdir { args} {
2007-01-21 02:48:56 +00:00
global _gitdir
2007-01-21 02:55:05 +00:00
if { $args eq { } } {
return $_gitdir
}
return [ eval [ concat [ list file join $_gitdir ] $args ] ]
2007-01-21 02:48:56 +00:00
}
2007-01-29 01:58:47 +00:00
proc gitexec { args} {
global _gitexec
if { $_gitexec eq { } } {
2007-02-13 03:48:56 +00:00
if { [ catch { set _gitexec [ git --exec-path] } err] } {
2007-01-29 01:58:47 +00:00
error " Git not installed?\n\n $err "
}
}
if { $args eq { } } {
return $_gitexec
}
return [ eval [ concat [ list file join $_gitexec ] $args ] ]
}
2007-01-21 02:48:56 +00:00
proc reponame { } {
global _reponame
return $_reponame
}
2006-11-12 00:03:06 +00:00
2007-01-29 01:58:47 +00:00
proc is_MacOSX { } {
global tcl_platform tk_library
if { [ tk windowingsystem] eq { aqua} } {
return 1
}
return 0
}
proc is_Windows { } {
global tcl_platform
if { $tcl_platform ( platform) eq { windows} } {
return 1
}
return 0
}
proc is_Cygwin { } {
global tcl_platform _iscygwin
if { $_iscygwin eq { } } {
if { $tcl_platform ( platform) eq { windows} } {
if { [ catch { set p [ exec cygpath --windir] } err] } {
set _iscygwin 0
} else {
set _iscygwin 1
}
} else {
set _iscygwin 0
}
}
return $_iscygwin
}
2007-02-08 23:03:41 +00:00
proc is_enabled { option} {
global enabled_options
if { [ catch { set on $enabled_options ( $option ) } ] } { return 0}
return $on
}
proc enable_option { option} {
global enabled_options
set enabled_options( $option ) 1
}
proc disable_option { option} {
global enabled_options
set enabled_options( $option ) 0
}
2006-11-09 04:42:51 +00:00
######################################################################
##
## config
2006-11-12 08:47:00 +00:00
proc is_many_config { name} {
switch -glob -- $name {
remote.*.fetch -
remote.*.push
{ return 1}
*
{ return 0}
}
}
2006-11-09 04:42:51 +00:00
2007-01-26 09:43:43 +00:00
proc is_config_true { name} {
global repo_config
if { [ catch { set v $repo_config ( $name ) } ] } {
return 0
} elseif { $v eq { true} || $v eq { 1} || $v eq { yes} } {
return 1
} else {
return 0
}
}
2006-11-12 21:24:52 +00:00
proc load_config { include_global} {
2006-11-12 08:47:00 +00:00
global repo_config global_config default_config
array unset global_config
2006-11-12 21:24:52 +00:00
if { $include_global } {
catch {
2007-02-09 00:53:36 +00:00
set fd_rc [ open "| git config --global --list" r]
2006-11-12 21:24:52 +00:00
while { [ gets $fd_rc line] >= 0} {
if { [ regexp { ^( [ ^= ] +) = ( .*) $} $line line name value] } {
if { [ is_many_config $name ] } {
lappend global_config( $name ) $value
} else {
set global_config( $name ) $value
}
2006-11-12 08:47:00 +00:00
}
}
2006-11-12 21:24:52 +00:00
close $fd_rc
2006-11-12 08:47:00 +00:00
}
}
2006-11-12 21:24:52 +00:00
array unset repo_config
2006-11-09 04:42:51 +00:00
catch {
2007-02-09 00:53:36 +00:00
set fd_rc [ open "| git config --list" r]
2006-11-09 04:42:51 +00:00
while { [ gets $fd_rc line] >= 0} {
if { [ regexp { ^( [ ^= ] +) = ( .*) $} $line line name value] } {
2006-11-12 08:47:00 +00:00
if { [ is_many_config $name ] } {
lappend repo_config( $name ) $value
} else {
set repo_config( $name ) $value
}
2006-11-09 04:42:51 +00:00
}
}
close $fd_rc
}
2006-11-12 08:47:00 +00:00
foreach name [ array names default_config] {
if { [ catch { set v $global_config ( $name ) } ] } {
set global_config( $name ) $default_config ( $name )
}
if { [ catch { set v $repo_config ( $name ) } ] } {
set repo_config( $name ) $default_config ( $name )
}
2006-11-09 04:42:51 +00:00
}
}
2006-11-12 08:47:00 +00:00
proc save_config { } {
2006-11-12 10:27:00 +00:00
global default_config font_descs
global repo_config global_config
2006-11-12 08:47:00 +00:00
global repo_config_new global_config_new
2006-11-09 04:42:51 +00:00
2006-11-12 10:27:00 +00:00
foreach option $font_descs {
set name [ lindex $option 0]
set font [ lindex $option 1]
font configure $font \
-family $global_config_new ( gui.$font ^^family) \
-size $global_config_new ( gui.$font ^^size)
font configure ${ font } bold \
-family $global_config_new ( gui.$font ^^family) \
-size $global_config_new ( gui.$font ^^size)
set global_config_new( gui.$name ) [ font configure $font ]
unset global_config_new( gui.$font ^^family)
unset global_config_new( gui.$font ^^size)
}
foreach name [ array names default_config] {
2006-11-12 08:47:00 +00:00
set value $global_config_new ( $name )
2006-11-12 23:16:45 +00:00
if { $value ne $global_config ( $name ) } {
if { $value eq $default_config ( $name ) } {
2007-02-13 03:48:56 +00:00
catch { git config --global --unset $name }
2006-11-12 08:47:00 +00:00
} else {
2006-11-12 20:45:35 +00:00
regsub -all "\[{}\]" $value { " } value
2007-02-13 03:48:56 +00:00
git config --global $name $value
2006-11-12 08:47:00 +00:00
}
set global_config( $name ) $value
2006-11-12 23:16:45 +00:00
if { $value eq $repo_config ( $name ) } {
2007-02-13 03:48:56 +00:00
catch { git config --unset $name }
2006-11-12 08:47:00 +00:00
set repo_config( $name ) $value
}
}
2006-11-09 04:42:51 +00:00
}
2006-11-12 10:27:00 +00:00
foreach name [ array names default_config] {
2006-11-12 08:47:00 +00:00
set value $repo_config_new ( $name )
2006-11-12 23:16:45 +00:00
if { $value ne $repo_config ( $name ) } {
if { $value eq $global_config ( $name ) } {
2007-02-13 03:48:56 +00:00
catch { git config --unset $name }
2006-11-12 08:47:00 +00:00
} else {
2006-11-12 20:45:35 +00:00
regsub -all "\[{}\]" $value { " } value
2007-02-13 03:48:56 +00:00
git config $name $value
2006-11-12 08:47:00 +00:00
}
set repo_config( $name ) $value
}
2006-11-09 04:42:51 +00:00
}
}
2007-02-13 03:48:56 +00:00
######################################################################
##
## handy utils
proc git { args} {
return [ eval exec git $args ]
}
2006-11-12 00:03:06 +00:00
proc error_popup { msg} {
2007-01-21 02:48:56 +00:00
set title [ appname]
if { [ reponame] ne { } } {
append title " ([reponame])"
2006-11-12 00:03:06 +00:00
}
2007-03-27 10:29:08 +00:00
option add *Dialog.msg.font font_ui
option add *Button.font font_ui
2006-11-18 06:20:37 +00:00
set cmd [ list tk_messageBox \
2006-11-12 00:03:06 +00:00
-icon error \
-type ok \
-title " $title : error " \
2006-11-18 06:20:37 +00:00
-message $msg ]
if { [ winfo ismapped .] } {
lappend cmd -parent .
}
eval $cmd
2006-11-12 00:03:06 +00:00
}
2006-11-21 20:28:14 +00:00
proc warn_popup { msg} {
2007-01-21 02:48:56 +00:00
set title [ appname]
if { [ reponame] ne { } } {
append title " ([reponame])"
2006-11-21 20:28:14 +00:00
}
2007-03-27 10:29:08 +00:00
option add *Dialog.msg.font font_ui
option add *Button.font font_ui
2006-11-21 20:28:14 +00:00
set cmd [ list tk_messageBox \
-icon warning \
-type ok \
-title " $title : warning " \
-message $msg ]
if { [ winfo ismapped .] } {
lappend cmd -parent .
}
eval $cmd
}
2007-01-26 09:07:34 +00:00
proc info_popup { msg { parent .} } {
2007-01-21 02:48:56 +00:00
set title [ appname]
if { [ reponame] ne { } } {
append title " ([reponame])"
2006-11-12 02:52:06 +00:00
}
2007-03-27 10:29:08 +00:00
option add *Dialog.msg.font font_ui
option add *Button.font font_ui
2006-11-12 02:52:06 +00:00
tk_messageBox \
2007-01-26 09:07:34 +00:00
-parent $parent \
2006-11-21 20:28:14 +00:00
-icon info \
2006-11-12 02:52:06 +00:00
-type ok \
-title $title \
-message $msg
}
2007-01-21 02:23:21 +00:00
proc ask_popup { msg} {
2007-01-21 02:48:56 +00:00
set title [ appname]
if { [ reponame] ne { } } {
append title " ([reponame])"
2007-01-21 02:23:21 +00:00
}
2007-03-27 10:29:08 +00:00
option add *Dialog.msg.font font_ui
option add *Button.font font_ui
2007-01-21 02:23:21 +00:00
return [ tk_messageBox \
-parent . \
-icon question \
-type yesno \
-title $title \
-message $msg ]
}
2007-02-14 04:15:25 +00:00
######################################################################
##
## version check
2007-03-12 17:24:10 +00:00
if { { --version} eq $argv || { version} eq $argv } {
puts " git-gui version $appvers "
exit
}
2007-02-14 04:15:25 +00:00
set req_maj 1
set req_min 5
if { [ catch { set v [ git --version] } err] } {
catch { wm withdraw .}
error_popup " Cannot determine Git version:
$err
[ appname] requires Git $req_maj .$req_min or later."
exit 1
}
if { [ regexp { ^git version ( \d +) \. ( \d +) } $v _junk act_maj act_min] } {
if { $act_maj < $req_maj
|| ( $act_maj = = $req_maj && $act_min < $req_min ) } {
catch { wm withdraw .}
error_popup " [appname] requires Git $req_maj . $req_min or later.
You are using $v ."
exit 1
}
} else {
catch { wm withdraw .}
error_popup " Cannot parse Git version string:\n\n $v "
exit 1
}
unset -nocomplain v _junk act_maj act_min req_maj req_min
2006-11-09 04:42:51 +00:00
######################################################################
##
## repository setup
2007-01-21 02:48:56 +00:00
if { [ catch { set _gitdir $env ( GIT_DIR) } ]
2007-02-13 03:48:56 +00:00
&& [ catch { set _gitdir [ git rev-parse --git-dir] } err] } {
2006-11-12 00:10:10 +00:00
catch { wm withdraw .}
error_popup " Cannot find the git directory:\n\n $err "
2006-11-09 04:42:51 +00:00
exit 1
}
2007-01-29 01:58:47 +00:00
if { ![ file isdirectory $_gitdir ] && [ is_Cygwin] } {
catch { set _gitdir [ exec cygpath --unix $_gitdir ] }
}
2007-01-21 02:48:56 +00:00
if { ![ file isdirectory $_gitdir ] } {
2006-11-16 03:45:33 +00:00
catch { wm withdraw .}
2007-01-21 02:48:56 +00:00
error_popup " Git directory not found:\n\n $_gitdir "
2006-11-16 03:45:33 +00:00
exit 1
}
2007-01-21 02:48:56 +00:00
if { [ lindex [ file split $_gitdir ] end] ne { .git} } {
2006-11-16 03:45:33 +00:00
catch { wm withdraw .}
2007-01-29 01:58:47 +00:00
error_popup " Cannot use funny .git directory:\n\n $_gitdir "
2006-11-16 03:45:33 +00:00
exit 1
}
2007-01-21 02:48:56 +00:00
if { [ catch { cd [ file dirname $_gitdir ] } err] } {
2006-11-16 03:13:45 +00:00
catch { wm withdraw .}
2007-01-21 02:48:56 +00:00
error_popup " No working directory [file dirname $_gitdir ]:\n\n $err "
2006-11-16 03:13:45 +00:00
exit 1
2006-11-09 04:42:51 +00:00
}
2007-01-21 02:48:56 +00:00
set _reponame [ lindex [ file split \
[ file normalize [ file dirname $_gitdir ] ] ] \
2007-01-21 02:36:21 +00:00
end]
2006-11-09 04:42:51 +00:00
2007-02-18 07:12:32 +00:00
######################################################################
##
## global init
set current_diff_path { }
set current_diff_side { }
set diff_actions [ list]
set ui_status_value { Initializing...}
set HEAD { }
set PARENT { }
set MERGE_HEAD [ list]
set commit_type { }
set empty_tree { }
set current_branch { }
set current_diff_path { }
set selected_commit_type new
2006-11-06 19:20:27 +00:00
######################################################################
##
2006-11-07 00:12:58 +00:00
## task management
2006-11-06 19:20:27 +00:00
2006-11-14 06:29:32 +00:00
set rescan_active 0
2006-11-06 21:07:32 +00:00
set diff_active 0
2006-11-13 21:06:38 +00:00
set last_clicked { }
2006-11-06 21:07:32 +00:00
2006-11-07 00:12:58 +00:00
set disable_on_lock [ list]
set index_lock_type none
proc lock_index { type} {
global index_lock_type disable_on_lock
2006-11-06 21:07:32 +00:00
2006-11-12 23:16:45 +00:00
if { $index_lock_type eq { none} } {
2006-11-07 00:12:58 +00:00
set index_lock_type $type
foreach w $disable_on_lock {
uplevel #0 $w disabled
}
return 1
2006-11-18 08:31:25 +00:00
} elseif { $index_lock_type eq " begin- $type " } {
2006-11-07 00:12:58 +00:00
set index_lock_type $type
2006-11-06 21:07:32 +00:00
return 1
}
return 0
}
2006-11-06 19:20:27 +00:00
2006-11-07 00:12:58 +00:00
proc unlock_index { } {
global index_lock_type disable_on_lock
set index_lock_type none
foreach w $disable_on_lock {
uplevel #0 $w normal
}
}
######################################################################
##
## status
2006-11-21 02:27:22 +00:00
proc repository_state { ctvar hdvar mhvar} {
2007-01-21 02:48:56 +00:00
global current_branch
2006-11-21 02:27:22 +00:00
upvar $ctvar ct $hdvar hd $mhvar mh
set mh [ list]
2006-11-07 01:50:59 +00:00
2007-02-13 03:48:56 +00:00
if { [ catch { set current_branch [ git symbolic-ref HEAD] } ] } {
2006-11-24 20:38:18 +00:00
set current_branch { }
} else {
2006-11-25 07:45:19 +00:00
regsub ^refs/( ( heads| tags| remotes) /) ? \
2006-11-24 20:38:18 +00:00
$current_branch \
{ } \
current_branch
}
2007-02-13 03:48:56 +00:00
if { [ catch { set hd [ git rev-parse --verify HEAD] } ] } {
2006-11-18 07:50:58 +00:00
set hd { }
2006-11-07 01:50:59 +00:00
set ct initial
2006-11-21 02:27:22 +00:00
return
}
2007-01-21 02:55:05 +00:00
set merge_head [ gitdir MERGE_HEAD]
2006-11-21 02:27:22 +00:00
if { [ file exists $merge_head ] } {
2006-11-07 01:50:59 +00:00
set ct merge
2006-11-21 02:27:22 +00:00
set fd_mh [ open $merge_head r]
while { [ gets $fd_mh line] >= 0} {
lappend mh $line
}
close $fd_mh
return
2006-11-07 01:50:59 +00:00
}
2006-11-21 02:27:22 +00:00
set ct normal
2006-11-07 01:50:59 +00:00
}
2006-11-18 07:50:58 +00:00
proc PARENT { } {
global PARENT empty_tree
2006-11-21 02:27:22 +00:00
set p [ lindex $PARENT 0]
if { $p ne { } } {
return $p
2006-11-18 07:50:58 +00:00
}
if { $empty_tree eq { } } {
2007-02-13 03:48:56 +00:00
set empty_tree [ git mktree << { } ]
2006-11-18 07:50:58 +00:00
}
return $empty_tree
}
2007-01-22 22:10:38 +00:00
proc rescan { after { honor_trustmtime 1} } {
2006-11-21 02:27:22 +00:00
global HEAD PARENT MERGE_HEAD commit_type
2007-01-21 03:06:51 +00:00
global ui_index ui_workdir ui_status_value ui_comm
2006-11-14 06:29:32 +00:00
global rescan_active file_states
2007-02-08 23:03:41 +00:00
global repo_config
2006-11-06 19:20:27 +00:00
2006-11-14 06:29:32 +00:00
if { $rescan_active > 0 || ![ lock_index read] } return
2006-11-06 19:20:27 +00:00
2006-11-21 02:27:22 +00:00
repository_state newType newHEAD newMERGE_HEAD
2006-11-18 07:50:58 +00:00
if { [ string match amend* $commit_type ]
2006-11-21 02:27:22 +00:00
&& $newType eq { normal}
&& $newHEAD eq $HEAD } {
2006-11-07 02:34:10 +00:00
} else {
2006-11-21 02:27:22 +00:00
set HEAD $newHEAD
set PARENT $newHEAD
set MERGE_HEAD $newMERGE_HEAD
set commit_type $newType
2006-11-07 02:34:10 +00:00
}
2006-11-06 19:20:27 +00:00
array unset file_states
2006-11-06 21:07:32 +00:00
if { ![ $ui_comm edit modified]
2006-11-12 23:16:45 +00:00
|| [ string trim [ $ui_comm get 0.0 end] ] eq { } } {
2006-11-06 21:07:32 +00:00
if { [ load_message GITGUI_MSG] } {
} elseif { [ load_message MERGE_MSG] } {
} elseif { [ load_message SQUASH_MSG] } {
}
2006-11-11 21:16:25 +00:00
$ui_comm edit reset
2006-11-21 02:59:19 +00:00
$ui_comm edit modified false
2006-11-06 21:07:32 +00:00
}
2007-02-08 23:10:05 +00:00
if { [ is_enabled branch] } {
2007-02-08 20:59:39 +00:00
load_all_heads
populate_branch_menu
}
2007-01-22 22:10:38 +00:00
if { $honor_trustmtime && $repo_config ( gui.trustmtime) eq { true} } {
2006-11-14 06:29:32 +00:00
rescan_stage2 { } $after
2006-11-08 02:27:29 +00:00
} else {
2006-11-14 06:29:32 +00:00
set rescan_active 1
2006-11-08 02:27:29 +00:00
set ui_status_value { Refreshing file status...}
2006-11-12 02:52:06 +00:00
set cmd [ list git update-index]
lappend cmd -q
lappend cmd --unmerged
lappend cmd --ignore-missing
lappend cmd --refresh
set fd_rf [ open " | $cmd " r]
2006-11-08 02:27:29 +00:00
fconfigure $fd_rf -blocking 0 -translation binary
2006-11-12 00:40:33 +00:00
fileevent $fd_rf readable \
2006-11-14 06:29:32 +00:00
[ list rescan_stage2 $fd_rf $after ]
2006-11-08 02:27:29 +00:00
}
2006-11-06 21:07:32 +00:00
}
2006-11-14 06:29:32 +00:00
proc rescan_stage2 { fd after} {
2007-01-21 02:48:56 +00:00
global ui_status_value
2006-11-18 07:50:58 +00:00
global rescan_active buf_rdi buf_rdf buf_rlo
2006-11-06 21:07:32 +00:00
2006-11-12 23:16:45 +00:00
if { $fd ne { } } {
2006-11-08 02:27:29 +00:00
read $fd
if { ![ eof $fd ] } return
close $fd
}
2006-11-06 21:07:32 +00:00
2006-11-06 19:20:27 +00:00
set ls_others [ list | git ls-files --others -z \
--exclude-per-directory= .gitignore]
2007-01-21 02:55:05 +00:00
set info_exclude [ gitdir info exclude]
2006-11-06 19:20:27 +00:00
if { [ file readable $info_exclude ] } {
lappend ls_others " --exclude-from= $info_exclude "
}
2006-11-07 23:34:09 +00:00
set buf_rdi { }
set buf_rdf { }
set buf_rlo { }
2006-11-14 06:29:32 +00:00
set rescan_active 3
2006-11-06 21:07:32 +00:00
set ui_status_value { Scanning for modified files ...}
2006-11-18 07:50:58 +00:00
set fd_di [ open "| git diff-index --cached -z [PARENT]" r]
2006-11-06 19:20:27 +00:00
set fd_df [ open "| git diff-files -z" r]
set fd_lo [ open $ls_others r]
2007-01-23 09:07:18 +00:00
fconfigure $fd_di -blocking 0 -translation binary -encoding binary
fconfigure $fd_df -blocking 0 -translation binary -encoding binary
fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
2006-11-14 06:29:32 +00:00
fileevent $fd_di readable [ list read_diff_index $fd_di $after ]
fileevent $fd_df readable [ list read_diff_files $fd_df $after ]
fileevent $fd_lo readable [ list read_ls_others $fd_lo $after ]
2006-11-06 19:20:27 +00:00
}
2006-11-06 21:07:32 +00:00
proc load_message { file} {
2007-01-21 02:48:56 +00:00
global ui_comm
2006-11-06 21:07:32 +00:00
2007-01-21 02:55:05 +00:00
set f [ gitdir $file ]
2006-11-07 02:34:10 +00:00
if { [ file isfile $f ] } {
2006-11-06 21:07:32 +00:00
if { [ catch { set fd [ open $f r] } ] } {
return 0
}
2006-11-07 02:34:10 +00:00
set content [ string trim [ read $fd ] ]
2006-11-06 21:07:32 +00:00
close $fd
2007-01-25 17:54:59 +00:00
regsub -all -line { [ \r \t ] +$} $content { } content
2006-11-06 21:07:32 +00:00
$ui_comm delete 0.0 end
$ui_comm insert end $content
return 1
}
return 0
}
2006-11-14 06:29:32 +00:00
proc read_diff_index { fd after} {
2006-11-06 19:20:27 +00:00
global buf_rdi
append buf_rdi [ read $fd ]
2006-11-07 23:34:09 +00:00
set c 0
set n [ string length $buf_rdi ]
while { $c < $n } {
set z1 [ string first "\0" $buf_rdi $c ]
if { $z1 = = -1} break
incr z1
set z2 [ string first "\0" $buf_rdi $z1 ]
if { $z2 = = -1} break
incr c
2006-11-19 06:00:48 +00:00
set i [ split [ string range $buf_rdi $c [ expr { $z1 - 2} ] ] { } ]
2007-01-23 09:07:18 +00:00
set p [ string range $buf_rdi $z1 [ expr { $z2 - 1} ] ]
2006-11-19 05:29:55 +00:00
merge_state \
2007-01-23 09:07:18 +00:00
[ encoding convertfrom $p ] \
2006-11-19 06:00:48 +00:00
[ lindex $i 4] ? \
[ list [ lindex $i 0] [ lindex $i 2] ] \
2006-11-19 05:29:55 +00:00
[ list]
set c $z2
2006-11-19 06:00:48 +00:00
incr c
2006-11-06 19:20:27 +00:00
}
2006-11-07 23:34:09 +00:00
if { $c < $n } {
set buf_rdi [ string range $buf_rdi $c end]
} else {
set buf_rdi { }
}
2006-11-14 06:29:32 +00:00
rescan_done $fd buf_rdi $after
2006-11-06 19:20:27 +00:00
}
2006-11-14 06:29:32 +00:00
proc read_diff_files { fd after} {
2006-11-06 19:20:27 +00:00
global buf_rdf
append buf_rdf [ read $fd ]
2006-11-07 23:34:09 +00:00
set c 0
set n [ string length $buf_rdf ]
while { $c < $n } {
set z1 [ string first "\0" $buf_rdf $c ]
if { $z1 = = -1} break
incr z1
set z2 [ string first "\0" $buf_rdf $z1 ]
if { $z2 = = -1} break
incr c
2006-11-19 06:00:48 +00:00
set i [ split [ string range $buf_rdf $c [ expr { $z1 - 2} ] ] { } ]
2007-01-23 09:07:18 +00:00
set p [ string range $buf_rdf $z1 [ expr { $z2 - 1} ] ]
2006-11-19 05:29:55 +00:00
merge_state \
2007-01-23 09:07:18 +00:00
[ encoding convertfrom $p ] \
2006-11-19 06:00:48 +00:00
?[ lindex $i 4] \
2006-11-19 05:29:55 +00:00
[ list] \
2006-11-19 06:00:48 +00:00
[ list [ lindex $i 0] [ lindex $i 2] ]
2006-11-19 05:29:55 +00:00
set c $z2
2006-11-19 06:00:48 +00:00
incr c
2006-11-07 23:34:09 +00:00
}
if { $c < $n } {
set buf_rdf [ string range $buf_rdf $c end]
} else {
set buf_rdf { }
2006-11-06 19:20:27 +00:00
}
2006-11-07 23:34:09 +00:00
2006-11-14 06:29:32 +00:00
rescan_done $fd buf_rdf $after
2006-11-06 19:20:27 +00:00
}
2006-11-14 06:29:32 +00:00
proc read_ls_others { fd after} {
2006-11-06 19:20:27 +00:00
global buf_rlo
append buf_rlo [ read $fd ]
set pck [ split $buf_rlo "\0" ]
set buf_rlo [ lindex $pck end]
foreach p [ lrange $pck 0 end-1] {
2007-01-23 09:07:18 +00:00
merge_state [ encoding convertfrom $p ] ?O
2006-11-06 19:20:27 +00:00
}
2006-11-14 06:29:32 +00:00
rescan_done $fd buf_rlo $after
2006-11-06 19:20:27 +00:00
}
2006-11-14 06:29:32 +00:00
proc rescan_done { fd buf after} {
global rescan_active
2006-11-13 09:22:42 +00:00
global file_states repo_config
2006-11-11 23:38:00 +00:00
upvar $buf to_clear
2006-11-06 19:20:27 +00:00
2006-11-13 09:22:42 +00:00
if { ![ eof $fd ] } return
set to_clear { }
close $fd
2006-11-14 06:29:32 +00:00
if { [ incr rescan_active -1] > 0} return
2006-11-08 00:30:54 +00:00
2006-11-13 21:06:38 +00:00
prune_selection
2006-11-13 09:22:42 +00:00
unlock_index
display_all_files
reshow_diff
2006-11-14 06:29:32 +00:00
uplevel #0 $after
2006-11-06 19:20:27 +00:00
}
2006-11-13 21:06:38 +00:00
proc prune_selection { } {
global file_states selected_paths
foreach path [ array names selected_paths] {
if { [ catch { set still_here $file_states ( $path ) } ] } {
unset selected_paths( $path )
}
}
}
2006-11-06 19:20:27 +00:00
######################################################################
##
## diff
proc clear_diff { } {
2007-01-25 02:20:57 +00:00
global ui_diff current_diff_path current_diff_header
global ui_index ui_workdir
2006-11-06 19:20:27 +00:00
$ui_diff conf -state normal
$ui_diff delete 0.0 end
$ui_diff conf -state disabled
2006-11-11 22:52:16 +00:00
2007-01-21 16:37:58 +00:00
set current_diff_path { }
2007-01-25 02:20:57 +00:00
set current_diff_header { }
2006-11-11 22:52:16 +00:00
$ui_index tag remove in_diff 0.0 end
2007-01-21 03:06:51 +00:00
$ui_workdir tag remove in_diff 0.0 end
2006-11-06 19:20:27 +00:00
}
2006-11-11 23:38:00 +00:00
proc reshow_diff { } {
2007-01-21 18:22:26 +00:00
global ui_status_value file_states file_lists
2007-01-21 16:54:16 +00:00
global current_diff_path current_diff_side
2006-11-11 23:38:00 +00:00
2007-01-21 18:22:26 +00:00
set p $current_diff_path
2007-02-18 07:12:32 +00:00
if { $p eq { } } {
# No diff is being shown.
} elseif { $current_diff_side eq { }
2007-01-21 18:22:26 +00:00
|| [ catch { set s $file_states ( $p ) } ]
2007-01-26 03:38:59 +00:00
|| [ lsearch -sorted -exact $file_lists ( $current_diff_side ) $p ] = = -1} {
2006-11-11 23:38:00 +00:00
clear_diff
2006-11-11 23:42:42 +00:00
} else {
2007-01-21 18:22:26 +00:00
show_diff $p $current_diff_side
2006-11-11 23:38:00 +00:00
}
}
2006-11-12 02:52:06 +00:00
proc handle_empty_diff { } {
2007-01-21 16:37:58 +00:00
global current_diff_path file_states file_lists
2006-11-12 02:52:06 +00:00
2007-01-21 16:37:58 +00:00
set path $current_diff_path
2006-11-12 02:52:06 +00:00
set s $file_states ( $path )
2006-11-12 23:16:45 +00:00
if { [ lindex $s 0] ne { _M} } return
2006-11-12 02:52:06 +00:00
info_popup " No differences detected.
[ short_path $path ] has no changes.
2007-03-27 10:31:55 +00:00
The modification date of this file was updated by another application, but the content within the file was not changed.
2007-01-23 03:41:13 +00:00
2007-03-27 10:31:55 +00:00
A rescan will be automatically started to find other files which may have the same state."
2006-11-12 02:52:06 +00:00
clear_diff
2007-01-21 03:45:19 +00:00
display_file $path __
2007-01-22 22:10:38 +00:00
rescan { set ui_status_value { Ready.} } 0
2006-11-12 02:52:06 +00:00
}
2007-01-21 16:54:16 +00:00
proc show_diff { path w { lno { } } } {
2006-11-11 22:52:16 +00:00
global file_states file_lists
2006-11-19 07:46:52 +00:00
global is_3way_diff diff_active repo_config
2007-01-21 16:54:16 +00:00
global ui_diff ui_status_value ui_index ui_workdir
2007-01-25 02:20:57 +00:00
global current_diff_path current_diff_side current_diff_header
2006-11-06 19:20:27 +00:00
2006-11-07 00:12:58 +00:00
if { $diff_active || ![ lock_index read] } return
2006-11-06 19:20:27 +00:00
clear_diff
2007-01-26 02:33:06 +00:00
if { $lno = = { } } {
2007-01-26 03:38:59 +00:00
set lno [ lsearch -sorted -exact $file_lists ( $w ) $path ]
2007-01-26 02:33:06 +00:00
if { $lno >= 0} {
incr lno
2006-11-11 22:52:16 +00:00
}
}
2007-01-26 02:33:06 +00:00
if { $lno >= 1} {
2006-11-13 21:06:38 +00:00
$w tag add in_diff $lno .0 [ expr { $lno + 1} ] .0
2006-11-11 22:52:16 +00:00
}
2006-11-06 19:20:27 +00:00
set s $file_states ( $path )
set m [ lindex $s 0]
2006-11-19 07:46:52 +00:00
set is_3way_diff 0
2006-11-06 19:20:27 +00:00
set diff_active 1
2007-01-21 16:37:58 +00:00
set current_diff_path $path
2007-01-21 16:54:16 +00:00
set current_diff_side $w
2007-01-25 02:20:57 +00:00
set current_diff_header { }
2006-11-11 22:59:34 +00:00
set ui_status_value " Loading diff of [escape_path $path ]... "
2006-11-06 19:20:27 +00:00
2007-01-21 16:54:16 +00:00
# - Git won't give us the diff, there's nothing to compare to!
#
if { $m eq { _O} } {
2007-01-23 07:33:58 +00:00
set max_sz [ expr { 128 * 1024} ]
2006-11-06 19:20:27 +00:00
if { [ catch {
set fd [ open $path r]
2007-01-23 07:33:58 +00:00
set content [ read $fd $max_sz ]
2006-11-06 19:20:27 +00:00
close $fd
2007-01-23 07:33:58 +00:00
set sz [ file size $path ]
2006-11-06 19:20:27 +00:00
} err ] } {
2006-11-06 21:07:32 +00:00
set diff_active 0
2006-11-07 00:12:58 +00:00
unlock_index
2006-11-11 22:59:34 +00:00
set ui_status_value " Unable to display [escape_path $path ] "
2006-11-12 00:10:10 +00:00
error_popup " Error loading file:\n\n $err "
2006-11-06 19:20:27 +00:00
return
}
$ui_diff conf -state normal
2007-01-23 08:18:37 +00:00
if { ![ catch { set type [ exec file $path ] } ] } {
set n [ string length $path ]
if { [ string equal -length $n $path $type ] } {
set type [ string range $type $n end]
regsub { ^:?\s *} $type { } type
}
$ui_diff insert end " * $type \n " d_@
}
2007-01-23 07:33:58 +00:00
if { [ string first "\0" $content ] != -1} {
$ui_diff insert end \
"* Binary file (not showing content)." \
d_@
} else {
if { $sz > $max_sz } {
$ui_diff insert end \
" * Untracked file is $sz bytes.
* Showing only first $max_sz bytes.
" d_@
}
$ui_diff insert end $content
if { $sz > $max_sz } {
$ui_diff insert end "
* Untracked file clipped here by [ appname] .
* To see the entire file, use an external editor.
" d_@
}
}
2006-11-06 19:20:27 +00:00
$ui_diff conf -state disabled
2006-11-07 03:03:05 +00:00
set diff_active 0
unlock_index
set ui_status_value { Ready.}
2006-11-06 19:20:27 +00:00
return
}
2007-01-21 16:54:16 +00:00
set cmd [ list | git]
if { $w eq $ui_index } {
lappend cmd diff-index
lappend cmd --cached
} elseif { $w eq $ui_workdir } {
2007-01-21 17:30:51 +00:00
if { [ string index $m 0] eq { U} } {
lappend cmd diff
} else {
lappend cmd diff-files
}
2006-11-06 19:20:27 +00:00
}
2007-01-21 16:54:16 +00:00
lappend cmd -p
lappend cmd --no-color
if { $repo_config ( gui.diffcontext) > 0} {
lappend cmd " -U $repo_config (gui.diffcontext) "
}
if { $w eq $ui_index } {
lappend cmd [ PARENT]
}
2006-11-12 23:51:38 +00:00
lappend cmd --
lappend cmd $path
2006-11-06 19:20:27 +00:00
if { [ catch { set fd [ open $cmd r] } err] } {
2006-11-06 21:07:32 +00:00
set diff_active 0
2006-11-07 00:12:58 +00:00
unlock_index
2006-11-11 22:59:34 +00:00
set ui_status_value " Unable to display [escape_path $path ] "
2006-11-12 00:10:10 +00:00
error_popup " Error loading diff:\n\n $err "
2006-11-06 19:20:27 +00:00
return
}
2007-01-25 02:20:57 +00:00
fconfigure $fd \
-blocking 0 \
-encoding binary \
-translation binary
2006-11-06 19:20:27 +00:00
fileevent $fd readable [ list read_diff $fd ]
}
proc read_diff { fd} {
2007-01-25 02:20:57 +00:00
global ui_diff ui_status_value diff_active
global is_3way_diff current_diff_header
2006-11-06 19:20:27 +00:00
2006-11-19 07:46:52 +00:00
$ui_diff conf -state normal
2006-11-06 19:20:27 +00:00
while { [ gets $fd line] >= 0} {
2006-11-19 07:46:52 +00:00
# -- Cleanup uninteresting diff header lines.
#
2007-01-25 02:20:57 +00:00
if { [ string match { diff --git *} $line ]
|| [ string match { diff --cc *} $line ]
|| [ string match { diff --combined *} $line ]
|| [ string match { --- *} $line ]
|| [ string match { +++ *} $line ] } {
append current_diff_header $line "\n"
continue
}
if { [ string match { index *} $line ] } continue
2006-11-19 06:06:42 +00:00
if { $line eq { deleted file mode 120000} } {
set line "deleted symlink"
}
2006-11-06 19:20:27 +00:00
2006-11-19 07:46:52 +00:00
# -- Automatically detect if this is a 3 way diff.
#
if { [ string match { @@@ *} $line ] } { set is_3way_diff 1}
2007-01-25 02:20:57 +00:00
if { [ string match { mode *} $line ]
2007-01-22 23:24:45 +00:00
|| [ string match { new file *} $line ]
|| [ string match { deleted file *} $line ]
2007-01-23 08:25:17 +00:00
|| [ string match { Binary files * and * differ} $line ]
2007-01-23 00:18:39 +00:00
|| $line eq { \ No newline at end of file}
2007-01-21 19:23:51 +00:00
|| [ regexp { ^\* Unmerged path } $line ] } {
2007-01-21 18:12:02 +00:00
set tags { }
} elseif { $is_3way_diff } {
2006-11-19 07:46:52 +00:00
set op [ string range $line 0 1]
switch -- $op {
2007-01-21 18:12:02 +00:00
{ } { set tags { } }
2006-11-19 07:46:52 +00:00
{ @@} { set tags d_@}
2007-01-21 18:12:02 +00:00
{ +} { set tags d_s+}
{ -} { set tags d_s-}
{ + } { set tags d_+s}
{ - } { set tags d_-s}
{ --} { set tags d_--}
{ ++} {
if { [ regexp { ^\+ \+ ( [ <>] { 7} | = { 7} ) } $line _g op] } {
set line [ string replace $line 0 1 { } ]
set tags d$op
} else {
set tags d_++
}
}
default {
puts " error: Unhandled 3 way diff marker: { $op } "
set tags { }
}
2006-11-06 19:20:27 +00:00
}
} else {
2007-01-21 18:12:02 +00:00
set op [ string index $line 0]
switch -- $op {
{ } { set tags { } }
{ @} { set tags d_@}
{ -} { set tags d_-}
{ +} {
if { [ regexp { ^\+ ( [ <>] { 7} | = { 7} ) } $line _g op] } {
set line [ string replace $line 0 0 { } ]
set tags d$op
} else {
set tags d_+
}
}
default {
puts " error: Unhandled 2 way diff marker: { $op } "
set tags { }
}
2006-11-06 19:20:27 +00:00
}
}
$ui_diff insert end $line $tags
2007-01-25 02:30:23 +00:00
if { [ string index $line end] eq "\r" } {
$ui_diff tag add d_cr { end - 2c}
}
2006-11-19 07:46:52 +00:00
$ui_diff insert end "\n" $tags
2006-11-06 19:20:27 +00:00
}
2006-11-19 07:46:52 +00:00
$ui_diff conf -state disabled
2006-11-06 19:20:27 +00:00
if { [ eof $fd ] } {
close $fd
set diff_active 0
2006-11-07 00:12:58 +00:00
unlock_index
2006-11-06 19:20:27 +00:00
set ui_status_value { Ready.}
2006-11-12 02:52:06 +00:00
2007-01-23 03:41:13 +00:00
if { [ $ui_diff index end] eq { 2.0} } {
2006-11-12 02:52:06 +00:00
handle_empty_diff
}
2006-11-06 19:20:27 +00:00
}
}
2007-01-25 02:20:57 +00:00
proc apply_hunk { x y} {
global current_diff_path current_diff_header current_diff_side
global ui_diff ui_index file_states
if { $current_diff_path eq { } || $current_diff_header eq { } } return
if { ![ lock_index apply_hunk] } return
set apply_cmd { git apply --cached --whitespace= nowarn}
set mi [ lindex $file_states ( $current_diff_path ) 0]
if { $current_diff_side eq $ui_index } {
set mode unstage
lappend apply_cmd --reverse
if { [ string index $mi 0] ne { M} } {
unlock_index
return
}
} else {
set mode stage
if { [ string index $mi 1] ne { M} } {
unlock_index
return
}
}
set s_lno [ lindex [ split [ $ui_diff index @$x ,$y ] .] 0]
set s_lno [ $ui_diff search -backwards -regexp ^@@ $s_lno .0 0.0]
if { $s_lno eq { } } {
unlock_index
return
}
set e_lno [ $ui_diff search -forwards -regexp ^@@ " $s_lno + 1 lines " end]
if { $e_lno eq { } } {
set e_lno end
}
if { [ catch {
set p [ open " | $apply_cmd " w]
fconfigure $p -translation binary -encoding binary
puts -nonewline $p $current_diff_header
puts -nonewline $p [ $ui_diff get $s_lno $e_lno ]
close $p } err] } {
error_popup " Failed to $mode selected hunk.\n\n $err "
unlock_index
return
}
$ui_diff conf -state normal
$ui_diff delete $s_lno $e_lno
$ui_diff conf -state disabled
if { [ $ui_diff get 1.0 end] eq "\n" } {
set o _
} else {
set o ?
}
if { $current_diff_side eq $ui_index } {
set mi ${ o } M
} elseif { [ string index $mi 0] eq { _} } {
set mi M$o
} else {
set mi ?$o
}
unlock_index
display_file $current_diff_path $mi
if { $o eq { _} } {
clear_diff
}
}
2006-11-07 01:50:59 +00:00
######################################################################
##
## commit
2006-11-07 02:34:10 +00:00
proc load_last_commit { } {
2006-11-21 02:27:22 +00:00
global HEAD PARENT MERGE_HEAD commit_type ui_comm
2007-01-23 09:40:21 +00:00
global repo_config
2006-11-07 02:34:10 +00:00
2006-11-21 02:27:22 +00:00
if { [ llength $PARENT ] = = 0} {
error_popup { There is nothing to amend.
2007-03-27 10:31:55 +00:00
You are about to create the initial commit. There is no commit before this to amend.
2006-11-21 02:27:22 +00:00
}
return
}
repository_state curType curHEAD curMERGE_HEAD
if { $curType eq { merge} } {
error_popup { Cannot amend while merging.
2007-03-27 10:31:55 +00:00
You are currently in the middle of a merge that has not been fully completed. You cannot amend the prior commit unless you first abort the current merge activity.
2006-11-21 02:27:22 +00:00
}
2006-11-07 02:34:10 +00:00
return
}
set msg { }
2006-11-21 02:27:22 +00:00
set parents [ list]
2006-11-07 02:34:10 +00:00
if { [ catch {
2006-11-21 02:27:22 +00:00
set fd [ open " | git cat-file commit $curHEAD " r]
2007-01-23 09:40:21 +00:00
fconfigure $fd -encoding binary -translation lf
if { [ catch { set enc $repo_config ( i18n.commitencoding) } ] } {
set enc utf-8
}
2006-11-07 02:34:10 +00:00
while { [ gets $fd line] > 0} {
if { [ string match { parent *} $line ] } {
2006-11-21 02:27:22 +00:00
lappend parents [ string range $line 7 end]
2007-01-23 09:40:21 +00:00
} elseif { [ string match { encoding *} $line ] } {
set enc [ string tolower [ string range $line 9 end] ]
2006-11-07 02:34:10 +00:00
}
}
2007-01-23 09:40:21 +00:00
fconfigure $fd -encoding $enc
2006-11-07 02:34:10 +00:00
set msg [ string trim [ read $fd ] ]
close $fd
} err] } {
2006-11-12 00:10:10 +00:00
error_popup " Error loading commit data for amend:\n\n $err "
2006-11-07 02:34:10 +00:00
return
}
2006-11-21 02:27:22 +00:00
set HEAD $curHEAD
set PARENT $parents
set MERGE_HEAD [ list]
switch -- [ llength $parents ] {
0 { set commit_type amend-initial}
1 { set commit_type amend}
default { set commit_type amend-merge}
2006-11-07 02:34:10 +00:00
}
2006-11-18 07:50:58 +00:00
$ui_comm delete 0.0 end
$ui_comm insert end $msg
$ui_comm edit reset
2006-11-21 02:59:19 +00:00
$ui_comm edit modified false
2006-11-18 07:50:58 +00:00
rescan { set ui_status_value { Ready.} }
2006-11-07 02:34:10 +00:00
}
2006-11-19 01:59:49 +00:00
proc create_new_commit { } {
global commit_type ui_comm
set commit_type normal
$ui_comm delete 0.0 end
$ui_comm edit reset
2006-11-21 02:59:19 +00:00
$ui_comm edit modified false
2006-11-19 01:59:49 +00:00
rescan { set ui_status_value { Ready.} }
}
2006-11-19 02:07:05 +00:00
set GIT_COMMITTER_IDENT { }
proc committer_ident { } {
global GIT_COMMITTER_IDENT
if { $GIT_COMMITTER_IDENT eq { } } {
2007-02-13 03:48:56 +00:00
if { [ catch { set me [ git var GIT_COMMITTER_IDENT] } err] } {
2006-11-19 02:07:05 +00:00
error_popup " Unable to obtain your identity:\n\n $err "
return { }
}
if { ![ regexp { ^( .*) [ 0-9] + [ -+0-9] +$} \
$me me GIT_COMMITTER_IDENT] } {
error_popup " Invalid GIT_COMMITTER_IDENT:\n\n $me "
return { }
}
}
return $GIT_COMMITTER_IDENT
}
2006-11-07 01:50:59 +00:00
proc commit_tree { } {
2006-11-15 23:06:29 +00:00
global HEAD commit_type file_states ui_comm repo_config
2007-01-21 09:28:22 +00:00
global ui_status_value pch_error
2006-11-07 01:50:59 +00:00
2006-11-19 02:07:05 +00:00
if { [ committer_ident] eq { } } return
2007-01-26 08:33:56 +00:00
if { ![ lock_index update] } return
2006-11-07 01:50:59 +00:00
# -- Our in memory state should match the repository.
#
2006-11-21 02:27:22 +00:00
repository_state curType curHEAD curMERGE_HEAD
2006-11-18 07:50:58 +00:00
if { [ string match amend* $commit_type ]
2006-11-21 02:27:22 +00:00
&& $curType eq { normal}
2006-11-12 23:16:45 +00:00
&& $curHEAD eq $HEAD } {
2006-11-21 02:27:22 +00:00
} elseif { $commit_type ne $curType || $HEAD ne $curHEAD } {
2006-11-19 02:13:16 +00:00
info_popup { Last scanned state does not match repository state.
2006-11-07 01:50:59 +00:00
2007-03-27 10:31:55 +00:00
Another Git program has modified this repository since the last scan. A rescan must be performed before another commit can be created.
2006-11-15 23:06:29 +00:00
2006-11-19 02:13:16 +00:00
The rescan will be automatically started now.
2006-11-07 01:50:59 +00:00
}
unlock_index
2006-11-14 06:29:32 +00:00
rescan { set ui_status_value { Ready.} }
2006-11-07 01:50:59 +00:00
return
}
# -- At least one file should differ in the index.
#
set files_ready 0
foreach path [ array names file_states] {
2006-11-15 23:06:29 +00:00
switch -glob -- [ lindex $file_states ( $path ) 0] {
2006-11-11 23:38:00 +00:00
_? { continue }
A? -
D? -
2007-01-21 18:34:00 +00:00
M? { set files_ready 1}
2006-11-11 23:38:00 +00:00
U? {
2006-11-07 01:50:59 +00:00
error_popup " Unmerged files cannot be committed.
2007-03-27 10:31:55 +00:00
File [ short_path $path ] has merge conflicts. You must resolve them and add the file before committing.
2006-11-07 01:50:59 +00:00
"
unlock_index
return
}
default {
error_popup " Unknown file state [lindex $s 0] detected.
2006-11-12 02:52:06 +00:00
File [ short_path $path ] cannot be committed by this program.
2006-11-07 01:50:59 +00:00
"
}
}
}
2007-03-12 17:03:47 +00:00
if { !$files_ready && ![ string match *merge $curType ] } {
2007-01-21 19:16:40 +00:00
info_popup { No changes to commit.
2006-11-07 01:50:59 +00:00
2007-01-21 18:34:00 +00:00
You must add at least 1 file before you can commit.
2006-11-07 01:50:59 +00:00
}
unlock_index
return
}
# -- A message is required.
#
set msg [ string trim [ $ui_comm get 1.0 end] ]
2007-01-25 17:54:59 +00:00
regsub -all -line { [ \t \r ] +$} $msg { } msg
2006-11-12 23:16:45 +00:00
if { $msg eq { } } {
2006-11-07 01:50:59 +00:00
error_popup { Please supply a commit message.
A good commit message has the following format:
- First line: Describe in one sentance what you did.
- Second line: Blank
- Remaining lines: Describe why this change is good.
}
unlock_index
return
}
2007-01-21 09:28:22 +00:00
# -- Run the pre-commit hook.
#
2007-01-21 02:55:05 +00:00
set pchook [ gitdir hooks pre-commit]
2006-11-15 23:06:29 +00:00
# On Cygwin [file executable] might lie so we need to ask
# the shell if the hook is executable. Yes that's annoying.
2006-11-21 16:57:41 +00:00
#
2007-01-29 01:58:47 +00:00
if { [ is_Cygwin] && [ file isfile $pchook ] } {
2006-11-12 22:58:08 +00:00
set pchook [ list sh -c [ concat \
" if test -x \" $pchook \"; " \
" then exec \" $pchook \" 2>&1; " \
"fi" ] ]
2006-11-07 01:50:59 +00:00
} elseif { [ file executable $pchook ] } {
2006-11-12 22:58:08 +00:00
set pchook [ list $pchook | & cat]
2006-11-07 01:50:59 +00:00
} else {
2006-11-15 23:06:29 +00:00
commit_writetree $curHEAD $msg
return
2006-11-12 22:58:08 +00:00
}
2006-11-15 23:06:29 +00:00
set ui_status_value { Calling pre-commit hook...}
set pch_error { }
set fd_ph [ open " | $pchook " r]
fconfigure $fd_ph -blocking 0 -translation binary
fileevent $fd_ph readable \
[ list commit_prehook_wait $fd_ph $curHEAD $msg ]
2006-11-12 22:58:08 +00:00
}
2006-11-15 23:06:29 +00:00
proc commit_prehook_wait { fd_ph curHEAD msg} {
2006-11-12 23:03:19 +00:00
global pch_error ui_status_value
2006-11-12 22:58:08 +00:00
append pch_error [ read $fd_ph ]
fconfigure $fd_ph -blocking 1
if { [ eof $fd_ph ] } {
if { [ catch { close $fd_ph } ] } {
set ui_status_value { Commit declined by pre-commit hook.}
hook_failed_popup pre-commit $pch_error
unlock_index
2006-11-12 23:03:19 +00:00
} else {
2006-11-15 23:06:29 +00:00
commit_writetree $curHEAD $msg
2006-11-12 22:58:08 +00:00
}
2006-11-12 23:03:19 +00:00
set pch_error { }
2006-11-15 23:06:29 +00:00
return
2006-11-07 01:50:59 +00:00
}
2006-11-15 23:06:29 +00:00
fconfigure $fd_ph -blocking 0
2006-11-12 22:58:08 +00:00
}
2006-11-15 23:06:29 +00:00
proc commit_writetree { curHEAD msg} {
2006-11-12 22:58:08 +00:00
global ui_status_value
2006-11-07 01:50:59 +00:00
set ui_status_value { Committing changes...}
set fd_wt [ open "| git write-tree" r]
2006-11-15 23:06:29 +00:00
fileevent $fd_wt readable \
[ list commit_committree $fd_wt $curHEAD $msg ]
2006-11-07 01:50:59 +00:00
}
2006-11-15 23:06:29 +00:00
proc commit_committree { fd_wt curHEAD msg} {
2006-11-21 02:27:22 +00:00
global HEAD PARENT MERGE_HEAD commit_type
2007-02-08 23:03:41 +00:00
global all_heads current_branch
2006-11-19 01:59:49 +00:00
global ui_status_value ui_comm selected_commit_type
2006-11-19 08:38:48 +00:00
global file_states selected_paths rescan_active
2007-01-23 09:40:21 +00:00
global repo_config
2006-11-07 01:50:59 +00:00
gets $fd_wt tree_id
2006-11-12 23:16:45 +00:00
if { $tree_id eq { } || [ catch { close $fd_wt } err] } {
2006-11-12 00:10:10 +00:00
error_popup " write-tree failed:\n\n $err "
2006-11-07 01:50:59 +00:00
set ui_status_value { Commit failed.}
unlock_index
return
}
2007-02-26 16:47:14 +00:00
# -- Verify this wasn't an empty change.
#
if { $commit_type eq { normal} } {
set old_tree [ git rev-parse " $PARENT ^{tree} " ]
if { $tree_id eq $old_tree } {
info_popup { No changes to commit.
2007-03-27 10:31:55 +00:00
No files were modified by this commit and it was not a merge commit.
2007-02-26 16:47:14 +00:00
A rescan will be automatically started now.
}
unlock_index
rescan { set ui_status_value { No changes to commit.} }
return
}
}
2007-01-23 09:40:21 +00:00
# -- Build the message.
#
set msg_p [ gitdir COMMIT_EDITMSG]
set msg_wt [ open $msg_p w]
if { [ catch { set enc $repo_config ( i18n.commitencoding) } ] } {
set enc utf-8
}
fconfigure $msg_wt -encoding $enc -translation binary
puts -nonewline $msg_wt $msg
close $msg_wt
2006-11-07 01:50:59 +00:00
# -- Create the commit.
#
set cmd [ list git commit-tree $tree_id ]
2007-03-01 19:37:34 +00:00
foreach p [ concat $PARENT $MERGE_HEAD ] {
lappend cmd -p $p
2006-11-07 01:50:59 +00:00
}
2007-01-23 09:40:21 +00:00
lappend cmd <$msg_p
2006-11-07 01:50:59 +00:00
if { [ catch { set cmt_id [ eval exec $cmd ] } err] } {
2006-11-12 00:10:10 +00:00
error_popup " commit-tree failed:\n\n $err "
2006-11-07 01:50:59 +00:00
set ui_status_value { Commit failed.}
unlock_index
return
}
# -- Update the HEAD ref.
#
set reflogm commit
2006-11-12 23:16:45 +00:00
if { $commit_type ne { normal} } {
2006-11-07 01:50:59 +00:00
append reflogm " ( $commit_type ) "
}
set i [ string first "\n" $msg ]
if { $i >= 0} {
2006-11-13 21:06:38 +00:00
append reflogm { : } [ string range $msg 0 [ expr { $i - 1} ] ]
2006-11-07 01:50:59 +00:00
} else {
append reflogm { : } $msg
}
2006-11-07 02:34:10 +00:00
set cmd [ list git update-ref -m $reflogm HEAD $cmt_id $curHEAD ]
2006-11-07 01:50:59 +00:00
if { [ catch { eval exec $cmd } err] } {
2006-11-12 00:10:10 +00:00
error_popup " update-ref failed:\n\n $err "
2006-11-07 01:50:59 +00:00
set ui_status_value { Commit failed.}
unlock_index
return
}
# -- Cleanup after ourselves.
#
2007-01-23 09:40:21 +00:00
catch { file delete $msg_p }
2007-01-21 02:55:05 +00:00
catch { file delete [ gitdir MERGE_HEAD] }
catch { file delete [ gitdir MERGE_MSG] }
catch { file delete [ gitdir SQUASH_MSG] }
catch { file delete [ gitdir GITGUI_MSG] }
2006-11-07 01:50:59 +00:00
# -- Let rerere do its thing.
#
2007-01-21 02:55:05 +00:00
if { [ file isdirectory [ gitdir rr-cache] ] } {
2007-02-13 03:48:56 +00:00
catch { git rerere}
2006-11-07 01:50:59 +00:00
}
2006-11-12 23:08:10 +00:00
# -- Run the post-commit hook.
#
2007-01-21 02:55:05 +00:00
set pchook [ gitdir hooks post-commit]
2007-01-29 01:58:47 +00:00
if { [ is_Cygwin] && [ file isfile $pchook ] } {
2006-11-12 23:08:10 +00:00
set pchook [ list sh -c [ concat \
" if test -x \" $pchook \"; " \
" then exec \" $pchook \"; " \
"fi" ] ]
} elseif { ![ file executable $pchook ] } {
set pchook { }
}
2006-11-12 23:16:45 +00:00
if { $pchook ne { } } {
2006-11-12 23:08:10 +00:00
catch { exec $pchook & }
}
2006-11-07 02:34:10 +00:00
$ui_comm delete 0.0 end
2006-11-11 21:16:25 +00:00
$ui_comm edit reset
2006-11-21 02:59:19 +00:00
$ui_comm edit modified false
2006-11-07 01:50:59 +00:00
2007-02-09 00:10:52 +00:00
if { [ is_enabled singlecommit] } do_quit
2006-11-07 01:50:59 +00:00
2007-02-21 06:33:59 +00:00
# -- Make sure our current branch exists.
#
if { $commit_type eq { initial} } {
lappend all_heads $current_branch
set all_heads [ lsort -unique $all_heads ]
populate_branch_menu
}
2006-11-19 08:38:48 +00:00
# -- Update in memory status
2006-11-11 23:38:00 +00:00
#
2006-11-19 01:59:49 +00:00
set selected_commit_type new
2006-11-21 02:27:22 +00:00
set commit_type normal
2006-11-07 03:03:05 +00:00
set HEAD $cmt_id
set PARENT $cmt_id
2006-11-21 02:27:22 +00:00
set MERGE_HEAD [ list]
2006-11-11 23:38:00 +00:00
foreach path [ array names file_states] {
set s $file_states ( $path )
set m [ lindex $s 0]
switch -glob -- $m {
2006-11-19 08:38:48 +00:00
_O -
_M -
_D { continue }
__ -
A_ -
M_ -
2007-01-21 03:57:19 +00:00
D_ {
2006-11-11 23:38:00 +00:00
unset file_states( $path )
2006-11-13 21:06:38 +00:00
catch { unset selected_paths( $path ) }
2006-11-19 08:38:48 +00:00
}
DO {
set file_states( $path ) [ list _O [ lindex $s 1] { } { } ]
}
AM -
AD -
MM -
2007-01-21 03:58:52 +00:00
MD {
2006-11-19 08:38:48 +00:00
set file_states( $path ) [ list \
_[ string index $m 1] \
[ lindex $s 1] \
[ lindex $s 3] \
{ } ]
}
2006-11-11 23:38:00 +00:00
}
}
display_all_files
2006-11-07 01:50:59 +00:00
unlock_index
2006-11-11 23:38:00 +00:00
reshow_diff
set ui_status_value \
" Changes committed as [string range $cmt_id 0 7]. "
2006-11-07 01:50:59 +00:00
}
2006-11-07 04:13:23 +00:00
######################################################################
##
2007-01-26 05:47:44 +00:00
## fetch push
2006-11-07 04:13:23 +00:00
proc fetch_from { remote} {
2007-01-26 05:47:44 +00:00
set w [ new_console \
" fetch $remote " \
2006-11-07 04:13:23 +00:00
" Fetching new changes from $remote " ]
2006-11-07 04:47:05 +00:00
set cmd [ list git fetch]
2006-11-07 04:13:23 +00:00
lappend cmd $remote
2007-01-26 06:29:00 +00:00
console_exec $w $cmd console_done
2006-11-07 04:13:23 +00:00
}
proc push_to { remote} {
2007-01-26 05:47:44 +00:00
set w [ new_console \
" push $remote " \
2006-11-07 04:13:23 +00:00
" Pushing changes to $remote " ]
2006-11-07 04:47:05 +00:00
set cmd [ list git push]
2007-01-26 05:49:17 +00:00
lappend cmd -v
2006-11-07 04:13:23 +00:00
lappend cmd $remote
2007-01-26 06:29:00 +00:00
console_exec $w $cmd console_done
2006-11-07 04:13:23 +00:00
}
2006-11-06 19:20:27 +00:00
######################################################################
##
## ui helpers
2007-01-21 03:45:19 +00:00
proc mapicon { w state path} {
2006-11-06 19:20:27 +00:00
global all_icons
2007-01-21 03:45:19 +00:00
if { [ catch { set r $all_icons ( $state $w ) } ] } {
puts " error: no icon for $w state={ $state } $path "
2006-11-06 19:20:27 +00:00
return file_plain
}
return $r
}
proc mapdesc { state path} {
global all_descs
if { [ catch { set r $all_descs ( $state ) } ] } {
puts " error: no desc for state={ $state } $path "
return $state
}
return $r
}
2006-11-11 22:59:34 +00:00
proc escape_path { path} {
2007-02-08 22:13:51 +00:00
regsub -all { \\ } $path "\\\\" path
2006-11-11 22:59:34 +00:00
regsub -all "\n" $path "\\n" path
return $path
}
2006-11-12 02:52:06 +00:00
proc short_path { path} {
return [ escape_path [ lindex [ file split $path ] end] ]
}
2006-11-08 00:30:54 +00:00
set next_icon_id 0
2006-11-19 06:20:42 +00:00
set null_sha1 [ string repeat 0 40]
2006-11-08 00:30:54 +00:00
2006-11-19 05:29:55 +00:00
proc merge_state { path new_state { head_info { } } { index_info { } } } {
2006-11-19 06:20:42 +00:00
global file_states next_icon_id null_sha1
2006-11-06 19:20:27 +00:00
2006-11-08 00:58:37 +00:00
set s0 [ string index $new_state 0]
set s1 [ string index $new_state 1]
if { [ catch { set info $file_states ( $path ) } ] } {
set state __
set icon n[ incr next_icon_id]
2006-11-06 19:20:27 +00:00
} else {
2006-11-08 00:58:37 +00:00
set state [ lindex $info 0]
set icon [ lindex $info 1]
2006-11-19 05:29:55 +00:00
if { $head_info eq { } } { set head_info [ lindex $info 2] }
if { $index_info eq { } } { set index_info [ lindex $info 3] }
2006-11-06 19:20:27 +00:00
}
2006-11-19 05:29:55 +00:00
if { $s0 eq { ?} } { set s0 [ string index $state 0] } \
elseif { $s0 eq { _} } { set s0 _}
if { $s1 eq { ?} } { set s1 [ string index $state 1] } \
elseif { $s1 eq { _} } { set s1 _}
2006-11-06 19:20:27 +00:00
2006-11-19 06:20:42 +00:00
if { $s0 eq { A} && $s1 eq { _} && $head_info eq { } } {
set head_info [ list 0 $null_sha1 ]
} elseif { $s0 ne { _} && [ string index $state 0] eq { _}
2006-11-19 05:29:55 +00:00
&& $head_info eq { } } {
set head_info $index_info
2006-11-06 19:20:27 +00:00
}
2006-11-19 05:29:55 +00:00
set file_states( $path ) [ list $s0 $s1 $icon \
$head_info $index_info \
]
2006-11-08 00:58:37 +00:00
return $state
2006-11-06 19:20:27 +00:00
}
2007-01-21 03:45:19 +00:00
proc display_file_helper { w path icon_name old_m new_m} {
global file_lists
if { $new_m eq { _} } {
2007-01-26 03:38:59 +00:00
set lno [ lsearch -sorted -exact $file_lists ( $w ) $path ]
2007-01-21 03:45:19 +00:00
if { $lno >= 0} {
set file_lists( $w ) [ lreplace $file_lists ( $w ) $lno $lno ]
incr lno
$w conf -state normal
$w delete $lno .0 [ expr { $lno + 1} ] .0
$w conf -state disabled
}
} elseif { $old_m eq { _} && $new_m ne { _} } {
lappend file_lists( $w ) $path
set file_lists( $w ) [ lsort -unique $file_lists ( $w ) ]
2007-01-26 03:38:59 +00:00
set lno [ lsearch -sorted -exact $file_lists ( $w ) $path ]
2007-01-21 03:45:19 +00:00
incr lno
$w conf -state normal
$w image create $lno .0 \
-align center -padx 5 -pady 1 \
-name $icon_name \
-image [ mapicon $w $new_m $path ]
$w insert $lno .1 " [escape_path $path ]\n "
$w conf -state disabled
} elseif { $old_m ne $new_m } {
$w conf -state normal
$w image conf $icon_name -image [ mapicon $w $new_m $path ]
$w conf -state disabled
}
}
2006-11-06 19:20:27 +00:00
proc display_file { path state} {
2007-01-21 03:45:19 +00:00
global file_states selected_paths
global ui_index ui_workdir
2006-11-06 19:20:27 +00:00
set old_m [ merge_state $path $state ]
set s $file_states ( $path )
2006-11-08 00:30:54 +00:00
set new_m [ lindex $s 0]
2007-01-21 03:45:19 +00:00
set icon_name [ lindex $s 1]
2007-01-21 18:18:11 +00:00
set o [ string index $old_m 0]
set n [ string index $new_m 0]
if { $o eq { U} } {
set o _
2007-01-21 17:30:51 +00:00
}
2007-01-21 18:18:11 +00:00
if { $n eq { U} } {
set n _
}
display_file_helper $ui_index $path $icon_name $o $n
2007-01-21 17:30:51 +00:00
2007-01-21 18:18:11 +00:00
if { [ string index $old_m 0] eq { U} } {
set o U
} else {
2007-01-21 18:25:06 +00:00
set o [ string index $old_m 1]
2007-01-21 18:18:11 +00:00
}
2007-01-21 17:30:51 +00:00
if { [ string index $new_m 0] eq { U} } {
2007-01-21 18:18:11 +00:00
set n U
2007-01-21 17:30:51 +00:00
} else {
2007-01-21 18:18:11 +00:00
set n [ string index $new_m 1]
2007-01-21 17:30:51 +00:00
}
2007-01-21 18:18:11 +00:00
display_file_helper $ui_workdir $path $icon_name $o $n
2006-11-06 19:20:27 +00:00
2006-11-24 02:40:45 +00:00
if { $new_m eq { __} } {
unset file_states( $path )
catch { unset selected_paths( $path ) }
}
2007-01-21 03:45:19 +00:00
}
2006-11-24 02:40:45 +00:00
2007-01-21 03:45:19 +00:00
proc display_all_files_helper { w path icon_name m} {
global file_lists
2006-11-08 00:30:54 +00:00
2007-01-21 03:45:19 +00:00
lappend file_lists( $w ) $path
set lno [ expr { [ lindex [ split [ $w index end] .] 0] - 1} ]
$w image create end \
-align center -padx 5 -pady 1 \
-name $icon_name \
-image [ mapicon $w $m $path ]
$w insert end " [escape_path $path ]\n "
2006-11-08 00:30:54 +00:00
}
2006-11-06 19:20:27 +00:00
2006-11-08 00:30:54 +00:00
proc display_all_files { } {
2007-01-21 03:06:51 +00:00
global ui_index ui_workdir
2006-11-13 21:06:38 +00:00
global file_states file_lists
2007-01-21 04:46:53 +00:00
global last_clicked
2006-11-08 00:30:54 +00:00
$ui_index conf -state normal
2007-01-21 03:06:51 +00:00
$ui_workdir conf -state normal
2006-11-08 00:30:54 +00:00
2006-11-11 23:38:00 +00:00
$ui_index delete 0.0 end
2007-01-21 03:06:51 +00:00
$ui_workdir delete 0.0 end
2006-11-13 21:06:38 +00:00
set last_clicked { }
2006-11-11 23:38:00 +00:00
2006-11-12 01:00:35 +00:00
set file_lists( $ui_index ) [ list]
2007-01-21 03:06:51 +00:00
set file_lists( $ui_workdir ) [ list]
2006-11-12 01:00:35 +00:00
2006-11-08 00:30:54 +00:00
foreach path [ lsort [ array names file_states] ] {
set s $file_states ( $path )
set m [ lindex $s 0]
2007-01-21 03:45:19 +00:00
set icon_name [ lindex $s 1]
2007-01-21 17:30:51 +00:00
set s [ string index $m 0]
if { $s ne { U} && $s ne { _} } {
2007-01-21 03:45:19 +00:00
display_all_files_helper $ui_index $path \
2007-01-21 17:30:51 +00:00
$icon_name $s
2006-11-13 21:06:38 +00:00
}
2007-01-21 17:30:51 +00:00
if { [ string index $m 0] eq { U} } {
set s U
} else {
set s [ string index $m 1]
}
if { $s ne { _} } {
2007-01-21 03:45:19 +00:00
display_all_files_helper $ui_workdir $path \
2007-01-21 17:30:51 +00:00
$icon_name $s
2006-11-13 21:06:38 +00:00
}
2006-11-06 19:20:27 +00:00
}
2006-11-08 00:30:54 +00:00
$ui_index conf -state disabled
2007-01-21 03:06:51 +00:00
$ui_workdir conf -state disabled
2006-11-06 19:20:27 +00:00
}
2006-11-19 05:29:55 +00:00
proc update_indexinfo { msg pathList after} {
global update_index_cp ui_status_value
if { ![ lock_index update] } return
set update_index_cp 0
set pathList [ lsort $pathList ]
set totalCnt [ llength $pathList ]
set batch [ expr { int( $totalCnt * .01) + 1} ]
if { $batch > 25} { set batch 25}
set ui_status_value [ format \
" $msg ... %i/%i files (%.2f%%) " \
$update_index_cp \
$totalCnt \
0.0]
set fd [ open "| git update-index -z --index-info" w]
fconfigure $fd \
-blocking 0 \
-buffering full \
-buffersize 512 \
2007-01-23 09:07:18 +00:00
-encoding binary \
2006-11-19 05:29:55 +00:00
-translation binary
fileevent $fd writable [ list \
write_update_indexinfo \
$fd \
$pathList \
$totalCnt \
$batch \
$msg \
$after \
]
}
proc write_update_indexinfo { fd pathList totalCnt batch msg after} {
global update_index_cp ui_status_value
2007-01-21 16:37:58 +00:00
global file_states current_diff_path
2006-11-19 05:29:55 +00:00
if { $update_index_cp >= $totalCnt } {
close $fd
unlock_index
uplevel #0 $after
return
}
for { set i $batch } \
{ $update_index_cp < $totalCnt && $i > 0} \
{ incr i -1} {
set path [ lindex $pathList $update_index_cp ]
incr update_index_cp
set s $file_states ( $path )
switch -glob -- [ lindex $s 0] {
A? { set new _O}
M? { set new _M}
2007-01-20 23:50:14 +00:00
D_ { set new _D}
2006-11-19 05:29:55 +00:00
D? { set new _?}
?? { continue }
}
set info [ lindex $s 2]
if { $info eq { } } continue
2007-01-23 09:07:18 +00:00
puts -nonewline $fd " $info \t[encoding convertto $path ]\0 "
2006-11-19 05:29:55 +00:00
display_file $path $new
}
set ui_status_value [ format \
" $msg ... %i/%i files (%.2f%%) " \
$update_index_cp \
$totalCnt \
[ expr { 100.0 * $update_index_cp / $totalCnt } ] ]
}
2006-11-14 06:42:32 +00:00
proc update_index { msg pathList after} {
2006-11-18 08:03:16 +00:00
global update_index_cp ui_status_value
2006-11-06 21:07:32 +00:00
2006-11-12 11:35:14 +00:00
if { ![ lock_index update] } return
2006-11-06 21:07:32 +00:00
2006-11-12 11:35:14 +00:00
set update_index_cp 0
2006-11-13 00:29:04 +00:00
set pathList [ lsort $pathList ]
2006-11-12 11:35:14 +00:00
set totalCnt [ llength $pathList ]
set batch [ expr { int( $totalCnt * .01) + 1} ]
if { $batch > 25} { set batch 25}
set ui_status_value [ format \
2006-11-14 06:42:32 +00:00
" $msg ... %i/%i files (%.2f%%) " \
2006-11-12 11:35:14 +00:00
$update_index_cp \
$totalCnt \
0.0]
set fd [ open "| git update-index --add --remove -z --stdin" w]
2006-11-13 00:33:33 +00:00
fconfigure $fd \
-blocking 0 \
-buffering full \
-buffersize 512 \
2007-01-23 09:07:18 +00:00
-encoding binary \
2006-11-13 00:33:33 +00:00
-translation binary
2006-11-12 11:35:14 +00:00
fileevent $fd writable [ list \
write_update_index \
$fd \
$pathList \
$totalCnt \
$batch \
2006-11-14 06:42:32 +00:00
$msg \
$after \
2006-11-12 11:35:14 +00:00
]
}
2006-11-14 06:42:32 +00:00
proc write_update_index { fd pathList totalCnt batch msg after} {
2006-11-18 08:03:16 +00:00
global update_index_cp ui_status_value
2007-01-21 16:37:58 +00:00
global file_states current_diff_path
2006-11-06 21:07:32 +00:00
2006-11-12 11:35:14 +00:00
if { $update_index_cp >= $totalCnt } {
close $fd
unlock_index
2006-11-14 06:42:32 +00:00
uplevel #0 $after
2006-11-12 11:35:14 +00:00
return
2006-11-06 21:07:32 +00:00
}
2006-11-12 11:35:14 +00:00
for { set i $batch } \
{ $update_index_cp < $totalCnt && $i > 0} \
{ incr i -1} {
set path [ lindex $pathList $update_index_cp ]
incr update_index_cp
2006-11-15 23:06:29 +00:00
switch -glob -- [ lindex $file_states ( $path ) 0] {
2007-01-21 04:33:34 +00:00
AD { set new __}
?D { set new D_}
2006-11-15 23:06:29 +00:00
_O -
2007-01-21 04:33:34 +00:00
AM { set new A_}
2007-01-21 17:30:51 +00:00
U? {
if { [ file exists $path ] } {
set new M_
} else {
set new D_
}
}
2007-01-21 04:33:34 +00:00
?M { set new M_}
2006-11-15 23:06:29 +00:00
?? { continue }
2006-11-12 11:35:14 +00:00
}
2007-01-23 09:07:18 +00:00
puts -nonewline $fd " [encoding convertto $path ]\0 "
2006-11-12 11:35:14 +00:00
display_file $path $new
2006-11-06 19:20:27 +00:00
}
2006-11-12 11:35:14 +00:00
set ui_status_value [ format \
2006-11-14 06:42:32 +00:00
" $msg ... %i/%i files (%.2f%%) " \
2006-11-12 11:35:14 +00:00
$update_index_cp \
$totalCnt \
[ expr { 100.0 * $update_index_cp / $totalCnt } ] ]
2006-11-06 19:20:27 +00:00
}
2006-11-24 02:40:45 +00:00
proc checkout_index { msg pathList after} {
global update_index_cp ui_status_value
if { ![ lock_index update] } return
set update_index_cp 0
set pathList [ lsort $pathList ]
set totalCnt [ llength $pathList ]
set batch [ expr { int( $totalCnt * .01) + 1} ]
if { $batch > 25} { set batch 25}
set ui_status_value [ format \
" $msg ... %i/%i files (%.2f%%) " \
$update_index_cp \
$totalCnt \
0.0]
set cmd [ list git checkout-index]
lappend cmd --index
lappend cmd --quiet
lappend cmd --force
lappend cmd -z
lappend cmd --stdin
set fd [ open " | $cmd " w]
fconfigure $fd \
-blocking 0 \
-buffering full \
-buffersize 512 \
2007-01-23 09:07:18 +00:00
-encoding binary \
2006-11-24 02:40:45 +00:00
-translation binary
fileevent $fd writable [ list \
write_checkout_index \
$fd \
$pathList \
$totalCnt \
$batch \
$msg \
$after \
]
}
proc write_checkout_index { fd pathList totalCnt batch msg after} {
global update_index_cp ui_status_value
2007-01-21 16:37:58 +00:00
global file_states current_diff_path
2006-11-24 02:40:45 +00:00
if { $update_index_cp >= $totalCnt } {
close $fd
unlock_index
uplevel #0 $after
return
}
for { set i $batch } \
{ $update_index_cp < $totalCnt && $i > 0} \
{ incr i -1} {
set path [ lindex $pathList $update_index_cp ]
incr update_index_cp
switch -glob -- [ lindex $file_states ( $path ) 0] {
2007-01-21 04:20:17 +00:00
U? { continue }
?M -
?D {
2007-01-23 09:07:18 +00:00
puts -nonewline $fd " [encoding convertto $path ]\0 "
2007-01-21 04:20:17 +00:00
display_file $path ?_
}
2006-11-24 02:40:45 +00:00
}
}
set ui_status_value [ format \
" $msg ... %i/%i files (%.2f%%) " \
$update_index_cp \
$totalCnt \
[ expr { 100.0 * $update_index_cp / $totalCnt } ] ]
}
2006-11-24 22:30:12 +00:00
######################################################################
##
## branch management
2007-01-21 22:22:40 +00:00
proc is_tracking_branch { name} {
global tracking_branches
if { ![ catch { set info $tracking_branches ( $name ) } ] } {
return 1
}
foreach t [ array names tracking_branches] {
if { [ string match { */\* } $t ] && [ string match $t $name ] } {
return 1
}
}
return 0
}
2006-11-25 08:35:33 +00:00
proc load_all_heads { } {
2007-01-21 22:22:40 +00:00
global all_heads
2006-11-24 22:30:12 +00:00
2006-11-25 08:35:33 +00:00
set all_heads [ list]
2007-01-21 22:22:40 +00:00
set fd [ open "| git for-each-ref --format=%(refname) refs/heads" r]
2006-11-24 22:30:12 +00:00
while { [ gets $fd line] > 0} {
2007-01-21 22:22:40 +00:00
if { [ is_tracking_branch $line ] } continue
2006-11-25 08:33:03 +00:00
if { ![ regsub ^refs/heads/ $line { } name] } continue
2006-11-25 08:35:33 +00:00
lappend all_heads $name
2006-11-24 22:30:12 +00:00
}
close $fd
2006-11-25 08:35:33 +00:00
set all_heads [ lsort $all_heads ]
2006-11-24 22:30:12 +00:00
}
2007-01-21 06:31:14 +00:00
proc populate_branch_menu { } {
2006-11-25 08:35:33 +00:00
global all_heads disable_on_lock
2006-11-24 22:30:12 +00:00
2007-01-21 06:31:14 +00:00
set m .mbar.branch
set last [ $m index last]
for { set i 0} { $i <= $last } { incr i} {
if { [ $m type $i ] eq { separator} } {
$m delete $i last
set new_dol [ list]
foreach a $disable_on_lock {
if { [ lindex $a 0] ne $m || [ lindex $a 2] < $i } {
lappend new_dol $a
}
}
set disable_on_lock $new_dol
break
}
}
2007-01-25 22:16:22 +00:00
if { $all_heads ne { } } {
$m add separator
}
2006-11-25 08:35:33 +00:00
foreach b $all_heads {
2006-11-24 22:30:12 +00:00
$m add radiobutton \
-label $b \
2006-11-25 07:47:18 +00:00
-command [ list switch_branch $b ] \
2006-11-24 22:30:12 +00:00
-variable current_branch \
-value $b \
-font font_ui
lappend disable_on_lock \
[ list $m entryconf [ $m index last] -state]
}
}
2007-01-21 20:38:09 +00:00
proc all_tracking_branches { } {
global tracking_branches
2007-01-21 22:22:40 +00:00
set all_trackings { }
set cmd { }
foreach name [ array names tracking_branches] {
if { [ regsub { /\* $} $name { } name] } {
lappend cmd $name
} else {
regsub ^refs/( heads| remotes) / $name { } name
lappend all_trackings $name
}
}
if { $cmd ne { } } {
set fd [ open " | git for-each-ref --format=%(refname) $cmd " r]
while { [ gets $fd name] > 0} {
regsub ^refs/( heads| remotes) / $name { } name
lappend all_trackings $name
}
close $fd
2007-01-21 20:38:09 +00:00
}
2007-01-21 22:22:40 +00:00
2007-01-21 20:38:09 +00:00
return [ lsort -unique $all_trackings ]
}
2007-02-15 06:28:34 +00:00
proc load_all_tags { } {
set all_tags [ list]
set fd [ open "| git for-each-ref --format=%(refname) refs/tags" r]
while { [ gets $fd line] > 0} {
if { ![ regsub ^refs/tags/ $line { } name] } continue
lappend all_tags $name
}
close $fd
return [ lsort $all_tags ]
}
2007-01-21 06:31:14 +00:00
proc do_create_branch_action { w} {
2007-01-21 21:28:59 +00:00
global all_heads null_sha1 repo_config
2007-01-21 07:27:26 +00:00
global create_branch_checkout create_branch_revtype
global create_branch_head create_branch_trackinghead
2007-01-25 21:50:15 +00:00
global create_branch_name create_branch_revexp
2007-02-15 06:28:34 +00:00
global create_branch_tag
2007-01-21 06:31:14 +00:00
2007-01-25 21:50:15 +00:00
set newbranch $create_branch_name
2007-01-21 21:28:59 +00:00
if { $newbranch eq { }
|| $newbranch eq $repo_config ( gui.newbranchtemplate) } {
2007-01-21 20:40:55 +00:00
tk_messageBox \
-icon error \
-type ok \
-title [ wm title $w ] \
-parent $w \
-message "Please supply a branch name."
focus $w .desc.name_t
return
}
2007-02-13 03:48:56 +00:00
if { ![ catch { git show-ref --verify -- " refs/heads/ $newbranch " } ] } {
2007-01-21 06:31:14 +00:00
tk_messageBox \
-icon error \
-type ok \
-title [ wm title $w ] \
-parent $w \
-message " Branch ' $newbranch ' already exists. "
2007-01-21 18:56:38 +00:00
focus $w .desc.name_t
2007-01-21 06:31:14 +00:00
return
}
2007-02-13 03:48:56 +00:00
if { [ catch { git check-ref-format " heads/ $newbranch " } ] } {
2007-01-21 06:31:14 +00:00
tk_messageBox \
-icon error \
-type ok \
-title [ wm title $w ] \
-parent $w \
-message " We do not like ' $newbranch ' as a branch name. "
2007-01-21 18:56:38 +00:00
focus $w .desc.name_t
2007-01-21 06:31:14 +00:00
return
}
set rev { }
switch -- $create_branch_revtype {
head { set rev $create_branch_head }
2007-01-21 07:27:26 +00:00
tracking { set rev $create_branch_trackinghead }
2007-02-15 06:28:34 +00:00
tag { set rev $create_branch_tag }
2007-01-25 21:50:15 +00:00
expression { set rev $create_branch_revexp }
2007-01-21 06:31:14 +00:00
}
2007-02-13 03:48:56 +00:00
if { [ catch { set cmt [ git rev-parse --verify " ${ rev } ^0 " ] } ] } {
2007-01-21 06:31:14 +00:00
tk_messageBox \
-icon error \
-type ok \
-title [ wm title $w ] \
-parent $w \
-message " Invalid starting revision: $rev "
return
}
set cmd [ list git update-ref]
lappend cmd -m
lappend cmd " branch: Created from $rev "
lappend cmd " refs/heads/ $newbranch "
lappend cmd $cmt
lappend cmd $null_sha1
if { [ catch { eval exec $cmd } err] } {
tk_messageBox \
-icon error \
-type ok \
-title [ wm title $w ] \
-parent $w \
-message " Failed to create ' $newbranch '.\n\n $err "
return
}
lappend all_heads $newbranch
set all_heads [ lsort $all_heads ]
populate_branch_menu
destroy $w
2007-01-21 09:57:11 +00:00
if { $create_branch_checkout } {
switch_branch $newbranch
}
2007-01-21 06:31:14 +00:00
}
2007-01-21 22:02:25 +00:00
proc radio_selector { varname value args} {
upvar #0 $varname var
set var $value
}
trace add variable create_branch_head write \
[ list radio_selector create_branch_revtype head]
trace add variable create_branch_trackinghead write \
[ list radio_selector create_branch_revtype tracking]
2007-02-15 06:28:34 +00:00
trace add variable create_branch_tag write \
[ list radio_selector create_branch_revtype tag]
2007-01-21 22:02:25 +00:00
trace add variable delete_branch_head write \
[ list radio_selector delete_branch_checktype head]
trace add variable delete_branch_trackinghead write \
[ list radio_selector delete_branch_checktype tracking]
2006-11-25 09:04:24 +00:00
proc do_create_branch { } {
2007-01-21 21:28:59 +00:00
global all_heads current_branch repo_config
2007-01-21 07:27:26 +00:00
global create_branch_checkout create_branch_revtype
global create_branch_head create_branch_trackinghead
2007-01-25 21:50:15 +00:00
global create_branch_name create_branch_revexp
2007-02-15 06:28:34 +00:00
global create_branch_tag
2007-01-21 06:31:14 +00:00
set w .branch_editor
toplevel $w
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
label $w .header -text { Create New Branch} \
-font font_uibold
pack $w .header -side top -fill x
frame $w .buttons
button $w .buttons.create -text Create \
-font font_ui \
-default active \
-command [ list do_create_branch_action $w ]
pack $w .buttons.create -side right
button $w .buttons.cancel -text { Cancel} \
-font font_ui \
-command [ list destroy $w ]
pack $w .buttons.cancel -side right -padx 5
pack $w .buttons -side bottom -fill x -pady 10 -padx 10
2007-01-21 18:37:53 +00:00
labelframe $w .desc \
2007-01-21 06:31:14 +00:00
-text { Branch Description} \
-font font_ui
2007-01-21 18:56:38 +00:00
label $w .desc.name_l -text { Name:} -font font_ui
2007-01-25 21:50:15 +00:00
entry $w .desc.name_t \
2007-01-21 08:13:13 +00:00
-borderwidth 1 \
-relief sunken \
2007-01-21 06:31:14 +00:00
-width 40 \
2007-01-25 21:50:15 +00:00
-textvariable create_branch_name \
-font font_ui \
-validate key \
-validatecommand {
if { %d = = 1 && [ regexp { [ ~^:?*\[ \0 - ] } %S] } { return 0}
return 1
2007-01-21 06:31:14 +00:00
}
2007-01-25 21:50:15 +00:00
grid $w .desc.name_l $w .desc.name_t -sticky we -padx { 0 5}
2007-01-21 18:56:38 +00:00
grid columnconfigure $w .desc 1 -weight 1
2007-01-21 18:37:53 +00:00
pack $w .desc -anchor nw -fill x -pady 5 -padx 5
2007-01-21 06:31:14 +00:00
labelframe $w .from \
-text { Starting Revision} \
-font font_ui
2007-01-21 18:56:38 +00:00
radiobutton $w .from.head_r \
2007-01-21 06:31:14 +00:00
-text { Local Branch:} \
-value head \
-variable create_branch_revtype \
-font font_ui
2007-03-27 10:29:08 +00:00
set lbranchm [ eval tk_optionMenu $w .from.head_m create_branch_head \
$all_heads ]
$lbranchm configure -font font_ui
$w .from.head_m configure -font font_ui
2007-01-21 18:56:38 +00:00
grid $w .from.head_r $w .from.head_m -sticky w
2007-01-21 20:38:09 +00:00
set all_trackings [ all_tracking_branches]
if { $all_trackings ne { } } {
set create_branch_trackinghead [ lindex $all_trackings 0]
radiobutton $w .from.tracking_r \
-text { Tracking Branch:} \
-value tracking \
-variable create_branch_revtype \
-font font_ui
2007-03-27 10:29:08 +00:00
set tbranchm [ eval tk_optionMenu $w .from.tracking_m \
2007-01-21 20:38:09 +00:00
create_branch_trackinghead \
2007-03-27 10:29:08 +00:00
$all_trackings ]
$tbranchm configure -font font_ui
$w .from.tracking_m configure -font font_ui
2007-01-21 20:38:09 +00:00
grid $w .from.tracking_r $w .from.tracking_m -sticky w
}
2007-02-15 06:28:34 +00:00
set all_tags [ load_all_tags]
if { $all_tags ne { } } {
set create_branch_tag [ lindex $all_tags 0]
radiobutton $w .from.tag_r \
-text { Tag:} \
-value tag \
-variable create_branch_revtype \
-font font_ui
2007-03-27 10:29:08 +00:00
set tagsm [ eval tk_optionMenu $w .from.tag_m \
2007-02-15 06:28:34 +00:00
create_branch_tag \
2007-03-27 10:29:08 +00:00
$all_tags ]
$tagsm configure -font font_ui
$w .from.tag_m configure -font font_ui
2007-02-15 06:28:34 +00:00
grid $w .from.tag_r $w .from.tag_m -sticky w
}
2007-01-21 18:56:38 +00:00
radiobutton $w .from.exp_r \
2007-01-21 06:31:14 +00:00
-text { Revision Expression:} \
-value expression \
-variable create_branch_revtype \
-font font_ui
2007-01-25 21:50:15 +00:00
entry $w .from.exp_t \
2007-01-21 08:13:13 +00:00
-borderwidth 1 \
-relief sunken \
2007-01-21 06:31:14 +00:00
-width 50 \
2007-01-25 21:50:15 +00:00
-textvariable create_branch_revexp \
-font font_ui \
-validate key \
-validatecommand {
if { %d = = 1 && [ regexp { \s } %S] } { return 0}
if { %d = = 1 && [ string length %S] > 0} {
set create_branch_revtype expression
}
return 1
}
2007-01-24 20:21:01 +00:00
grid $w .from.exp_r $w .from.exp_t -sticky we -padx { 0 5}
2007-01-21 18:56:38 +00:00
grid columnconfigure $w .from 1 -weight 1
2007-01-21 06:31:14 +00:00
pack $w .from -anchor nw -fill x -pady 5 -padx 5
labelframe $w .postActions \
-text { Post Creation Actions} \
-font font_ui
checkbutton $w .postActions.checkout \
-text { Checkout after creation} \
-variable create_branch_checkout \
-font font_ui
pack $w .postActions.checkout -anchor nw
pack $w .postActions -anchor nw -fill x -pady 5 -padx 5
2007-01-21 22:02:25 +00:00
set create_branch_checkout 1
set create_branch_head $current_branch
set create_branch_revtype head
2007-01-25 21:50:15 +00:00
set create_branch_name $repo_config ( gui.newbranchtemplate)
set create_branch_revexp { }
2007-01-21 22:02:25 +00:00
2007-01-25 21:50:15 +00:00
bind $w <Visibility> "
grab $w
$w .desc.name_t icursor end
focus $w .desc.name_t
"
2007-01-21 06:31:14 +00:00
bind $w <Key-Escape> " destroy $w "
bind $w <Key-Return> " do_create_branch_action $w ;break "
wm title $w "[appname] ([reponame]): Create Branch"
tkwait window $w
2006-11-25 07:47:18 +00:00
}
2007-01-21 07:14:00 +00:00
proc do_delete_branch_action { w} {
global all_heads
2007-01-21 19:14:54 +00:00
global delete_branch_checktype delete_branch_head delete_branch_trackinghead
set check_rev { }
switch -- $delete_branch_checktype {
head { set check_rev $delete_branch_head }
tracking { set check_rev $delete_branch_trackinghead }
always { set check_rev { :none} }
}
if { $check_rev eq { :none} } {
set check_cmt { }
2007-02-13 03:48:56 +00:00
} elseif { [ catch { set check_cmt [ git rev-parse --verify " ${ check_rev } ^0 " ] } ] } {
2007-01-21 19:14:54 +00:00
tk_messageBox \
-icon error \
-type ok \
-title [ wm title $w ] \
-parent $w \
-message " Invalid check revision: $check_rev "
return
}
2007-01-21 07:14:00 +00:00
set to_delete [ list]
2007-01-21 09:51:45 +00:00
set not_merged [ list]
2007-01-21 07:14:00 +00:00
foreach i [ $w .list.l curselection] {
set b [ $w .list.l get $i ]
2007-02-13 03:48:56 +00:00
if { [ catch { set o [ git rev-parse --verify $b ] } ] } continue
2007-01-21 19:14:54 +00:00
if { $check_cmt ne { } } {
if { $b eq $check_rev } continue
2007-02-13 03:48:56 +00:00
if { [ catch { set m [ git merge-base $o $check_cmt ] } ] } continue
2007-01-21 09:51:45 +00:00
if { $o ne $m } {
lappend not_merged $b
continue
}
2007-01-21 07:14:00 +00:00
}
lappend to_delete [ list $b $o ]
}
2007-01-21 09:51:45 +00:00
if { $not_merged ne { } } {
2007-01-21 19:14:54 +00:00
set msg " The following branches are not completely merged into $check_rev :
2007-01-21 09:51:45 +00:00
- [ join $not_merged "\n - " ] "
2007-01-21 07:14:00 +00:00
tk_messageBox \
-icon info \
-type ok \
-title [ wm title $w ] \
-parent $w \
2007-01-21 09:51:45 +00:00
-message $msg
2007-01-21 07:14:00 +00:00
}
2007-01-21 09:51:45 +00:00
if { $to_delete eq { } } return
2007-01-21 19:14:54 +00:00
if { $delete_branch_checktype eq { always} } {
2007-01-21 09:51:45 +00:00
set msg { Recovering deleted branches is difficult.
2007-01-21 07:14:00 +00:00
2007-01-21 09:51:45 +00:00
Delete the selected branches?}
if { [ tk_messageBox \
-icon warning \
-type yesno \
-title [ wm title $w ] \
-parent $w \
-message $msg ] ne yes} {
return
}
2007-01-21 07:14:00 +00:00
}
set failed { }
foreach i $to_delete {
set b [ lindex $i 0]
set o [ lindex $i 1]
2007-02-13 03:48:56 +00:00
if { [ catch { git update-ref -d " refs/heads/ $b " $o } err] } {
2007-01-21 07:14:00 +00:00
append failed " - $b : $err \n "
} else {
2007-01-26 03:38:59 +00:00
set x [ lsearch -sorted -exact $all_heads $b ]
2007-01-21 07:14:00 +00:00
if { $x >= 0} {
set all_heads [ lreplace $all_heads $x $x ]
}
}
}
if { $failed ne { } } {
tk_messageBox \
-icon error \
-type ok \
-title [ wm title $w ] \
-parent $w \
-message " Failed to delete branches:\n $failed "
}
set all_heads [ lsort $all_heads ]
populate_branch_menu
destroy $w
}
2006-11-25 09:04:24 +00:00
proc do_delete_branch { } {
2007-01-21 07:21:45 +00:00
global all_heads tracking_branches current_branch
2007-01-21 19:14:54 +00:00
global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2007-01-21 07:14:00 +00:00
set w .branch_editor
toplevel $w
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
label $w .header -text { Delete Local Branch} \
-font font_uibold
pack $w .header -side top -fill x
frame $w .buttons
button $w .buttons.create -text Delete \
-font font_ui \
-command [ list do_delete_branch_action $w ]
pack $w .buttons.create -side right
button $w .buttons.cancel -text { Cancel} \
-font font_ui \
-command [ list destroy $w ]
pack $w .buttons.cancel -side right -padx 5
pack $w .buttons -side bottom -fill x -pady 10 -padx 10
labelframe $w .list \
-text { Local Branches} \
-font font_ui
listbox $w .list.l \
-height 10 \
2007-01-26 09:16:39 +00:00
-width 70 \
2007-01-21 07:14:00 +00:00
-selectmode extended \
2007-01-26 09:16:39 +00:00
-yscrollcommand [ list $w .list.sby set] \
2007-01-21 07:14:00 +00:00
-font font_ui
foreach h $all_heads {
if { $h ne $current_branch } {
$w .list.l insert end $h
}
}
2007-01-26 09:16:39 +00:00
scrollbar $w .list.sby -command [ list $w .list.l yview]
pack $w .list.sby -side right -fill y
pack $w .list.l -side left -fill both -expand 1
pack $w .list -fill both -expand 1 -pady 5 -padx 5
2007-01-21 07:14:00 +00:00
labelframe $w .validate \
2007-01-21 19:14:54 +00:00
-text { Delete Only If} \
-font font_ui
radiobutton $w .validate.head_r \
-text { Merged Into Local Branch:} \
-value head \
-variable delete_branch_checktype \
-font font_ui
2007-03-27 10:29:08 +00:00
set mergedlocalm [ eval tk_optionMenu $w .validate.head_m \
delete_branch_head \
$all_heads ]
$mergedlocalm configure -font font_ui
$w .validate.head_m configure -font font_ui
2007-01-21 19:14:54 +00:00
grid $w .validate.head_r $w .validate.head_m -sticky w
2007-01-21 20:38:09 +00:00
set all_trackings [ all_tracking_branches]
if { $all_trackings ne { } } {
set delete_branch_trackinghead [ lindex $all_trackings 0]
radiobutton $w .validate.tracking_r \
-text { Merged Into Tracking Branch:} \
-value tracking \
-variable delete_branch_checktype \
-font font_ui
2007-03-27 10:29:08 +00:00
set mergedtrackm [ eval tk_optionMenu $w .validate.tracking_m \
2007-01-21 20:38:09 +00:00
delete_branch_trackinghead \
2007-03-27 10:29:08 +00:00
$all_trackings ]
$mergedtrackm configure -font font_ui
$w .validate.tracking_m configure -font font_ui
2007-01-21 20:38:09 +00:00
grid $w .validate.tracking_r $w .validate.tracking_m -sticky w
}
2007-01-21 19:14:54 +00:00
radiobutton $w .validate.always_r \
-text { Always ( Do not perform merge checks) } \
-value always \
-variable delete_branch_checktype \
2007-01-21 07:14:00 +00:00
-font font_ui
2007-01-21 19:14:54 +00:00
grid $w .validate.always_r -columnspan 2 -sticky w
grid columnconfigure $w .validate 1 -weight 1
2007-01-21 07:14:00 +00:00
pack $w .validate -anchor nw -fill x -pady 5 -padx 5
2007-01-21 22:02:25 +00:00
set delete_branch_head $current_branch
set delete_branch_checktype head
2007-01-21 07:14:00 +00:00
bind $w <Visibility> " grab $w ; focus $w "
bind $w <Key-Escape> " destroy $w "
wm title $w "[appname] ([reponame]): Delete Branch"
tkwait window $w
2006-11-25 09:04:24 +00:00
}
2007-01-24 21:51:59 +00:00
proc switch_branch { new_branch} {
global HEAD commit_type current_branch repo_config
2006-11-25 09:04:24 +00:00
if { ![ lock_index switch] } return
# -- Our in memory state should match the repository.
#
repository_state curType curHEAD curMERGE_HEAD
if { [ string match amend* $commit_type ]
&& $curType eq { normal}
&& $curHEAD eq $HEAD } {
} elseif { $commit_type ne $curType || $HEAD ne $curHEAD } {
info_popup { Last scanned state does not match repository state.
2007-03-27 10:31:55 +00:00
Another Git program has modified this repository since the last scan. A rescan must be performed before the current branch can be changed.
2006-11-25 09:04:24 +00:00
The rescan will be automatically started now.
}
unlock_index
rescan { set ui_status_value { Ready.} }
return
}
2007-01-25 22:07:03 +00:00
# -- Don't do a pointless switch.
#
if { $current_branch eq $new_branch } {
unlock_index
return
}
2007-01-24 21:51:59 +00:00
if { $repo_config ( gui.trustmtime) eq { true} } {
switch_branch_stage2 { } $new_branch
} else {
set ui_status_value { Refreshing file status...}
set cmd [ list git update-index]
lappend cmd -q
lappend cmd --unmerged
lappend cmd --ignore-missing
lappend cmd --refresh
set fd_rf [ open " | $cmd " r]
fconfigure $fd_rf -blocking 0 -translation binary
fileevent $fd_rf readable \
[ list switch_branch_stage2 $fd_rf $new_branch ]
}
}
proc switch_branch_stage2 { fd_rf new_branch} {
global ui_status_value HEAD
if { $fd_rf ne { } } {
read $fd_rf
if { ![ eof $fd_rf ] } return
close $fd_rf
}
set ui_status_value " Updating working directory to ' $new_branch '... "
set cmd [ list git read-tree]
lappend cmd -m
lappend cmd -u
lappend cmd --exclude-per-directory= .gitignore
lappend cmd $HEAD
lappend cmd $new_branch
set fd_rt [ open " | $cmd " r]
fconfigure $fd_rt -blocking 0 -translation binary
fileevent $fd_rt readable \
[ list switch_branch_readtree_wait $fd_rt $new_branch ]
}
proc switch_branch_readtree_wait { fd_rt new_branch} {
global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
global current_branch
global ui_comm ui_status_value
# -- We never get interesting output on stdout; only stderr.
2006-11-25 09:04:24 +00:00
#
2007-01-24 21:51:59 +00:00
read $fd_rt
fconfigure $fd_rt -blocking 1
if { ![ eof $fd_rt ] } {
fconfigure $fd_rt -blocking 0
return
2006-11-25 09:04:24 +00:00
}
2007-01-24 21:51:59 +00:00
# -- The working directory wasn't in sync with the index and
# we'd have to overwrite something to make the switch. A
# merge is required.
#
if { [ catch { close $fd_rt } err] } {
regsub { ^fatal: } $err { } err
warn_popup " File level merge required.
$err
Staying on branch '$current_branch' ."
set ui_status_value " Aborted checkout of ' $new_branch ' (file level merging is required). "
unlock_index
return
}
# -- Update the symbolic ref. Core git doesn't even check for failure
# here, it Just Works(tm). If it doesn't we are in some really ugly
# state that is difficult to recover from within git-gui.
#
2007-02-13 03:48:56 +00:00
if { [ catch { git symbolic-ref HEAD " refs/heads/ $new_branch " } err] } {
2007-01-24 21:51:59 +00:00
error_popup " Failed to set current branch.
2007-03-27 10:31:55 +00:00
This working directory is only partially switched. We successfully updated your files, but failed to update an internal Git file.
2007-01-24 21:51:59 +00:00
2007-03-27 10:31:55 +00:00
This should not have occurred. [ appname] will now close and give up.
2006-11-25 09:04:24 +00:00
2007-01-24 21:51:59 +00:00
$err "
do_quit
return
}
# -- Update our repository state. If we were previously in amend mode
# we need to toss the current buffer and do a full rescan to update
# our file lists. If we weren't in amend mode our file lists are
# accurate and we can avoid the rescan.
#
2006-11-25 09:04:24 +00:00
unlock_index
2007-01-24 21:51:59 +00:00
set selected_commit_type new
if { [ string match amend* $commit_type ] } {
$ui_comm delete 0.0 end
$ui_comm edit reset
$ui_comm edit modified false
rescan { set ui_status_value " Checked out branch ' $current_branch '. " }
} else {
repository_state commit_type HEAD MERGE_HEAD
set PARENT $HEAD
set ui_status_value " Checked out branch ' $current_branch '. "
}
2006-11-25 09:04:24 +00:00
}
2006-11-07 04:13:23 +00:00
######################################################################
##
2006-11-09 04:42:51 +00:00
## remote management
2006-11-07 09:26:02 +00:00
2006-11-07 04:13:23 +00:00
proc load_all_remotes { } {
2007-01-21 02:48:56 +00:00
global repo_config
2006-11-25 08:33:03 +00:00
global all_remotes tracking_branches
2006-11-07 04:13:23 +00:00
set all_remotes [ list]
2006-11-25 08:33:03 +00:00
array unset tracking_branches
2007-01-21 02:55:05 +00:00
set rm_dir [ gitdir remotes]
2006-11-07 04:13:23 +00:00
if { [ file isdirectory $rm_dir ] } {
2006-11-25 08:33:03 +00:00
set all_remotes [ glob \
2006-11-07 08:00:20 +00:00
-types f \
-tails \
-nocomplain \
2006-11-25 08:33:03 +00:00
-directory $rm_dir *]
foreach name $all_remotes {
catch {
set fd [ open [ file join $rm_dir $name ] r]
while { [ gets $fd line] >= 0} {
if { ![ regexp { ^Pull:[ ] *( [ ^:] +) :( .+) $} \
$line line src dst] } continue
if { ![ regexp ^refs/ $dst ] } {
set dst " refs/heads/ $dst "
}
set tracking_branches( $dst ) [ list $name $src ]
}
close $fd
}
}
2006-11-07 04:13:23 +00:00
}
2006-11-07 09:26:02 +00:00
foreach line [ array names repo_config remote.*.url] {
2006-11-25 08:33:03 +00:00
if { ![ regexp ^remote\. ( .*) \. url\$ $line line name] } continue
lappend all_remotes $name
if { [ catch { set fl $repo_config ( remote.$name .fetch) } ] } {
set fl { }
}
foreach line $fl {
if { ![ regexp { ^( [ ^:] +) :( .+) $} $line line src dst] } continue
if { ![ regexp ^refs/ $dst ] } {
set dst " refs/heads/ $dst "
}
set tracking_branches( $dst ) [ list $name $src ]
2006-11-07 04:13:23 +00:00
}
}
set all_remotes [ lsort -unique $all_remotes ]
}
2007-01-25 22:16:22 +00:00
proc populate_fetch_menu { } {
2007-01-21 02:48:56 +00:00
global all_remotes repo_config
2006-11-07 04:13:23 +00:00
2007-01-25 22:16:22 +00:00
set m .mbar.fetch
2006-11-16 04:52:20 +00:00
foreach r $all_remotes {
set enable 0
if { ![ catch { set a $repo_config ( remote.$r .url) } ] } {
if { ![ catch { set a $repo_config ( remote.$r .fetch) } ] } {
set enable 1
}
} else {
catch {
2007-01-21 02:55:05 +00:00
set fd [ open [ gitdir remotes $r ] r]
2006-11-16 04:52:20 +00:00
while { [ gets $fd n] >= 0} {
if { [ regexp { ^Pull:[ \t ] *( [ ^:] +) :} $n ] } {
set enable 1
break
}
}
close $fd
}
}
if { $enable } {
$m add command \
-label " Fetch from $r ... " \
-command [ list fetch_from $r ] \
-font font_ui
}
}
}
2007-01-25 22:16:22 +00:00
proc populate_push_menu { } {
2007-01-21 02:48:56 +00:00
global all_remotes repo_config
2006-11-16 04:52:20 +00:00
2007-01-25 22:16:22 +00:00
set m .mbar.push
2007-01-26 04:50:27 +00:00
set fast_count 0
2006-11-16 04:52:20 +00:00
foreach r $all_remotes {
set enable 0
if { ![ catch { set a $repo_config ( remote.$r .url) } ] } {
if { ![ catch { set a $repo_config ( remote.$r .push) } ] } {
set enable 1
}
} else {
catch {
2007-01-21 02:55:05 +00:00
set fd [ open [ gitdir remotes $r ] r]
2006-11-16 04:52:20 +00:00
while { [ gets $fd n] >= 0} {
if { [ regexp { ^Push:[ \t ] *( [ ^:] +) :} $n ] } {
set enable 1
break
}
}
close $fd
}
}
if { $enable } {
2007-01-26 04:50:27 +00:00
if { !$fast_count } {
$m add separator
}
2006-11-16 04:52:20 +00:00
$m add command \
-label " Push to $r ... " \
-command [ list push_to $r ] \
-font font_ui
2007-01-26 04:50:27 +00:00
incr fast_count
}
}
}
proc start_push_anywhere_action { w} {
global push_urltype push_remote push_url push_thin push_tags
set r_url { }
switch -- $push_urltype {
remote { set r_url $push_remote }
url { set r_url $push_url }
}
if { $r_url eq { } } return
set cmd [ list git push]
lappend cmd -v
if { $push_thin } {
lappend cmd --thin
}
if { $push_tags } {
lappend cmd --tags
}
lappend cmd $r_url
set cnt 0
foreach i [ $w .source.l curselection] {
set b [ $w .source.l get $i ]
lappend cmd " refs/heads/ $b :refs/heads/ $b "
incr cnt
}
if { $cnt = = 0} {
return
} elseif { $cnt = = 1} {
set unit branch
} else {
set unit branches
}
set cons [ new_console " push $r_url " " Pushing $cnt $unit to $r_url " ]
2007-01-26 06:29:00 +00:00
console_exec $cons $cmd console_done
2007-01-26 04:50:27 +00:00
destroy $w
}
trace add variable push_remote write \
[ list radio_selector push_urltype remote]
proc do_push_anywhere { } {
global all_heads all_remotes current_branch
global push_urltype push_remote push_url push_thin push_tags
set w .push_setup
toplevel $w
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
label $w .header -text { Push Branches} -font font_uibold
pack $w .header -side top -fill x
frame $w .buttons
button $w .buttons.create -text Push \
-font font_ui \
2007-03-27 10:31:02 +00:00
-default active \
2007-01-26 04:50:27 +00:00
-command [ list start_push_anywhere_action $w ]
pack $w .buttons.create -side right
button $w .buttons.cancel -text { Cancel} \
-font font_ui \
2007-03-27 10:31:02 +00:00
-default normal \
2007-01-26 04:50:27 +00:00
-command [ list destroy $w ]
pack $w .buttons.cancel -side right -padx 5
pack $w .buttons -side bottom -fill x -pady 10 -padx 10
labelframe $w .source \
-text { Source Branches} \
-font font_ui
listbox $w .source.l \
-height 10 \
2007-01-26 09:16:39 +00:00
-width 70 \
2007-01-26 04:50:27 +00:00
-selectmode extended \
2007-01-26 09:16:39 +00:00
-yscrollcommand [ list $w .source.sby set] \
2007-01-26 04:50:27 +00:00
-font font_ui
foreach h $all_heads {
$w .source.l insert end $h
if { $h eq $current_branch } {
$w .source.l select set end
}
}
2007-01-26 09:16:39 +00:00
scrollbar $w .source.sby -command [ list $w .source.l yview]
pack $w .source.sby -side right -fill y
pack $w .source.l -side left -fill both -expand 1
pack $w .source -fill both -expand 1 -pady 5 -padx 5
2007-01-26 04:50:27 +00:00
labelframe $w .dest \
-text { Destination Repository} \
-font font_ui
if { $all_remotes ne { } } {
radiobutton $w .dest.remote_r \
-text { Remote:} \
-value remote \
-variable push_urltype \
-font font_ui
2007-03-27 10:29:08 +00:00
set remmenu [ eval tk_optionMenu $w .dest.remote_m push_remote \
$all_remotes ]
$remmenu configure -font font_ui
$w .dest.remote_m configure -font font_ui
2007-01-26 04:50:27 +00:00
grid $w .dest.remote_r $w .dest.remote_m -sticky w
if { [ lsearch -sorted -exact $all_remotes origin] != -1} {
set push_remote origin
} else {
set push_remote [ lindex $all_remotes 0]
2006-11-16 04:52:20 +00:00
}
2007-01-26 04:50:27 +00:00
set push_urltype remote
} else {
set push_urltype url
2006-11-07 04:13:23 +00:00
}
2007-01-26 04:50:27 +00:00
radiobutton $w .dest.url_r \
-text { Arbitrary URL:} \
-value url \
-variable push_urltype \
-font font_ui
entry $w .dest.url_t \
-borderwidth 1 \
-relief sunken \
-width 50 \
-textvariable push_url \
-font font_ui \
-validate key \
-validatecommand {
if { %d = = 1 && [ regexp { \s } %S] } { return 0}
if { %d = = 1 && [ string length %S] > 0} {
set push_urltype url
}
return 1
}
grid $w .dest.url_r $w .dest.url_t -sticky we -padx { 0 5}
grid columnconfigure $w .dest 1 -weight 1
pack $w .dest -anchor nw -fill x -pady 5 -padx 5
labelframe $w .options \
-text { Transfer Options} \
-font font_ui
checkbutton $w .options.thin \
-text { Use thin pack ( for slow network connections) } \
-variable push_thin \
-font font_ui
grid $w .options.thin -columnspan 2 -sticky w
checkbutton $w .options.tags \
-text { Include tags} \
-variable push_tags \
-font font_ui
grid $w .options.tags -columnspan 2 -sticky w
grid columnconfigure $w .options 1 -weight 1
pack $w .options -anchor nw -fill x -pady 5 -padx 5
set push_url { }
set push_thin 0
set push_tags 0
2007-03-27 10:31:02 +00:00
bind $w <Visibility> " grab $w ; focus $w .buttons.create "
2007-01-26 04:50:27 +00:00
bind $w <Key-Escape> " destroy $w "
wm title $w "[appname] ([reponame]): Push"
tkwait window $w
2006-11-07 04:13:23 +00:00
}
2007-01-26 08:33:56 +00:00
######################################################################
##
## merge
proc can_merge { } {
global HEAD commit_type file_states
if { [ string match amend* $commit_type ] } {
info_popup { Cannot merge while amending.
2007-03-27 10:31:55 +00:00
You must finish amending this commit before starting any type of merge.
2007-01-26 08:33:56 +00:00
}
return 0
}
if { [ committer_ident] eq { } } { return 0}
if { ![ lock_index merge] } { return 0}
# -- Our in memory state should match the repository.
#
repository_state curType curHEAD curMERGE_HEAD
if { $commit_type ne $curType || $HEAD ne $curHEAD } {
info_popup { Last scanned state does not match repository state.
2007-03-27 10:31:55 +00:00
Another Git program has modified this repository since the last scan. A rescan must be performed before a merge can be performed.
2007-01-26 08:33:56 +00:00
The rescan will be automatically started now.
}
unlock_index
rescan { set ui_status_value { Ready.} }
return 0
}
foreach path [ array names file_states] {
switch -glob -- [ lindex $file_states ( $path ) 0] {
2007-01-26 09:11:10 +00:00
_O {
continue ; # and pray it works!
}
2007-01-26 08:33:56 +00:00
U? {
error_popup " You are in the middle of a conflicted merge.
File [ short_path $path ] has merge conflicts.
2007-03-27 10:31:55 +00:00
You must resolve them, add the file, and commit to complete the current merge. Only then can you begin another merge.
2007-01-26 09:11:10 +00:00
"
unlock_index
return 0
}
?? {
error_popup " You are in the middle of a change.
File [ short_path $path ] is modified.
2007-03-27 10:31:55 +00:00
You should complete the current commit before starting a merge. Doing so will help you abort a failed merge, should the need arise.
2007-01-26 08:33:56 +00:00
"
unlock_index
return 0
}
}
}
return 1
}
proc visualize_local_merge { w} {
set revs { }
foreach i [ $w .source.l curselection] {
lappend revs [ $w .source.l get $i ]
}
if { $revs eq { } } return
lappend revs --not HEAD
do_gitk $revs
}
proc start_local_merge_action { w} {
2007-01-26 08:58:56 +00:00
global HEAD ui_status_value current_branch
2007-01-26 08:33:56 +00:00
set cmd [ list git merge]
set names { }
set revcnt 0
foreach i [ $w .source.l curselection] {
set b [ $w .source.l get $i ]
lappend cmd $b
lappend names $b
incr revcnt
}
if { $revcnt = = 0} {
return
} elseif { $revcnt = = 1} {
set unit branch
} elseif { $revcnt <= 15} {
set unit branches
} else {
tk_messageBox \
-icon error \
-type ok \
-title [ wm title $w ] \
-parent $w \
-message " Too many branches selected.
You have requested to merge $revcnt branches
in an octopus merge. This exceeds Git' s
internal limit of 15 branches per merge.
Please select fewer branches. To merge more
than 15 branches, merge the branches in batches.
"
return
}
2007-01-26 08:58:56 +00:00
set msg " Merging $current_branch , [join $names {, }] "
set ui_status_value " $msg ... "
set cons [ new_console "Merge" $msg ]
2007-01-26 09:07:34 +00:00
console_exec $cons $cmd [ list finish_merge $revcnt ]
2007-01-26 08:33:56 +00:00
bind $w <Destroy> { }
destroy $w
}
2007-01-26 09:07:34 +00:00
proc finish_merge { revcnt w ok} {
2007-01-26 08:33:56 +00:00
console_done $w $ok
if { $ok } {
set msg { Merge completed successfully.}
} else {
2007-01-26 09:07:34 +00:00
if { $revcnt != 1} {
info_popup " Octopus merge failed.
Your merge of $revcnt branches has failed.
2007-03-27 10:31:55 +00:00
There are file-level conflicts between the branches which must be resolved manually.
2007-01-26 09:07:34 +00:00
The working directory will now be reset.
2007-03-27 10:31:55 +00:00
You can attempt this merge again by merging only one branch at a time." $w
2007-01-26 09:07:34 +00:00
set fd [ open "| git read-tree --reset -u HEAD" r]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [ list reset_hard_wait $fd ]
set ui_status_value { Aborting... please wait...}
return
}
2007-01-26 08:33:56 +00:00
set msg { Merge failed. Conflict resolution is required.}
}
unlock_index
rescan [ list set ui_status_value $msg ]
}
proc do_local_merge { } {
global current_branch
if { ![ can_merge] } return
set w .merge_setup
toplevel $w
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
label $w .header \
-text " Merge Into $current_branch " \
-font font_uibold
pack $w .header -side top -fill x
frame $w .buttons
button $w .buttons.visualize -text Visualize \
-font font_ui \
-command [ list visualize_local_merge $w ]
pack $w .buttons.visualize -side left
button $w .buttons.create -text Merge \
-font font_ui \
-command [ list start_local_merge_action $w ]
pack $w .buttons.create -side right
button $w .buttons.cancel -text { Cancel} \
-font font_ui \
-command [ list destroy $w ]
pack $w .buttons.cancel -side right -padx 5
pack $w .buttons -side bottom -fill x -pady 10 -padx 10
labelframe $w .source \
-text { Source Branches} \
-font font_ui
listbox $w .source.l \
-height 10 \
2007-01-26 09:16:39 +00:00
-width 70 \
2007-01-26 08:33:56 +00:00
-selectmode extended \
-yscrollcommand [ list $w .source.sby set] \
-font font_ui
scrollbar $w .source.sby -command [ list $w .source.l yview]
pack $w .source.sby -side right -fill y
pack $w .source.l -side left -fill both -expand 1
pack $w .source -fill both -expand 1 -pady 5 -padx 5
set cmd [ list git for -each-ref]
2007-02-14 04:43:48 +00:00
lappend cmd { --format= %( objectname) %( *objectname) %( refname) }
2007-01-26 08:33:56 +00:00
lappend cmd refs/heads
lappend cmd refs/remotes
2007-02-14 04:43:48 +00:00
lappend cmd refs/tags
2007-01-26 08:33:56 +00:00
set fr_fd [ open " | $cmd " r]
fconfigure $fr_fd -translation binary
while { [ gets $fr_fd line] > 0} {
set line [ split $line { } ]
2007-02-14 04:43:48 +00:00
set sha1( [ lindex $line 0] ) [ lindex $line 2]
set sha1( [ lindex $line 1] ) [ lindex $line 2]
2007-01-26 08:33:56 +00:00
}
close $fr_fd
set to_show { }
set fr_fd [ open "| git rev-list --all --not HEAD" ]
while { [ gets $fr_fd line] > 0} {
if { [ catch { set ref $sha1 ( $line ) } ] } continue
2007-02-14 04:43:48 +00:00
regsub ^refs/( heads| remotes| tags) / $ref { } ref
2007-01-26 08:33:56 +00:00
lappend to_show $ref
}
close $fr_fd
foreach ref [ lsort -unique $to_show ] {
$w .source.l insert end $ref
}
bind $w <Visibility> " grab $w "
bind $w <Key-Escape> " unlock_index;destroy $w "
bind $w <Destroy> unlock_index
wm title $w "[appname] ([reponame]): Merge"
tkwait window $w
}
2007-01-26 08:54:05 +00:00
proc do_reset_hard { } {
global HEAD commit_type file_states
if { [ string match amend* $commit_type ] } {
info_popup { Cannot abort while amending.
You must finish amending this commit.
}
return
}
if { ![ lock_index abort] } return
if { [ string match *merge* $commit_type ] } {
set op merge
} else {
set op commit
}
if { [ ask_popup " Abort $op ?
2007-03-27 10:31:55 +00:00
Aborting the current $op will cause *ALL* uncommitted changes to be lost.
2007-01-26 08:54:05 +00:00
Continue with aborting the current $op ?" ] eq {yes}} {
set fd [ open "| git read-tree --reset -u HEAD" r]
fconfigure $fd -blocking 0 -translation binary
fileevent $fd readable [ list reset_hard_wait $fd ]
set ui_status_value { Aborting... please wait...}
} else {
unlock_index
}
}
proc reset_hard_wait { fd} {
global ui_comm
read $fd
if { [ eof $fd ] } {
close $fd
unlock_index
$ui_comm delete 0.0 end
$ui_comm edit modified false
catch { file delete [ gitdir MERGE_HEAD] }
catch { file delete [ gitdir rr-cache MERGE_RR] }
catch { file delete [ gitdir SQUASH_MSG] }
catch { file delete [ gitdir MERGE_MSG] }
catch { file delete [ gitdir GITGUI_MSG] }
rescan { set ui_status_value { Abort completed. Ready.} }
}
}
2007-01-29 05:50:41 +00:00
######################################################################
##
## browser
set next_browser_id 0
2007-01-29 07:52:06 +00:00
proc new_browser { commit} {
2007-02-08 22:07:59 +00:00
global next_browser_id cursor_ptr M1B
2007-01-29 05:50:41 +00:00
global browser_commit browser_status browser_stack browser_path browser_busy
2007-02-16 05:24:03 +00:00
if { [ winfo ismapped .] } {
set w .browser[ incr next_browser_id]
set tl $w
toplevel $w
} else {
set w { }
set tl .
}
2007-01-29 05:50:41 +00:00
set w_list $w .list.l
2007-01-29 07:52:06 +00:00
set browser_commit( $w_list ) $commit
2007-01-29 05:50:41 +00:00
set browser_status( $w_list ) { Starting...}
set browser_stack( $w_list ) { }
set browser_path( $w_list ) $browser_commit ( $w_list ) :
set browser_busy( $w_list ) 1
label $w .path -textvariable browser_path( $w_list ) \
-anchor w \
-justify left \
-borderwidth 1 \
-relief sunken \
-font font_uibold
pack $w .path -anchor w -side top -fill x
frame $w .list
text $w_list -background white -borderwidth 0 \
-cursor $cursor_ptr \
-state disabled \
-wrap none \
-height 20 \
-width 70 \
-xscrollcommand [ list $w .list.sbx set] \
-yscrollcommand [ list $w .list.sby set] \
-font font_ui
$w_list tag conf in_sel \
-background [ $w_list cget -foreground] \
-foreground [ $w_list cget -background]
scrollbar $w .list.sbx -orient h -command [ list $w_list xview]
scrollbar $w .list.sby -orient v -command [ list $w_list yview]
pack $w .list.sbx -side bottom -fill x
pack $w .list.sby -side right -fill y
pack $w_list -side left -fill both -expand 1
pack $w .list -side top -fill both -expand 1
label $w .status -textvariable browser_status( $w_list ) \
-anchor w \
-justify left \
-borderwidth 1 \
-relief sunken \
-font font_ui
pack $w .status -anchor w -side bottom -fill x
bind $w_list <Button-1> " browser_click 0 $w_list @%x,%y;break "
bind $w_list <Double-Button-1> " browser_click 1 $w_list @%x,%y;break "
2007-02-08 22:07:59 +00:00
bind $w_list <$M1B -Up> " browser_parent $w_list ;break "
bind $w_list <$M1B -Left> " browser_parent $w_list ;break "
bind $w_list <Up> " browser_move -1 $w_list ;break "
bind $w_list <Down> " browser_move 1 $w_list ;break "
bind $w_list <$M1B -Right> " browser_enter $w_list ;break "
bind $w_list <Return> " browser_enter $w_list ;break "
bind $w_list <Prior> " browser_page -1 $w_list ;break "
bind $w_list <Next> " browser_page 1 $w_list ;break "
bind $w_list <Left> break
bind $w_list <Right> break
2007-01-29 05:50:41 +00:00
2007-02-16 05:24:03 +00:00
bind $tl <Visibility> " focus $w "
bind $tl <Destroy> "
2007-01-29 05:50:41 +00:00
array unset browser_buffer $w_list
array unset browser_files $w_list
array unset browser_status $w_list
array unset browser_stack $w_list
array unset browser_path $w_list
array unset browser_commit $w_list
array unset browser_busy $w_list
"
2007-02-16 05:24:03 +00:00
wm title $tl "[appname] ([reponame]): File Browser"
2007-01-29 05:50:41 +00:00
ls_tree $w_list $browser_commit ( $w_list ) { }
}
2007-02-08 22:07:59 +00:00
proc browser_move { dir w} {
global browser_files browser_busy
if { $browser_busy ( $w ) } return
set lno [ lindex [ split [ $w index in_sel.first] .] 0]
incr lno $dir
if { [ lindex $browser_files ( $w ) [ expr { $lno - 1} ] ] ne { } } {
$w tag remove in_sel 0.0 end
$w tag add in_sel $lno .0 [ expr { $lno + 1} ] .0
$w see $lno .0
}
}
proc browser_page { dir w} {
global browser_files browser_busy
if { $browser_busy ( $w ) } return
$w yview scroll $dir pages
set lno [ expr { int(
[ lindex [ $w yview] 0]
* [ llength $browser_files ( $w ) ]
+ 1) } ]
if { [ lindex $browser_files ( $w ) [ expr { $lno - 1} ] ] ne { } } {
$w tag remove in_sel 0.0 end
$w tag add in_sel $lno .0 [ expr { $lno + 1} ] .0
$w see $lno .0
}
}
proc browser_parent { w} {
global browser_files browser_status browser_path
global browser_stack browser_busy
if { $browser_busy ( $w ) } return
set info [ lindex $browser_files ( $w ) 0]
if { [ lindex $info 0] eq { parent} } {
set parent [ lindex $browser_stack ( $w ) end-1]
set browser_stack( $w ) [ lrange $browser_stack ( $w ) 0 end-2]
if { $browser_stack ( $w ) eq { } } {
regsub { :.*$} $browser_path ( $w ) { :} browser_path( $w )
} else {
regsub { /[ ^/] +$} $browser_path ( $w ) { } browser_path( $w )
}
set browser_status( $w ) " Loading $browser_path ( $w )... "
ls_tree $w [ lindex $parent 0] [ lindex $parent 1]
}
}
proc browser_enter { w} {
2007-01-29 05:50:41 +00:00
global browser_files browser_status browser_path
global browser_commit browser_stack browser_busy
if { $browser_busy ( $w ) } return
2007-02-08 22:07:59 +00:00
set lno [ lindex [ split [ $w index in_sel.first] .] 0]
2007-01-29 05:50:41 +00:00
set info [ lindex $browser_files ( $w ) [ expr { $lno - 1} ] ]
if { $info ne { } } {
2007-02-08 22:07:59 +00:00
switch -- [ lindex $info 0] {
parent {
browser_parent $w
}
tree {
set name [ lindex $info 2]
set escn [ escape_path $name ]
set browser_status( $w ) " Loading $escn ... "
append browser_path( $w ) $escn
ls_tree $w [ lindex $info 1] $name
}
blob {
set name [ lindex $info 2]
set p { }
foreach n $browser_stack ( $w ) {
append p [ lindex $n 1]
}
append p $name
show_blame $browser_commit ( $w ) $p
}
}
}
}
proc browser_click { was_double_click w pos} {
global browser_files browser_busy
if { $browser_busy ( $w ) } return
set lno [ lindex [ split [ $w index $pos ] .] 0]
focus $w
if { [ lindex $browser_files ( $w ) [ expr { $lno - 1} ] ] ne { } } {
$w tag remove in_sel 0.0 end
2007-01-29 05:50:41 +00:00
$w tag add in_sel $lno .0 [ expr { $lno + 1} ] .0
if { $was_double_click } {
2007-02-08 22:07:59 +00:00
browser_enter $w
2007-01-29 05:50:41 +00:00
}
}
}
proc ls_tree { w tree_id name} {
global browser_buffer browser_files browser_stack browser_busy
set browser_buffer( $w ) { }
set browser_files( $w ) { }
set browser_busy( $w ) 1
$w conf -state normal
$w tag remove in_sel 0.0 end
$w delete 0.0 end
if { $browser_stack ( $w ) ne { } } {
$w image create end \
-align center -padx 5 -pady 1 \
-name icon0 \
-image file_uplevel
$w insert end { [ Up To Parent] }
lappend browser_files( $w ) parent
}
lappend browser_stack( $w ) [ list $tree_id $name ]
$w conf -state disabled
2007-01-29 08:09:28 +00:00
set cmd [ list git ls-tree -z $tree_id ]
set fd [ open " | $cmd " r]
2007-01-29 05:50:41 +00:00
fconfigure $fd -blocking 0 -translation binary -encoding binary
fileevent $fd readable [ list read_ls_tree $fd $w ]
}
proc read_ls_tree { fd w} {
global browser_buffer browser_files browser_status browser_busy
if { ![ winfo exists $w ] } {
catch { close $fd }
return
}
append browser_buffer( $w ) [ read $fd ]
set pck [ split $browser_buffer ( $w ) "\0" ]
set browser_buffer( $w ) [ lindex $pck end]
set n [ llength $browser_files ( $w ) ]
$w conf -state normal
foreach p [ lrange $pck 0 end-1] {
set info [ split $p "\t" ]
set path [ lindex $info 1]
set info [ split [ lindex $info 0] { } ]
set type [ lindex $info 1]
set object [ lindex $info 2]
switch -- $type {
blob {
2007-01-29 07:50:10 +00:00
set image file_mod
2007-01-29 05:50:41 +00:00
}
tree {
set image file_dir
append path /
}
default {
set image file_question
}
}
if { $n > 0} { $w insert end "\n" }
$w image create end \
-align center -padx 5 -pady 1 \
-name icon[ incr n] \
-image $image
$w insert end [ escape_path $path ]
lappend browser_files( $w ) [ list $type $object $path ]
}
$w conf -state disabled
if { [ eof $fd ] } {
close $fd
set browser_status( $w ) Ready.
set browser_busy( $w ) 0
array unset browser_buffer $w
2007-02-08 22:07:59 +00:00
if { $n > 0} {
$w tag add in_sel 1.0 2.0
focus -force $w
}
2007-01-29 05:50:41 +00:00
}
}
proc show_blame { commit path} {
global next_browser_id blame_status blame_data
2007-02-09 00:10:52 +00:00
if { [ winfo ismapped .] } {
set w .browser[ incr next_browser_id]
set tl $w
toplevel $w
} else {
set w { }
set tl .
}
2007-01-29 05:50:41 +00:00
set blame_status( $w ) { Loading current file content...}
label $w .path -text " $commit : $path " \
-anchor w \
-justify left \
-borderwidth 1 \
-relief sunken \
-font font_uibold
2007-01-29 11:23:12 +00:00
pack $w .path -side top -fill x
2007-01-29 05:50:41 +00:00
2007-01-29 11:23:12 +00:00
frame $w .out
2007-02-09 06:59:38 +00:00
text $w .out.loaded_t \
-background white -borderwidth 0 \
-state disabled \
-wrap none \
-height 40 \
-width 1 \
-font font_diff
$w .out.loaded_t tag conf annotated -background grey
2007-01-29 11:23:12 +00:00
text $w .out.linenumber_t \
2007-01-29 10:51:49 +00:00
-background white -borderwidth 0 \
2007-01-29 05:50:41 +00:00
-state disabled \
-wrap none \
-height 40 \
-width 5 \
-font font_diff
2007-01-29 11:23:12 +00:00
$w .out.linenumber_t tag conf linenumber -justify right
text $w .out.file_t \
2007-01-29 10:51:49 +00:00
-background white -borderwidth 0 \
2007-01-29 05:50:41 +00:00
-state disabled \
-wrap none \
-height 40 \
-width 80 \
2007-01-29 11:23:12 +00:00
-xscrollcommand [ list $w .out.sbx set] \
2007-01-29 05:50:41 +00:00
-font font_diff
2007-01-29 11:23:12 +00:00
scrollbar $w .out.sbx -orient h -command [ list $w .out.file_t xview]
scrollbar $w .out.sby -orient v \
2007-02-09 02:39:27 +00:00
-command [ list scrollbar2many [ list \
2007-02-09 06:59:38 +00:00
$w .out.loaded_t \
2007-02-09 02:39:27 +00:00
$w .out.linenumber_t \
$w .out.file_t \
] yview]
2007-02-09 06:59:38 +00:00
grid \
$w .out.linenumber_t \
$w .out.loaded_t \
$w .out.file_t \
$w .out.sby \
-sticky nsew
grid conf $w .out.sbx -column 2 -sticky we
grid columnconfigure $w .out 2 -weight 1
2007-02-09 02:39:27 +00:00
grid rowconfigure $w .out 0 -weight 1
2007-01-29 11:23:12 +00:00
pack $w .out -fill both -expand 1
2007-01-29 05:50:41 +00:00
label $w .status -textvariable blame_status( $w ) \
-anchor w \
-justify left \
-borderwidth 1 \
-relief sunken \
-font font_ui
2007-01-29 11:23:12 +00:00
pack $w .status -side bottom -fill x
2007-01-29 05:50:41 +00:00
2007-02-09 02:39:27 +00:00
frame $w .cm
text $w .cm.t \
-background white -borderwidth 0 \
-state disabled \
-wrap none \
-height 10 \
-width 80 \
-xscrollcommand [ list $w .cm.sbx set] \
-yscrollcommand [ list $w .cm.sby set] \
-font font_diff
scrollbar $w .cm.sbx -orient h -command [ list $w .cm.t xview]
scrollbar $w .cm.sby -orient v -command [ list $w .cm.t yview]
pack $w .cm.sby -side right -fill y
pack $w .cm.sbx -side bottom -fill x
pack $w .cm.t -expand 1 -fill both
pack $w .cm -side bottom -fill x
2007-01-29 05:50:41 +00:00
menu $w .ctxm -tearoff 0
$w .ctxm add command -label "Copy Commit" \
-font font_ui \
-command " blame_copycommit $w \$cursorW @\$cursorX,\$cursorY "
2007-02-09 06:59:38 +00:00
foreach i [ list \
$w .out.loaded_t \
$w .out.linenumber_t \
$w .out.file_t] {
2007-01-29 05:50:41 +00:00
$i tag conf in_sel \
-background [ $i cget -foreground] \
-foreground [ $i cget -background]
2007-01-29 10:51:49 +00:00
$i conf -yscrollcommand \
2007-02-09 02:39:27 +00:00
[ list many2scrollbar [ list \
2007-02-09 06:59:38 +00:00
$w .out.loaded_t \
2007-02-09 02:39:27 +00:00
$w .out.linenumber_t \
$w .out.file_t \
] yview $w .out.sby]
bind $i <Button-1> "
2007-02-09 06:59:38 +00:00
blame_click { $w } \\
2007-02-09 02:39:27 +00:00
$w .cm.t \\
$w .out.linenumber_t \\
$w .out.file_t \\
$i @%x,%y
2007-02-09 07:28:32 +00:00
focus $i
2007-02-09 02:39:27 +00:00
"
2007-01-29 05:50:41 +00:00
bind_button3 $i "
set cursorX %x
set cursorY %y
set cursorW %W
tk_popup $w .ctxm %X %Y
"
}
2007-02-09 07:28:32 +00:00
bind $w .cm.t <Button-1> " focus $w .cm.t "
2007-02-09 00:10:52 +00:00
bind $tl <Visibility> " focus $tl "
bind $tl <Destroy> "
array unset blame_status { $w }
2007-01-29 05:50:41 +00:00
array unset blame_data $w ,*
"
2007-02-09 00:10:52 +00:00
wm title $tl "[appname] ([reponame]): File Viewer"
2007-01-29 05:50:41 +00:00
2007-02-09 06:59:38 +00:00
set blame_data( $w ,commit_count) 0
set blame_data( $w ,commit_list) { }
2007-01-29 05:50:41 +00:00
set blame_data( $w ,total_lines) 0
2007-02-09 02:39:27 +00:00
set blame_data( $w ,blame_lines) 0
set blame_data( $w ,highlight_commit) { }
set blame_data( $w ,highlight_line) -1
2007-02-09 06:59:38 +00:00
2007-01-29 08:09:28 +00:00
set cmd [ list git cat-file blob " $commit : $path " ]
set fd [ open " | $cmd " r]
2007-01-29 05:50:41 +00:00
fconfigure $fd -blocking 0 -translation lf -encoding binary
2007-01-29 10:51:49 +00:00
fileevent $fd readable [ list read_blame_catfile \
$fd $w $commit $path \
2007-02-09 06:59:38 +00:00
$w .cm.t $w .out.loaded_t $w .out.linenumber_t $w .out.file_t]
2007-01-29 05:50:41 +00:00
}
2007-02-09 06:59:38 +00:00
proc read_blame_catfile { fd w commit path w_cmit w_load w_line w_file} {
2007-01-29 05:50:41 +00:00
global blame_status blame_data
if { ![ winfo exists $w_file ] } {
catch { close $fd }
return
}
set n $blame_data ( $w ,total_lines)
2007-02-09 06:59:38 +00:00
$w_load conf -state normal
2007-02-09 02:39:27 +00:00
$w_line conf -state normal
$w_file conf -state normal
2007-01-29 05:50:41 +00:00
while { [ gets $fd line] >= 0} {
regsub "\r\$" $line { } line
incr n
2007-02-09 06:59:38 +00:00
$w_load insert end "\n"
2007-02-09 02:39:27 +00:00
$w_line insert end " $n \n " linenumber
$w_file insert end " $line \n "
2007-01-29 05:50:41 +00:00
}
2007-02-09 06:59:38 +00:00
$w_load conf -state disabled
2007-02-09 02:39:27 +00:00
$w_line conf -state disabled
$w_file conf -state disabled
2007-01-29 05:50:41 +00:00
set blame_data( $w ,total_lines) $n
if { [ eof $fd ] } {
close $fd
2007-02-09 02:39:27 +00:00
blame_incremental_status $w
2007-01-29 08:03:29 +00:00
set cmd [ list git blame -M -C --incremental]
lappend cmd $commit -- $path
set fd [ open " | $cmd " r]
2007-01-29 05:50:41 +00:00
fconfigure $fd -blocking 0 -translation lf -encoding binary
2007-02-09 02:39:27 +00:00
fileevent $fd readable [ list read_blame_incremental $fd $w \
2007-02-09 06:59:38 +00:00
$w_load $w_cmit $w_line $w_file ]
2007-01-29 05:50:41 +00:00
}
}
2007-02-09 06:59:38 +00:00
proc read_blame_incremental { fd w w_load w_cmit w_line w_file} {
2007-01-29 05:50:41 +00:00
global blame_status blame_data
2007-02-09 02:39:27 +00:00
if { ![ winfo exists $w_file ] } {
2007-01-29 05:50:41 +00:00
catch { close $fd }
return
}
while { [ gets $fd line] >= 0} {
if { [ regexp { ^( [ a-z0-9] { 40} ) ( \d +) ( \d +) ( \d +) $} $line line \
2007-01-29 11:56:00 +00:00
cmit original_line final_line line_count] } {
set blame_data( $w ,commit) $cmit
2007-01-29 05:50:41 +00:00
set blame_data( $w ,original_line) $original_line
set blame_data( $w ,final_line) $final_line
set blame_data( $w ,line_count) $line_count
2007-01-29 11:56:00 +00:00
2007-02-09 06:59:38 +00:00
if { [ catch { set g $blame_data ( $w ,$cmit ,order) } ] } {
2007-02-09 02:39:27 +00:00
$w_line tag conf g$cmit
$w_file tag conf g$cmit
$w_line tag raise in_sel
$w_file tag raise in_sel
2007-02-09 07:28:32 +00:00
$w_file tag raise sel
2007-02-09 06:59:38 +00:00
set blame_data( $w ,$cmit ,order) $blame_data ( $w ,commit_count)
incr blame_data( $w ,commit_count)
lappend blame_data( $w ,commit_list) $cmit
2007-01-29 11:56:00 +00:00
}
2007-01-29 05:50:41 +00:00
} elseif { [ string match { filename *} $line ] } {
2007-02-09 02:39:27 +00:00
set file [ string range $line 9 end]
2007-01-29 05:50:41 +00:00
set n $blame_data ( $w ,line_count)
set lno $blame_data ( $w ,final_line)
2007-01-29 11:56:00 +00:00
set cmit $blame_data ( $w ,commit)
2007-01-29 05:50:41 +00:00
while { $n > 0} {
2007-02-09 02:39:27 +00:00
if { [ catch { set g g$blame_data ( $w ,line$lno ,commit) } ] } {
2007-02-09 06:59:38 +00:00
$w_load tag add annotated $lno .0 " $lno .0 lineend + 1c "
2007-02-09 02:39:27 +00:00
} else {
$w_line tag remove g$g $lno .0 " $lno .0 lineend + 1c "
$w_file tag remove g$g $lno .0 " $lno .0 lineend + 1c "
2007-01-29 11:56:00 +00:00
}
2007-01-29 05:50:41 +00:00
2007-02-09 02:39:27 +00:00
set blame_data( $w ,line$lno ,commit) $cmit
set blame_data( $w ,line$lno ,file) $file
$w_line tag add g$cmit $lno .0 " $lno .0 lineend + 1c "
$w_file tag add g$cmit $lno .0 " $lno .0 lineend + 1c "
2007-01-29 10:33:27 +00:00
2007-02-09 03:41:51 +00:00
if { $blame_data ( $w ,highlight_line) = = -1} {
if { [ lindex [ $w_file yview] 0] = = 0} {
$w_file see $lno .0
blame_showcommit $w $w_cmit $w_line $w_file $lno
}
} elseif { $blame_data ( $w ,highlight_line) = = $lno } {
2007-02-09 02:39:27 +00:00
blame_showcommit $w $w_cmit $w_line $w_file $lno
2007-01-29 11:56:00 +00:00
}
2007-01-29 05:50:41 +00:00
incr n -1
incr lno
2007-02-09 02:39:27 +00:00
incr blame_data( $w ,blame_lines)
2007-01-29 05:50:41 +00:00
}
2007-02-09 06:59:38 +00:00
set hc $blame_data ( $w ,highlight_commit)
if { $hc ne { }
&& [ expr { $blame_data ( $w ,$hc ,order) + 1} ]
= = $blame_data ( $w ,$cmit ,order) } {
blame_showcommit $w $w_cmit $w_line $w_file \
$blame_data ( $w ,highlight_line)
}
2007-01-29 05:50:41 +00:00
} elseif { [ regexp { ^( [ a-z-] +) ( .*) $} $line line header data] } {
set blame_data( $w ,$blame_data ( $w ,commit) ,$header ) $data
}
}
if { [ eof $fd ] } {
close $fd
set blame_status( $w ) { Annotation complete.}
2007-02-09 02:39:27 +00:00
} else {
blame_incremental_status $w
2007-01-29 05:50:41 +00:00
}
}
2007-02-09 02:39:27 +00:00
proc blame_incremental_status { w} {
global blame_status blame_data
set blame_status( $w ) [ format \
"Loading annotations... %i of %i lines annotated (%2i%%)" \
$blame_data ( $w ,blame_lines) \
$blame_data ( $w ,total_lines) \
[ expr { 100 * $blame_data ( $w ,blame_lines)
/ $blame_data ( $w ,total_lines) } ] ]
}
2007-02-09 06:59:38 +00:00
proc blame_click { w w_cmit w_line w_file cur_w pos} {
2007-02-09 02:39:27 +00:00
set lno [ lindex [ split [ $cur_w index $pos ] .] 0]
2007-01-29 05:50:41 +00:00
if { $lno eq { } } return
2007-02-09 02:39:27 +00:00
$w_line tag remove in_sel 0.0 end
$w_file tag remove in_sel 0.0 end
$w_line tag add in_sel $lno .0 " $lno .0 + 1 line "
$w_file tag add in_sel $lno .0 " $lno .0 + 1 line "
blame_showcommit $w $w_cmit $w_line $w_file $lno
}
2007-02-09 06:59:38 +00:00
set blame_colors {
#ff4040
#ff40ff
#4040ff
}
2007-02-09 02:39:27 +00:00
proc blame_showcommit { w w_cmit w_line w_file lno} {
2007-02-09 06:59:38 +00:00
global blame_colors blame_data repo_config
2007-02-09 02:39:27 +00:00
set cmit $blame_data ( $w ,highlight_commit)
if { $cmit ne { } } {
2007-02-09 06:59:38 +00:00
set idx $blame_data ( $w ,$cmit ,order)
set i 0
foreach c $blame_colors {
set h [ lindex $blame_data ( $w ,commit_list) [ expr { $idx - 1 + $i } ] ]
$w_line tag conf g$h -background white
$w_file tag conf g$h -background white
incr i
}
2007-01-29 05:50:41 +00:00
}
2007-02-09 02:39:27 +00:00
$w_cmit conf -state normal
$w_cmit delete 0.0 end
if { [ catch { set cmit $blame_data ( $w ,line$lno ,commit) } ] } {
set cmit { }
2007-02-09 06:59:38 +00:00
$w_cmit insert end "Loading annotation..."
2007-02-09 02:39:27 +00:00
} else {
2007-02-09 06:59:38 +00:00
set idx $blame_data ( $w ,$cmit ,order)
set i 0
foreach c $blame_colors {
set h [ lindex $blame_data ( $w ,commit_list) [ expr { $idx - 1 + $i } ] ]
$w_line tag conf g$h -background $c
$w_file tag conf g$h -background $c
incr i
}
2007-02-09 02:39:27 +00:00
if { [ catch { set msg $blame_data ( $w ,$cmit ,message) } ] } {
set msg { }
catch {
set fd [ open " | git cat-file commit $cmit " r]
fconfigure $fd -encoding binary -translation lf
if { [ catch { set enc $repo_config ( i18n.commitencoding) } ] } {
set enc utf-8
}
while { [ gets $fd line] > 0} {
if { [ string match { encoding *} $line ] } {
set enc [ string tolower [ string range $line 9 end] ]
}
}
fconfigure $fd -encoding $enc
set msg [ string trim [ read $fd ] ]
close $fd
}
set blame_data( $w ,$cmit ,message) $msg
}
set author_name { }
set author_email { }
set author_time { }
catch { set author_name $blame_data ( $w ,$cmit ,author) }
catch { set author_email $blame_data ( $w ,$cmit ,author-mail) }
catch { set author_time [ clock format $blame_data ( $w ,$cmit ,author-time) ] }
set committer_name { }
set committer_email { }
set committer_time { }
catch { set committer_name $blame_data ( $w ,$cmit ,committer) }
catch { set committer_email $blame_data ( $w ,$cmit ,committer-mail) }
catch { set committer_time [ clock format $blame_data ( $w ,$cmit ,committer-time) ] }
$w_cmit insert end " commit $cmit \n "
$w_cmit insert end " Author: $author_name $author_email $author_time \n "
$w_cmit insert end " Committer: $committer_name $committer_email $committer_time \n "
$w_cmit insert end " Original File: [escape_path $blame_data ( $w ,line $lno ,file)]\n "
$w_cmit insert end "\n"
$w_cmit insert end $msg
}
$w_cmit conf -state disabled
set blame_data( $w ,highlight_line) $lno
set blame_data( $w ,highlight_commit) $cmit
2007-01-29 05:50:41 +00:00
}
proc blame_copycommit { w i pos} {
global blame_data
set lno [ lindex [ split [ $i index $pos ] .] 0]
if { ![ catch { set commit $blame_data ( $w ,line$lno ,commit) } ] } {
clipboard clear
clipboard append \
-format STRING \
-type STRING \
-- $commit
}
}
2006-11-06 19:20:27 +00:00
######################################################################
##
## icons
set filemask {
#define mask_width 14
#define mask_height 15
static unsigned char mask_bits[ ] = {
0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f} ;
}
image create bitmap file_plain -background white -foreground black -data {
#define plain_width 14
#define plain_height 15
static unsigned char plain_bits[ ] = {
0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f} ;
} -maskdata $filemask
image create bitmap file_mod -background white -foreground blue -data {
#define mod_width 14
#define mod_height 15
static unsigned char mod_bits[ ] = {
0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f} ;
} -maskdata $filemask
2006-11-06 21:07:32 +00:00
image create bitmap file_fulltick -background white -foreground "#007000" -data {
#define file_fulltick_width 14
#define file_fulltick_height 15
static unsigned char file_fulltick_bits[ ] = {
2006-11-06 19:20:27 +00:00
0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f} ;
} -maskdata $filemask
image create bitmap file_parttick -background white -foreground "#005050" -data {
#define parttick_width 14
#define parttick_height 15
static unsigned char parttick_bits[ ] = {
0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f} ;
} -maskdata $filemask
image create bitmap file_question -background white -foreground black -data {
#define file_question_width 14
#define file_question_height 15
static unsigned char file_question_bits[ ] = {
0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f} ;
} -maskdata $filemask
image create bitmap file_removed -background white -foreground red -data {
#define file_removed_width 14
#define file_removed_height 15
static unsigned char file_removed_bits[ ] = {
0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f} ;
} -maskdata $filemask
image create bitmap file_merge -background white -foreground blue -data {
#define file_merge_width 14
#define file_merge_height 15
static unsigned char file_merge_bits[ ] = {
0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f} ;
} -maskdata $filemask
2007-01-29 07:50:10 +00:00
set file_dir_data {
#define file_width 18
#define file_height 18
static unsigned char file_bits[ ] = {
0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
0x00, 0x00, 0x00, 0x00, 0x00, 0x00} ;
}
image create bitmap file_dir -background white -foreground blue \
-data $file_dir_data -maskdata $file_dir_data
unset file_dir_data
set file_uplevel_data {
#define up_width 15
#define up_height 15
static unsigned char up_bits[ ] = {
0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00} ;
}
image create bitmap file_uplevel -background white -foreground red \
-data $file_uplevel_data -maskdata $file_uplevel_data
unset file_uplevel_data
2007-01-29 05:50:41 +00:00
2006-11-08 00:58:37 +00:00
set ui_index .vpane.files.index.list
2007-01-21 03:06:51 +00:00
set ui_workdir .vpane.files.workdir.list
2007-01-21 03:45:19 +00:00
set all_icons( _$ui_index ) file_plain
set all_icons( A$ui_index ) file_fulltick
set all_icons( M$ui_index ) file_fulltick
set all_icons( D$ui_index ) file_removed
set all_icons( U$ui_index ) file_merge
set all_icons( _$ui_workdir ) file_plain
set all_icons( M$ui_workdir ) file_mod
set all_icons( D$ui_workdir ) file_question
2007-01-21 17:30:51 +00:00
set all_icons( U$ui_workdir ) file_merge
2007-01-21 03:45:19 +00:00
set all_icons( O$ui_workdir ) file_plain
2006-11-06 21:07:32 +00:00
set max_status_desc 0
2006-11-06 19:20:27 +00:00
foreach i {
2007-01-21 03:45:19 +00:00
{ __ "Unmodified" }
2007-01-21 04:00:28 +00:00
{ _M "Modified, not staged" }
{ M_ "Staged for commit" }
{ MM "Portions staged for commit" }
{ MD "Staged for commit, missing" }
{ _O "Untracked, not staged" }
{ A_ "Staged for commit" }
{ AM "Portions staged for commit" }
{ AD "Staged for commit, missing" }
2007-01-21 03:45:19 +00:00
{ _D "Missing" }
2007-01-21 04:00:28 +00:00
{ D_ "Staged for removal" }
{ DO "Staged for removal, still present" }
2007-01-21 03:45:19 +00:00
2007-01-21 04:00:28 +00:00
{ U_ "Requires merge resolution" }
2007-01-21 17:30:51 +00:00
{ UU "Requires merge resolution" }
2007-01-21 04:00:28 +00:00
{ UM "Requires merge resolution" }
{ UD "Requires merge resolution" }
2006-11-06 19:20:27 +00:00
} {
2007-01-21 03:45:19 +00:00
if { $max_status_desc < [ string length [ lindex $i 1] ] } {
set max_status_desc [ string length [ lindex $i 1] ]
2006-11-06 21:07:32 +00:00
}
2007-01-21 03:45:19 +00:00
set all_descs( [ lindex $i 0] ) [ lindex $i 1]
2006-11-06 19:20:27 +00:00
}
2007-01-21 03:45:19 +00:00
unset i
2006-11-06 19:20:27 +00:00
######################################################################
##
## util
2006-11-12 07:22:21 +00:00
proc bind_button3 { w cmd} {
bind $w <Any-Button-3> $cmd
if { [ is_MacOSX] } {
bind $w <Control-Button-1> $cmd
}
}
2007-01-29 05:50:41 +00:00
proc scrollbar2many { list mode args} {
foreach w $list { eval $w $mode $args }
}
proc many2scrollbar { list mode sb top bottom} {
$sb set $top $bottom
foreach w $list { $w $mode moveto $top }
}
2006-11-12 05:40:38 +00:00
proc incr_font_size { font { amt 1} } {
set sz [ font configure $font -size]
incr sz $amt
font configure $font -size $sz
font configure ${ font } bold -size $sz
}
2006-11-07 01:03:36 +00:00
proc hook_failed_popup { hook msg} {
set w .hookfail
toplevel $w
frame $w .m
label $w .m.l1 -text " $hook hook failed: " \
-anchor w \
-justify left \
2006-11-12 05:40:38 +00:00
-font font_uibold
2006-11-07 01:03:36 +00:00
text $w .m.t \
-background white -borderwidth 1 \
-relief sunken \
-width 80 -height 10 \
2006-11-12 05:40:38 +00:00
-font font_diff \
2006-11-07 01:03:36 +00:00
-yscrollcommand [ list $w .m.sby set]
label $w .m.l2 \
-text { You must correct the above errors before committing.} \
-anchor w \
-justify left \
2006-11-12 05:40:38 +00:00
-font font_uibold
2006-11-07 01:03:36 +00:00
scrollbar $w .m.sby -command [ list $w .m.t yview]
pack $w .m.l1 -side top -fill x
pack $w .m.l2 -side bottom -fill x
pack $w .m.sby -side right -fill y
pack $w .m.t -side left -fill both -expand 1
pack $w .m -side top -fill both -expand 1 -padx 5 -pady 10
$w .m.t insert 1.0 $msg
$w .m.t conf -state disabled
button $w .ok -text OK \
-width 15 \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-07 01:03:36 +00:00
-command " destroy $w "
2006-11-13 03:41:34 +00:00
pack $w .ok -side bottom -anchor e -pady 10 -padx 10
2006-11-07 01:03:36 +00:00
bind $w <Visibility> " grab $w ; focus $w "
bind $w <Key-Return> " destroy $w "
2007-01-21 02:48:56 +00:00
wm title $w "[appname] ([reponame]): error"
2006-11-07 01:03:36 +00:00
tkwait window $w
}
2006-11-07 04:13:23 +00:00
set next_console_id 0
proc new_console { short_title long_title} {
2006-11-07 09:19:49 +00:00
global next_console_id console_data
set w .console[ incr next_console_id]
set console_data( $w ) [ list $short_title $long_title ]
return [ console_init $w ]
}
proc console_init { w} {
2007-01-21 02:48:56 +00:00
global console_cr console_data M1B
2006-11-07 04:13:23 +00:00
2006-11-07 07:18:18 +00:00
set console_cr( $w ) 1.0
2006-11-07 04:13:23 +00:00
toplevel $w
frame $w .m
2006-11-07 09:19:49 +00:00
label $w .m.l1 -text " [lindex $console_data ( $w ) 1]: " \
2006-11-07 04:13:23 +00:00
-anchor w \
-justify left \
2006-11-12 05:40:38 +00:00
-font font_uibold
2006-11-07 04:13:23 +00:00
text $w .m.t \
-background white -borderwidth 1 \
-relief sunken \
-width 80 -height 10 \
2006-11-12 05:40:38 +00:00
-font font_diff \
2006-11-07 04:13:23 +00:00
-state disabled \
-yscrollcommand [ list $w .m.sby set]
2006-11-13 03:41:34 +00:00
label $w .m.s -text { Working... please wait...} \
-anchor w \
2006-11-07 07:57:46 +00:00
-justify left \
2006-11-12 05:40:38 +00:00
-font font_uibold
2006-11-07 04:13:23 +00:00
scrollbar $w .m.sby -command [ list $w .m.t yview]
pack $w .m.l1 -side top -fill x
2006-11-07 07:57:46 +00:00
pack $w .m.s -side bottom -fill x
2006-11-07 04:13:23 +00:00
pack $w .m.sby -side right -fill y
pack $w .m.t -side left -fill both -expand 1
pack $w .m -side top -fill both -expand 1 -padx 5 -pady 10
2006-11-12 01:24:23 +00:00
menu $w .ctxm -tearoff 0
$w .ctxm add command -label "Copy" \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-12 01:24:23 +00:00
-command " tk_textCopy $w .m.t "
$w .ctxm add command -label "Select All" \
2006-11-12 05:40:38 +00:00
-font font_ui \
2007-01-22 23:31:12 +00:00
-command " focus $w .m.t; $w .m.t tag add sel 0.0 end "
2006-11-12 01:24:23 +00:00
$w .ctxm add command -label "Copy All" \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-12 01:24:23 +00:00
-command "
$w .m.t tag add sel 0.0 end
tk_textCopy $w .m.t
$w .m.t tag remove sel 0.0 end
"
2006-11-13 03:41:34 +00:00
button $w .ok -text { Close} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-07 04:13:23 +00:00
-state disabled \
-command " destroy $w "
2006-11-13 03:41:34 +00:00
pack $w .ok -side bottom -anchor e -pady 10 -padx 10
2006-11-07 04:13:23 +00:00
2006-11-12 07:22:21 +00:00
bind_button3 $w .m.t " tk_popup $w .ctxm %X %Y "
2006-11-12 01:00:35 +00:00
bind $w .m.t <$M1B -Key-a> " $w .m.t tag add sel 0.0 end;break "
bind $w .m.t <$M1B -Key-A> " $w .m.t tag add sel 0.0 end;break "
2006-11-07 04:13:23 +00:00
bind $w <Visibility> " focus $w "
2007-01-21 02:48:56 +00:00
wm title $w " [appname] ([reponame]): [lindex $console_data ( $w ) 0] "
2006-11-07 04:13:23 +00:00
return $w
}
2007-01-26 06:29:00 +00:00
proc console_exec { w cmd after} {
2007-01-29 01:58:47 +00:00
# -- Cygwin's Tcl tosses the enviroment when we exec our child.
2006-11-07 04:47:05 +00:00
# But most users need that so we have to relogin. :-(
#
2007-01-29 01:58:47 +00:00
if { [ is_Cygwin] } {
2006-11-07 04:47:05 +00:00
set cmd [ list sh --login -c " cd \"[pwd]\" && [join $cmd { }] " ]
}
# -- Tcl won't let us redirect both stdout and stderr to
# the same pipe. So pass it through cat...
#
set cmd [ concat | $cmd | & cat]
set fd_f [ open $cmd r]
2006-11-07 07:18:18 +00:00
fconfigure $fd_f -blocking 0 -translation binary
2006-11-07 10:02:15 +00:00
fileevent $fd_f readable [ list console_read $w $fd_f $after ]
2006-11-07 04:47:05 +00:00
}
2006-11-07 10:02:15 +00:00
proc console_read { w fd after} {
2007-01-26 06:29:00 +00:00
global console_cr
2006-11-07 07:18:18 +00:00
set buf [ read $fd ]
2006-11-12 23:16:45 +00:00
if { $buf ne { } } {
2006-11-07 09:19:49 +00:00
if { ![ winfo exists $w ] } { console_init $w }
$w .m.t conf -state normal
set c 0
set n [ string length $buf ]
while { $c < $n } {
set cr [ string first "\r" $buf $c ]
set lf [ string first "\n" $buf $c ]
2006-11-13 21:06:38 +00:00
if { $cr < 0} { set cr [ expr { $n + 1} ] }
if { $lf < 0} { set lf [ expr { $n + 1} ] }
2006-11-07 09:19:49 +00:00
if { $lf < $cr } {
$w .m.t insert end [ string range $buf $c $lf ]
set console_cr( $w ) [ $w .m.t index { end -1c} ]
set c $lf
incr c
} else {
$w .m.t delete $console_cr ( $w ) end
$w .m.t insert end "\n"
$w .m.t insert end [ string range $buf $c $cr ]
set c $cr
incr c
}
2006-11-07 07:18:18 +00:00
}
2006-11-07 09:19:49 +00:00
$w .m.t conf -state disabled
$w .m.t see end
2006-11-07 04:13:23 +00:00
}
2006-11-07 07:57:46 +00:00
fconfigure $fd -blocking 1
2006-11-07 04:13:23 +00:00
if { [ eof $fd ] } {
2006-11-07 07:57:46 +00:00
if { [ catch { close $fd } ] } {
2006-11-07 10:02:15 +00:00
set ok 0
2007-01-26 06:29:00 +00:00
} else {
2006-11-07 10:02:15 +00:00
set ok 1
2006-11-07 07:57:46 +00:00
}
2007-01-26 06:29:00 +00:00
uplevel #0 $after $w $ok
2006-11-07 07:57:46 +00:00
return
2006-11-07 04:13:23 +00:00
}
2006-11-07 07:57:46 +00:00
fconfigure $fd -blocking 0
2006-11-07 04:13:23 +00:00
}
2007-01-26 07:02:09 +00:00
proc console_chain { cmdlist w { ok 1} } {
if { $ok } {
if { [ llength $cmdlist ] = = 0} {
console_done $w $ok
return
}
set cmd [ lindex $cmdlist 0]
set cmdlist [ lrange $cmdlist 1 end]
if { [ lindex $cmd 0] eq { console_exec} } {
console_exec $w \
[ lindex $cmd 1] \
[ list console_chain $cmdlist ]
} else {
uplevel #0 $cmd $cmdlist $w $ok
}
} else {
console_done $w $ok
}
}
proc console_done { args} {
2007-01-26 06:29:00 +00:00
global console_cr console_data
2007-01-26 07:02:09 +00:00
switch -- [ llength $args ] {
2 {
set w [ lindex $args 0]
set ok [ lindex $args 1]
}
3 {
set w [ lindex $args 1]
set ok [ lindex $args 2]
}
default {
error "wrong number of args: console_done ?ignored? w ok"
}
}
2007-01-26 06:29:00 +00:00
if { $ok } {
if { [ winfo exists $w ] } {
$w .m.s conf -background green -text { Success}
$w .ok conf -state normal
2007-03-27 10:31:02 +00:00
focus $w .ok
2007-01-26 06:29:00 +00:00
}
} else {
if { ![ winfo exists $w ] } {
console_init $w
}
$w .m.s conf -background red -text { Error: Command Failed}
$w .ok conf -state normal
2007-03-27 10:31:02 +00:00
focus $w .ok
2007-01-26 06:29:00 +00:00
}
array unset console_cr $w
array unset console_data $w
}
2006-11-06 19:20:27 +00:00
######################################################################
##
## ui commands
2007-01-21 02:56:25 +00:00
set starting_gitk_msg { Starting gitk... please wait...}
2006-11-07 04:47:05 +00:00
2006-11-22 01:33:09 +00:00
proc do_gitk { revs} {
2007-01-29 01:58:47 +00:00
global env ui_status_value starting_gitk_msg
# -- Always start gitk through whatever we were loaded with. This
# lets us bypass using shell process on Windows systems.
#
set cmd [ info nameofexecutable]
lappend cmd [ gitexec gitk]
2006-11-22 01:33:09 +00:00
if { $revs ne { } } {
append cmd { }
append cmd $revs
2006-11-07 00:12:58 +00:00
}
2006-11-22 01:33:09 +00:00
2007-01-29 01:58:47 +00:00
if { [ catch { eval exec $cmd & } err] } {
2006-11-22 01:33:09 +00:00
error_popup " Failed to start gitk:\n\n $err "
2006-11-06 19:20:27 +00:00
} else {
2006-11-22 01:33:09 +00:00
set ui_status_value $starting_gitk_msg
after 10000 {
if { $ui_status_value eq $starting_gitk_msg } {
set ui_status_value { Ready.}
}
}
2006-11-06 19:20:27 +00:00
}
}
2007-01-24 20:21:01 +00:00
proc do_stats { } {
set fd [ open "| git count-objects -v" r]
while { [ gets $fd line] > 0} {
if { [ regexp { ^( [ ^:] +) : ( \d +) $} $line _ name value] } {
set stats( $name ) $value
}
}
close $fd
2007-01-25 00:08:49 +00:00
set packed_sz 0
foreach p [ glob -directory [ gitdir objects pack] \
-type f \
-nocomplain -- *] {
incr packed_sz [ file size $p ]
}
if { $packed_sz > 0} {
set stats( size-pack) [ expr { $packed_sz / 1024} ]
}
2007-01-24 20:21:01 +00:00
set w .stats_view
toplevel $w
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
label $w .header -text { Database Statistics} \
-font font_uibold
pack $w .header -side top -fill x
frame $w .buttons -border 1
button $w .buttons.close -text Close \
-font font_ui \
2007-03-27 10:31:02 +00:00
-default active \
2007-01-24 20:21:01 +00:00
-command [ list destroy $w ]
button $w .buttons.gc -text { Compress Database} \
-font font_ui \
2007-03-27 10:31:02 +00:00
-default normal \
2007-01-24 20:21:01 +00:00
-command " destroy $w ;do_gc "
pack $w .buttons.close -side right
pack $w .buttons.gc -side left
pack $w .buttons -side bottom -fill x -pady 10 -padx 10
frame $w .stat -borderwidth 1 -relief solid
foreach s {
{ count { Number of loose objects} }
{ size { Disk space used by loose objects} { KiB} }
{ in-pack { Number of packed objects} }
{ packs { Number of packs} }
2007-01-25 00:08:49 +00:00
{ size-pack { Disk space used by packed objects} { KiB} }
2007-01-24 20:21:01 +00:00
{ prune-packable { Packed objects waiting for pruning} }
{ garbage { Garbage files} }
} {
set name [ lindex $s 0]
set label [ lindex $s 1]
if { [ catch { set value $stats ( $name ) } ] } continue
if { [ llength $s ] > 2} {
set value " $value [lindex $s 2] "
}
label $w .stat.l_$name -text " $label : " -anchor w -font font_ui
label $w .stat.v_$name -text $value -anchor w -font font_ui
grid $w .stat.l_$name $w .stat.v_$name -sticky we -padx { 0 5}
}
2007-01-25 18:07:53 +00:00
pack $w .stat -pady 10 -padx 10
2007-01-24 20:21:01 +00:00
2007-03-27 10:31:02 +00:00
bind $w <Visibility> " grab $w ; focus $w .buttons.close "
2007-01-24 20:21:01 +00:00
bind $w <Key-Escape> [ list destroy $w ]
bind $w <Key-Return> [ list destroy $w ]
wm title $w "[appname] ([reponame]): Database Statistics"
tkwait window $w
}
2007-01-20 23:38:12 +00:00
proc do_gc { } {
set w [ new_console { gc} { Compressing the object database} ]
2007-01-26 07:02:09 +00:00
console_chain {
{ console_exec { git pack-refs --prune} }
{ console_exec { git reflog expire --all} }
{ console_exec { git repack -a -d -l} }
{ console_exec { git rerere gc} }
} $w
2006-11-08 01:40:35 +00:00
}
2006-11-21 02:43:41 +00:00
proc do_fsck_objects { } {
2006-11-21 03:17:15 +00:00
set w [ new_console { fsck-objects} \
{ Verifying the object database with fsck-objects} ]
2006-11-21 02:43:41 +00:00
set cmd [ list git fsck-objects]
lappend cmd --full
lappend cmd --cache
lappend cmd --strict
2007-01-26 06:29:00 +00:00
console_exec $w $cmd console_done
2006-11-21 02:43:41 +00:00
}
2006-11-12 07:27:28 +00:00
set is_quitting 0
2006-11-12 00:32:24 +00:00
2006-11-06 19:20:27 +00:00
proc do_quit { } {
2007-01-21 02:48:56 +00:00
global ui_comm is_quitting repo_config commit_type
2006-11-12 00:32:24 +00:00
2006-11-12 07:27:28 +00:00
if { $is_quitting } return
set is_quitting 1
2006-11-06 21:07:32 +00:00
2007-02-08 22:47:17 +00:00
if { [ winfo exists $ui_comm ] } {
# -- Stash our current commit buffer.
#
set save [ gitdir GITGUI_MSG]
set msg [ string trim [ $ui_comm get 0.0 end] ]
regsub -all -line { [ \r \t ] +$} $msg { } msg
if { ( ![ string match amend* $commit_type ]
|| [ $ui_comm edit modified] )
&& $msg ne { } } {
catch {
set fd [ open $save w]
puts -nonewline $fd $msg
close $fd
}
} else {
catch { file delete $save }
2006-11-06 21:07:32 +00:00
}
2007-02-08 22:47:17 +00:00
# -- Stash our current window geometry into this repository.
#
set cfg_geometry [ list]
lappend cfg_geometry [ wm geometry .]
lappend cfg_geometry [ lindex [ .vpane sash coord 0] 1]
lappend cfg_geometry [ lindex [ .vpane.files sash coord 0] 0]
if { [ catch { set rc_geometry $repo_config ( gui.geometry) } ] } {
set rc_geometry { }
}
if { $cfg_geometry ne $rc_geometry } {
2007-02-13 03:48:56 +00:00
catch { git config gui.geometry $cfg_geometry }
2007-02-08 22:47:17 +00:00
}
2006-11-12 08:47:00 +00:00
}
2006-11-06 19:20:27 +00:00
destroy .
}
proc do_rescan { } {
2006-11-14 06:29:32 +00:00
rescan { set ui_status_value { Ready.} }
2006-11-06 19:20:27 +00:00
}
2007-01-21 04:07:04 +00:00
proc unstage_helper { txt paths} {
2007-01-21 16:37:58 +00:00
global file_states current_diff_path
2006-11-19 05:29:55 +00:00
if { ![ lock_index begin-update] } return
set pathList [ list]
set after { }
foreach path $paths {
switch -glob -- [ lindex $file_states ( $path ) 0] {
A? -
M? -
D? {
lappend pathList $path
2007-01-21 16:37:58 +00:00
if { $path eq $current_diff_path } {
2006-11-19 05:29:55 +00:00
set after { reshow_diff; }
}
}
}
}
if { $pathList eq { } } {
unlock_index
} else {
update_indexinfo \
$txt \
$pathList \
[ concat $after { set ui_status_value { Ready.} } ]
}
}
2007-01-21 04:07:04 +00:00
proc do_unstage_selection { } {
2007-01-21 16:37:58 +00:00
global current_diff_path selected_paths
2006-11-19 05:29:55 +00:00
if { [ array size selected_paths] > 0} {
2007-01-21 04:07:04 +00:00
unstage_helper \
{ Unstaging selected files from commit} \
2006-11-19 05:29:55 +00:00
[ array names selected_paths]
2007-01-21 16:37:58 +00:00
} elseif { $current_diff_path ne { } } {
2007-01-21 04:07:04 +00:00
unstage_helper \
2007-01-21 16:37:58 +00:00
" Unstaging [short_path $current_diff_path ] from commit " \
[ list $current_diff_path ]
2006-11-19 05:29:55 +00:00
}
}
2007-01-21 04:07:04 +00:00
proc add_helper { txt paths} {
2007-01-21 16:37:58 +00:00
global file_states current_diff_path
2006-11-12 11:35:14 +00:00
if { ![ lock_index begin-update] } return
set pathList [ list]
2006-11-18 08:03:16 +00:00
set after { }
2006-11-18 08:24:20 +00:00
foreach path $paths {
2006-11-19 08:46:29 +00:00
switch -glob -- [ lindex $file_states ( $path ) 0] {
2007-01-21 04:33:34 +00:00
_O -
?M -
?D -
U? {
2006-11-18 08:03:16 +00:00
lappend pathList $path
2007-01-21 16:37:58 +00:00
if { $path eq $current_diff_path } {
2006-11-18 08:03:16 +00:00
set after { reshow_diff; }
}
}
2006-11-06 21:07:32 +00:00
}
2006-11-12 11:35:14 +00:00
}
2006-11-12 23:16:45 +00:00
if { $pathList eq { } } {
2006-11-12 11:35:14 +00:00
unlock_index
} else {
2006-11-14 06:42:32 +00:00
update_index \
2006-11-18 08:24:20 +00:00
$txt \
2006-11-14 06:42:32 +00:00
$pathList \
2006-11-18 08:03:16 +00:00
[ concat $after { set ui_status_value { Ready to commit.} } ]
2006-11-06 21:07:32 +00:00
}
}
2007-01-21 04:07:04 +00:00
proc do_add_selection { } {
2007-01-21 16:37:58 +00:00
global current_diff_path selected_paths
2006-11-18 08:24:20 +00:00
if { [ array size selected_paths] > 0} {
2007-01-21 04:07:04 +00:00
add_helper \
2007-01-21 00:07:46 +00:00
{ Adding selected files} \
2006-11-18 08:24:20 +00:00
[ array names selected_paths]
2007-01-21 16:37:58 +00:00
} elseif { $current_diff_path ne { } } {
2007-01-21 04:07:04 +00:00
add_helper \
2007-01-21 16:37:58 +00:00
" Adding [short_path $current_diff_path ] " \
[ list $current_diff_path ]
2006-11-18 08:24:20 +00:00
}
}
2007-01-21 04:07:04 +00:00
proc do_add_all { } {
2006-11-18 08:24:20 +00:00
global file_states
2006-11-19 02:33:04 +00:00
set paths [ list]
foreach path [ array names file_states] {
2007-01-21 04:33:34 +00:00
switch -glob -- [ lindex $file_states ( $path ) 0] {
U? { continue }
?M -
?D { lappend paths $path }
2006-11-19 02:33:04 +00:00
}
}
2007-01-21 04:33:34 +00:00
add_helper { Adding all changed files} $paths
2006-11-18 08:24:20 +00:00
}
2006-11-24 02:40:45 +00:00
proc revert_helper { txt paths} {
2007-01-21 16:37:58 +00:00
global file_states current_diff_path
2006-11-24 02:40:45 +00:00
if { ![ lock_index begin-update] } return
set pathList [ list]
set after { }
foreach path $paths {
switch -glob -- [ lindex $file_states ( $path ) 0] {
2007-01-21 04:20:17 +00:00
U? { continue }
?M -
?D {
2006-11-24 02:40:45 +00:00
lappend pathList $path
2007-01-21 16:37:58 +00:00
if { $path eq $current_diff_path } {
2006-11-24 02:40:45 +00:00
set after { reshow_diff; }
}
}
}
}
set n [ llength $pathList ]
if { $n = = 0} {
unlock_index
return
} elseif { $n = = 1} {
set s " [short_path [lindex $pathList ]] "
} else {
set s " these $n files "
}
set reply [ tk_dialog \
.confirm_revert \
2007-01-21 02:48:56 +00:00
"[appname] ([reponame])" \
2007-01-20 23:54:56 +00:00
" Revert changes in $s ?
2006-11-24 02:40:45 +00:00
2007-01-20 23:54:56 +00:00
Any unadded changes will be permanently lost by the revert." \
2006-11-25 17:40:29 +00:00
question \
2006-11-24 02:40:45 +00:00
1 \
{ Do Nothing} \
{ Revert Changes} \
]
if { $reply = = 1} {
checkout_index \
$txt \
$pathList \
[ concat $after { set ui_status_value { Ready.} } ]
} else {
unlock_index
}
}
proc do_revert_selection { } {
2007-01-21 16:37:58 +00:00
global current_diff_path selected_paths
2006-11-24 02:40:45 +00:00
if { [ array size selected_paths] > 0} {
revert_helper \
{ Reverting selected files} \
[ array names selected_paths]
2007-01-21 16:37:58 +00:00
} elseif { $current_diff_path ne { } } {
2006-11-24 02:40:45 +00:00
revert_helper \
2007-01-21 16:37:58 +00:00
" Reverting [short_path $current_diff_path ] " \
[ list $current_diff_path ]
2006-11-24 02:40:45 +00:00
}
}
2006-11-06 21:07:32 +00:00
proc do_signoff { } {
2006-11-19 02:07:05 +00:00
global ui_comm
2006-11-06 21:07:32 +00:00
2006-11-19 02:07:05 +00:00
set me [ committer_ident]
if { $me eq { } } return
2006-11-09 04:05:46 +00:00
2006-11-19 02:07:05 +00:00
set sob " Signed-off-by: $me "
2006-11-12 01:44:03 +00:00
set last [ $ui_comm get { end -1c linestart} { end -1c} ]
2006-11-12 23:16:45 +00:00
if { $last ne $sob } {
2006-11-11 21:16:25 +00:00
$ui_comm edit separator
2006-11-12 23:16:45 +00:00
if { $last ne { }
2006-11-12 01:44:03 +00:00
&& ![ regexp { ^[ A-Z] [ A-Za-z] *-[ A-Za-z-] +: *} $last ] } {
$ui_comm insert end "\n"
}
$ui_comm insert end " \n $sob "
2006-11-11 21:16:25 +00:00
$ui_comm edit separator
2006-11-09 04:05:46 +00:00
$ui_comm see end
2006-11-06 21:07:32 +00:00
}
}
2006-11-19 01:59:49 +00:00
proc do_select_commit_type { } {
global commit_type selected_commit_type
if { $selected_commit_type eq { new}
&& [ string match amend* $commit_type ] } {
create_new_commit
} elseif { $selected_commit_type eq { amend}
&& ![ string match amend* $commit_type ] } {
load_last_commit
# The amend request was rejected...
#
if { ![ string match amend* $commit_type ] } {
2006-11-19 02:33:04 +00:00
set selected_commit_type new
2006-11-19 01:59:49 +00:00
}
}
2006-11-07 02:34:10 +00:00
}
2006-11-07 01:03:36 +00:00
proc do_commit { } {
2006-11-07 01:50:59 +00:00
commit_tree
2006-11-07 01:03:36 +00:00
}
2006-11-21 04:55:51 +00:00
proc do_about { } {
2007-01-21 02:48:56 +00:00
global appvers copyright
2006-11-21 07:46:51 +00:00
global tcl_patchLevel tk_patchLevel
2006-11-21 04:55:51 +00:00
set w .about_dialog
toplevel $w
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2007-01-21 02:48:56 +00:00
label $w .header -text "About [appname]" \
2006-11-21 04:55:51 +00:00
-font font_uibold
pack $w .header -side top -fill x
frame $w .buttons
button $w .buttons.close -text { Close} \
-font font_ui \
2007-03-27 10:31:02 +00:00
-default active \
2006-11-21 04:55:51 +00:00
-command [ list destroy $w ]
pack $w .buttons.close -side right
pack $w .buttons -side bottom -fill x -pady 10 -padx 10
label $w .desc \
2007-02-19 02:08:04 +00:00
-text " git-gui - a graphical user interface for Git.
2006-11-21 07:36:55 +00:00
$copyright " \
2006-11-21 04:55:51 +00:00
-padx 5 -pady 5 \
-justify left \
-anchor w \
-borderwidth 1 \
-relief solid \
-font font_ui
pack $w .desc -side top -fill x -padx 5 -pady 5
2007-01-21 01:04:02 +00:00
set v { }
2007-02-14 05:10:20 +00:00
append v " git-gui version $appvers \n "
2007-02-13 03:48:56 +00:00
append v "[git version]\n"
2007-01-21 01:31:09 +00:00
append v "\n"
2006-11-21 07:46:51 +00:00
if { $tcl_patchLevel eq $tk_patchLevel } {
append v " Tcl/Tk version $tcl_patchLevel "
} else {
append v " Tcl version $tcl_patchLevel "
append v " , Tk version $tk_patchLevel "
}
2006-11-21 04:55:51 +00:00
label $w .vers \
2006-11-21 07:46:51 +00:00
-text $v \
2006-11-21 04:55:51 +00:00
-padx 5 -pady 5 \
-justify left \
-anchor w \
-borderwidth 1 \
-relief solid \
-font font_ui
pack $w .vers -side top -fill x -padx 5 -pady 5
2007-01-21 01:47:31 +00:00
menu $w .ctxm -tearoff 0
$w .ctxm add command \
-label { Copy} \
-font font_ui \
-command "
clipboard clear
clipboard append -format STRING -type STRING -- \[ $w .vers cget -text\]
"
2007-03-27 10:31:02 +00:00
bind $w <Visibility> " grab $w ; focus $w .buttons.close "
2006-11-21 04:55:51 +00:00
bind $w <Key-Escape> " destroy $w "
2007-03-27 10:31:02 +00:00
bind $w <Key-Return> " destroy $w "
2007-01-21 01:47:31 +00:00
bind_button3 $w .vers " tk_popup $w .ctxm %X %Y; grab $w ; focus $w "
2007-01-21 02:48:56 +00:00
wm title $w "About [appname]"
2006-11-21 04:55:51 +00:00
tkwait window $w
}
2006-11-12 08:47:00 +00:00
proc do_options { } {
2007-01-21 02:48:56 +00:00
global repo_config global_config font_descs
2006-11-12 08:47:00 +00:00
global repo_config_new global_config_new
array unset repo_config_new
array unset global_config_new
foreach name [ array names repo_config] {
set repo_config_new( $name ) $repo_config ( $name )
}
2006-11-13 00:20:02 +00:00
load_config 1
foreach name [ array names repo_config] {
switch -- $name {
gui.diffcontext { continue }
}
set repo_config_new( $name ) $repo_config ( $name )
}
2006-11-12 08:47:00 +00:00
foreach name [ array names global_config] {
set global_config_new( $name ) $global_config ( $name )
}
set w .options_editor
toplevel $w
2006-11-12 11:46:26 +00:00
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2006-11-12 08:47:00 +00:00
2007-02-14 05:10:20 +00:00
label $w .header -text "Options" \
2006-11-12 08:47:00 +00:00
-font font_uibold
pack $w .header -side top -fill x
frame $w .buttons
2006-11-12 10:27:00 +00:00
button $w .buttons.restore -text { Restore Defaults} \
-font font_ui \
2007-03-27 10:31:02 +00:00
-default normal \
2006-11-12 10:27:00 +00:00
-command do_restore_defaults
pack $w .buttons.restore -side left
2006-11-12 08:47:00 +00:00
button $w .buttons.save -text Save \
-font font_ui \
2007-03-27 10:31:02 +00:00
-default active \
2007-01-25 21:50:15 +00:00
-command [ list do_save_config $w ]
2006-11-12 08:47:00 +00:00
pack $w .buttons.save -side right
button $w .buttons.cancel -text { Cancel} \
-font font_ui \
2007-03-27 10:31:02 +00:00
-default normal \
2006-11-12 10:27:00 +00:00
-command [ list destroy $w ]
2007-01-21 04:52:19 +00:00
pack $w .buttons.cancel -side right -padx 5
2006-11-12 10:27:00 +00:00
pack $w .buttons -side bottom -fill x -pady 10 -padx 10
2006-11-12 08:47:00 +00:00
2007-01-21 02:48:56 +00:00
labelframe $w .repo -text "[reponame] Repository" \
2007-01-24 22:01:49 +00:00
-font font_ui
2006-11-12 08:47:00 +00:00
labelframe $w .global -text { Global ( All Repositories) } \
2007-01-24 22:01:49 +00:00
-font font_ui
2006-11-12 08:47:00 +00:00
pack $w .repo -side left -fill both -expand 1 -pady 5 -padx 5
pack $w .global -side right -fill both -expand 1 -pady 5 -padx 5
2007-01-26 09:43:43 +00:00
set optid 0
2006-11-12 08:47:00 +00:00
foreach option {
2007-01-29 07:56:07 +00:00
{ t user.name { User Name} }
{ t user.email { Email Address} }
2007-01-27 07:31:01 +00:00
{ b merge.summary { Summarize Merge Commits} }
2007-01-26 09:43:43 +00:00
{ i-1..5 merge.verbosity { Merge Verbosity} }
{ b gui.trustmtime { Trust File Modification Timestamps} }
{ i-1..99 gui.diffcontext { Number of Diff Context Lines} }
{ t gui.newbranchtemplate { New Branch Name Template} }
2006-11-12 08:47:00 +00:00
} {
2006-11-13 00:20:02 +00:00
set type [ lindex $option 0]
set name [ lindex $option 1]
set text [ lindex $option 2]
2007-01-26 09:43:43 +00:00
incr optid
2006-11-12 08:47:00 +00:00
foreach f { repo global} {
2007-01-26 09:43:43 +00:00
switch -glob -- $type {
2006-11-13 00:20:02 +00:00
b {
2007-01-26 09:43:43 +00:00
checkbutton $w .$f .$optid -text $text \
-variable ${ f } _config_new( $name ) \
2006-11-13 00:20:02 +00:00
-onvalue true \
-offvalue false \
-font font_ui
2007-01-26 09:43:43 +00:00
pack $w .$f .$optid -side top -anchor w
2006-11-13 00:20:02 +00:00
}
2007-01-26 09:43:43 +00:00
i-* {
regexp -- { -( \d +) \. \. ( \d +) $} $type _junk min max
frame $w .$f .$optid
label $w .$f .$optid .l -text " $text : " -font font_ui
pack $w .$f .$optid .l -side left -anchor w -fill x
spinbox $w .$f .$optid .v \
-textvariable ${ f } _config_new( $name ) \
-from $min \
-to $max \
-increment 1 \
-width [ expr { 1 + [ string length $max ] } ] \
2006-11-13 00:20:02 +00:00
-font font_ui
2007-01-26 09:43:43 +00:00
bind $w .$f .$optid .v <FocusIn> { %W selection range 0 end}
pack $w .$f .$optid .v -side right -anchor e -padx 5
pack $w .$f .$optid -side top -anchor w -fill x
2007-01-21 21:28:59 +00:00
}
t {
2007-01-26 09:43:43 +00:00
frame $w .$f .$optid
label $w .$f .$optid .l -text " $text : " -font font_ui
entry $w .$f .$optid .v \
2007-01-21 21:28:59 +00:00
-borderwidth 1 \
-relief sunken \
-width 20 \
2007-01-26 09:43:43 +00:00
-textvariable ${ f } _config_new( $name ) \
2007-01-21 21:28:59 +00:00
-font font_ui
2007-01-26 09:43:43 +00:00
pack $w .$f .$optid .l -side left -anchor w
pack $w .$f .$optid .v -side left -anchor w \
2007-01-21 21:28:59 +00:00
-fill x -expand 1 \
-padx 5
2007-01-26 09:43:43 +00:00
pack $w .$f .$optid -side top -anchor w -fill x
2006-11-13 00:20:02 +00:00
}
}
2006-11-12 08:47:00 +00:00
}
}
2006-11-12 10:27:00 +00:00
set all_fonts [ lsort [ font families] ]
foreach option $font_descs {
set name [ lindex $option 0]
set font [ lindex $option 1]
set text [ lindex $option 2]
set global_config_new( gui.$font ^^family) \
[ font configure $font -family]
set global_config_new( gui.$font ^^size) \
[ font configure $font -size]
frame $w .global.$name
label $w .global.$name .l -text " $text : " -font font_ui
pack $w .global.$name .l -side left -anchor w -fill x
2007-03-27 10:29:08 +00:00
set fontmenu [ eval tk_optionMenu $w .global.$name .family \
2006-11-12 10:27:00 +00:00
global_config_new( gui.$font ^^family) \
2007-03-27 10:29:08 +00:00
$all_fonts ]
$w .global.$name .family configure -font font_ui
$fontmenu configure -font font_ui
2006-11-12 10:27:00 +00:00
spinbox $w .global.$name .size \
-textvariable global_config_new( gui.$font ^^size) \
-from 2 -to 80 -increment 1 \
-width 3 \
-font font_ui
2007-01-21 21:43:14 +00:00
bind $w .global.$name .size <FocusIn> { %W selection range 0 end}
2006-11-12 10:27:00 +00:00
pack $w .global.$name .size -side right -anchor e
pack $w .global.$name .family -side right -anchor e
pack $w .global.$name -side top -anchor w -fill x
}
2007-03-27 10:31:02 +00:00
bind $w <Visibility> " grab $w ; focus $w .buttons.save "
2006-11-12 08:47:00 +00:00
bind $w <Key-Escape> " destroy $w "
2007-01-21 02:48:56 +00:00
wm title $w "[appname] ([reponame]): Options"
2006-11-12 08:47:00 +00:00
tkwait window $w
}
2006-11-12 10:27:00 +00:00
proc do_restore_defaults { } {
2006-11-12 20:45:35 +00:00
global font_descs default_config repo_config
2006-11-12 10:27:00 +00:00
global repo_config_new global_config_new
foreach name [ array names default_config] {
set repo_config_new( $name ) $default_config ( $name )
set global_config_new( $name ) $default_config ( $name )
}
foreach option $font_descs {
set name [ lindex $option 0]
2006-11-12 20:45:35 +00:00
set repo_config( gui.$name ) $default_config ( gui.$name )
2006-11-12 10:27:00 +00:00
}
apply_config
foreach option $font_descs {
set name [ lindex $option 0]
set font [ lindex $option 1]
set global_config_new( gui.$font ^^family) \
[ font configure $font -family]
set global_config_new( gui.$font ^^size) \
[ font configure $font -size]
}
}
proc do_save_config { w} {
if { [ catch { save_config} err] } {
error_popup " Failed to completely save options:\n\n $err "
}
2006-11-13 00:20:02 +00:00
reshow_diff
2006-11-12 10:27:00 +00:00
destroy $w
}
2006-11-16 03:35:26 +00:00
proc do_windows_shortcut { } {
2007-01-21 02:48:56 +00:00
global argv0
2006-11-16 03:35:26 +00:00
2007-01-29 01:58:47 +00:00
set fn [ tk_getSaveFile \
-parent . \
-title "[appname] ([reponame]): Create Desktop Icon" \
-initialfile "Git [reponame].bat" ]
if { $fn != { } } {
if { [ catch {
set fd [ open $fn w]
puts $fd "@ECHO Entering [reponame]"
puts $fd "@ECHO Starting git-gui... please wait..."
puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
puts -nonewline $fd "@\"[info nameofexecutable]\""
puts $fd " \"[file normalize $argv0 ]\" "
close $fd
} err] } {
error_popup " Cannot write script:\n\n $err "
}
}
}
proc do_cygwin_shortcut { } {
global argv0
2006-11-16 03:35:26 +00:00
if { [ catch {
set desktop [ exec cygpath \
--windows \
--absolute \
--long-name \
--desktop]
} ] } {
set desktop .
}
set fn [ tk_getSaveFile \
-parent . \
2007-01-21 02:48:56 +00:00
-title "[appname] ([reponame]): Create Desktop Icon" \
2006-11-16 03:35:26 +00:00
-initialdir $desktop \
2007-01-21 02:48:56 +00:00
-initialfile "Git [reponame].bat" ]
2006-11-16 03:35:26 +00:00
if { $fn != { } } {
if { [ catch {
set fd [ open $fn w]
set sh [ exec cygpath \
--windows \
--absolute \
/bin/sh]
set me [ exec cygpath \
--unix \
--absolute \
$argv0 ]
set gd [ exec cygpath \
--unix \
--absolute \
2007-01-21 02:48:56 +00:00
[ gitdir] ]
2007-01-21 03:00:28 +00:00
set gw [ exec cygpath \
--windows \
--absolute \
[ file dirname [ gitdir] ] ]
2006-11-16 03:53:53 +00:00
regsub -all ' $me "' \\ '' " me
regsub -all ' $gd "' \\ '' " gd
2007-01-21 03:00:28 +00:00
puts $fd " @ECHO Entering $gw "
puts $fd "@ECHO Starting git-gui... please wait..."
2007-01-21 00:45:26 +00:00
puts -nonewline $fd " @\" $sh \" --login -c \" "
2006-11-16 03:45:33 +00:00
puts -nonewline $fd " GIT_DIR=' $gd ' "
puts -nonewline $fd " ' $me ' "
2006-11-16 03:35:26 +00:00
puts $fd "&\""
close $fd
} err] } {
error_popup " Cannot write script:\n\n $err "
}
}
}
2006-11-18 05:31:00 +00:00
proc do_macosx_app { } {
2007-01-21 02:48:56 +00:00
global argv0 env
2006-11-18 05:31:00 +00:00
set fn [ tk_getSaveFile \
-parent . \
2007-01-21 02:48:56 +00:00
-title "[appname] ([reponame]): Create Desktop Icon" \
2006-11-18 05:31:00 +00:00
-initialdir [ file join $env ( HOME) Desktop] \
2007-01-21 02:48:56 +00:00
-initialfile "Git [reponame].app" ]
2006-11-18 05:31:00 +00:00
if { $fn != { } } {
if { [ catch {
set Contents [ file join $fn Contents]
set MacOS [ file join $Contents MacOS]
set exe [ file join $MacOS git-gui]
file mkdir $MacOS
set fd [ open [ file join $Contents Info.plist] w]
puts $fd { <?xml version = "1.0" encoding = "UTF-8" ?>
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd" >
<plist version = "1.0" >
<dict>
<key>CFBundleDevelopmentRegion</key>
<string>English</string>
<key>CFBundleExecutable</key>
<string>git-gui</string>
<key>CFBundleIdentifier</key>
<string>org.spearce.git-gui</string>
<key>CFBundleInfoDictionaryVersion</key>
<string>6.0</string>
<key>CFBundlePackageType</key>
<string>APPL</string>
<key>CFBundleSignature</key>
<string>????</string>
<key>CFBundleVersion</key>
<string>1.0</string>
<key>NSPrincipalClass</key>
<string>NSApplication</string>
</dict>
</plist>}
close $fd
set fd [ open $exe w]
2007-01-21 02:48:56 +00:00
set gd [ file normalize [ gitdir] ]
2007-01-29 01:58:47 +00:00
set ep [ file normalize [ gitexec] ]
2006-11-18 05:31:00 +00:00
regsub -all ' $gd "' \\ '' " gd
regsub -all ' $ep "' \\ '' " ep
puts $fd "#!/bin/sh"
foreach name [ array names env] {
if { [ string match GIT_* $name ] } {
regsub -all ' $env($name) "' \\ '' " v
puts $fd " export $name =' $v ' "
}
}
puts $fd " export PATH=' $ep ':\$PATH "
puts $fd " export GIT_DIR=' $gd ' "
puts $fd " exec [file normalize $argv0 ] "
close $fd
file attributes $exe -permissions u+x,g+x,o+x
} err] } {
error_popup " Cannot write icon:\n\n $err "
}
}
}
2006-11-13 21:06:38 +00:00
proc toggle_or_diff { w x y} {
2007-01-21 16:37:58 +00:00
global file_states file_lists current_diff_path ui_index ui_workdir
2006-11-13 21:06:38 +00:00
global last_clicked selected_paths
2006-11-06 21:07:32 +00:00
2006-11-06 19:20:27 +00:00
set pos [ split [ $w index @$x ,$y ] .]
set lno [ lindex $pos 0]
set col [ lindex $pos 1]
2006-11-13 21:06:38 +00:00
set path [ lindex $file_lists ( $w ) [ expr { $lno - 1} ] ]
if { $path eq { } } {
set last_clicked { }
return
}
set last_clicked [ list $w $lno ]
array unset selected_paths
$ui_index tag remove in_sel 0.0 end
2007-01-21 03:06:51 +00:00
$ui_workdir tag remove in_sel 0.0 end
2006-11-06 19:20:27 +00:00
2006-11-13 21:06:38 +00:00
if { $col = = 0} {
2007-01-21 16:37:58 +00:00
if { $current_diff_path eq $path } {
2006-11-18 08:03:16 +00:00
set after { reshow_diff; }
} else {
set after { }
}
2007-01-21 04:10:30 +00:00
if { $w eq $ui_index } {
2006-11-19 05:37:49 +00:00
update_indexinfo \
2007-01-21 04:07:04 +00:00
" Unstaging [short_path $path ] from commit " \
2006-11-19 05:37:49 +00:00
[ list $path ] \
[ concat $after { set ui_status_value { Ready.} } ]
2007-01-21 04:10:30 +00:00
} elseif { $w eq $ui_workdir } {
2006-11-19 05:37:49 +00:00
update_index \
2007-01-21 00:07:46 +00:00
" Adding [short_path $path ] " \
2006-11-19 05:37:49 +00:00
[ list $path ] \
[ concat $after { set ui_status_value { Ready.} } ]
}
2006-11-13 21:06:38 +00:00
} else {
2006-11-11 22:52:16 +00:00
show_diff $path $w $lno
2006-11-06 19:20:27 +00:00
}
}
2006-11-13 21:06:38 +00:00
proc add_one_to_selection { w x y} {
2007-01-21 04:46:53 +00:00
global file_lists last_clicked selected_paths
2006-11-11 23:38:00 +00:00
2007-01-21 04:46:53 +00:00
set lno [ lindex [ split [ $w index @$x ,$y ] .] 0]
2006-11-13 21:06:38 +00:00
set path [ lindex $file_lists ( $w ) [ expr { $lno - 1} ] ]
if { $path eq { } } {
set last_clicked { }
return
}
2006-11-06 19:20:27 +00:00
2007-01-21 04:46:53 +00:00
if { $last_clicked ne { }
&& [ lindex $last_clicked 0] ne $w } {
array unset selected_paths
[ lindex $last_clicked 0] tag remove in_sel 0.0 end
}
2006-11-13 21:06:38 +00:00
set last_clicked [ list $w $lno ]
if { [ catch { set in_sel $selected_paths ( $path ) } ] } {
set in_sel 0
}
if { $in_sel } {
unset selected_paths( $path )
$w tag remove in_sel $lno .0 [ expr { $lno + 1} ] .0
} else {
set selected_paths( $path ) 1
$w tag add in_sel $lno .0 [ expr { $lno + 1} ] .0
}
}
proc add_range_to_selection { w x y} {
2007-01-21 04:46:53 +00:00
global file_lists last_clicked selected_paths
2006-11-13 21:06:38 +00:00
if { [ lindex $last_clicked 0] ne $w } {
toggle_or_diff $w $x $y
return
2006-11-06 19:20:27 +00:00
}
2006-11-13 21:06:38 +00:00
2007-01-21 04:46:53 +00:00
set lno [ lindex [ split [ $w index @$x ,$y ] .] 0]
2006-11-13 21:06:38 +00:00
set lc [ lindex $last_clicked 1]
if { $lc < $lno } {
set begin $lc
set end $lno
} else {
set begin $lno
set end $lc
}
foreach path [ lrange $file_lists ( $w ) \
[ expr { $begin - 1} ] \
[ expr { $end - 1} ] ] {
set selected_paths( $path ) 1
}
$w tag add in_sel $begin .0 [ expr { $end + 1} ] .0
2006-11-06 19:20:27 +00:00
}
######################################################################
##
2006-11-12 10:27:00 +00:00
## config defaults
2006-11-06 19:20:27 +00:00
2006-11-12 07:30:02 +00:00
set cursor_ptr arrow
2006-11-12 05:40:38 +00:00
font create font_diff -family Courier -size 10
font create font_ui
catch {
label .dummy
eval font configure font_ui [ font actual [ .dummy cget -font] ]
destroy .dummy
}
2006-11-12 10:27:00 +00:00
font create font_uibold
font create font_diffbold
2006-11-06 19:20:27 +00:00
2006-11-21 16:57:41 +00:00
if { [ is_Windows] } {
2006-11-12 07:22:21 +00:00
set M1B Control
set M1T Ctrl
} elseif { [ is_MacOSX] } {
set M1B M1
set M1T Cmd
2006-11-22 01:21:11 +00:00
} else {
set M1B M1
set M1T M1
2006-11-07 00:12:58 +00:00
}
2006-11-12 10:27:00 +00:00
proc apply_config { } {
global repo_config font_descs
foreach option $font_descs {
set name [ lindex $option 0]
set font [ lindex $option 1]
if { [ catch {
foreach { cn cv} $repo_config ( gui.$name ) {
font configure $font $cn $cv
}
} err] } {
error_popup " Invalid font specified in gui. $name :\n\n $err "
}
foreach { cn cv} [ font configure $font ] {
font configure ${ font } bold $cn $cv
}
font configure ${ font } bold -weight bold
}
}
2007-01-27 07:31:01 +00:00
set default_config( merge.summary) false
2007-01-26 09:43:43 +00:00
set default_config( merge.verbosity) 2
2007-01-29 07:56:07 +00:00
set default_config( user.name) { }
set default_config( user.email) { }
2006-11-12 10:27:00 +00:00
set default_config( gui.trustmtime) false
2006-11-13 00:20:02 +00:00
set default_config( gui.diffcontext) 5
2007-01-21 21:28:59 +00:00
set default_config( gui.newbranchtemplate) { }
2006-11-12 10:27:00 +00:00
set default_config( gui.fontui) [ font configure font_ui]
set default_config( gui.fontdiff) [ font configure font_diff]
set font_descs {
{ fontui font_ui { Main Font} }
{ fontdiff font_diff { Diff/Console Font} }
}
2006-11-12 21:24:52 +00:00
load_config 0
2006-11-12 10:27:00 +00:00
apply_config
2007-02-09 00:10:52 +00:00
######################################################################
##
## feature option selection
2007-02-09 00:41:32 +00:00
if { [ regexp { ^git-( .+) $} [ appname] _junk subcommand] } {
unset _junk
} else {
set subcommand gui
}
if { $subcommand eq { gui.sh} } {
set subcommand gui
}
if { $subcommand eq { gui} && [ llength $argv ] > 0} {
set subcommand [ lindex $argv 0]
set argv [ lrange $argv 1 end]
}
2007-02-09 00:10:52 +00:00
enable_option multicommit
enable_option branch
enable_option transport
2007-02-09 00:41:32 +00:00
switch -- $subcommand {
2007-02-16 05:24:03 +00:00
browser -
2007-02-09 00:41:32 +00:00
blame {
2007-02-09 00:10:52 +00:00
disable_option multicommit
disable_option branch
disable_option transport
}
2007-02-09 00:41:32 +00:00
citool {
enable_option singlecommit
2007-02-09 00:10:52 +00:00
disable_option multicommit
disable_option branch
disable_option transport
}
}
2006-11-12 10:27:00 +00:00
######################################################################
##
## ui construction
2007-02-09 00:10:52 +00:00
set ui_comm { }
2006-11-06 19:20:27 +00:00
# -- Menu Bar
2006-11-18 08:27:23 +00:00
#
2006-11-12 05:40:38 +00:00
menu .mbar -tearoff 0
2007-03-27 10:29:08 +00:00
.mbar add cascade -label Repository -menu .mbar.repository -font font_ui
.mbar add cascade -label Edit -menu .mbar.edit -font font_ui
2007-02-08 23:10:05 +00:00
if { [ is_enabled branch] } {
2007-03-27 10:29:08 +00:00
.mbar add cascade -label Branch -menu .mbar.branch -font font_ui
2006-11-24 22:30:12 +00:00
}
2007-02-09 00:10:52 +00:00
if { [ is_enabled multicommit] || [ is_enabled singlecommit] } {
2007-03-27 10:29:08 +00:00
.mbar add cascade -label Commit -menu .mbar.commit -font font_ui
2007-02-09 00:10:52 +00:00
}
2007-02-08 23:10:05 +00:00
if { [ is_enabled transport] } {
2007-03-27 10:29:08 +00:00
.mbar add cascade -label Merge -menu .mbar.merge -font font_ui
.mbar add cascade -label Fetch -menu .mbar.fetch -font font_ui
.mbar add cascade -label Push -menu .mbar.push -font font_ui
2006-11-12 21:20:36 +00:00
}
2006-11-06 19:20:27 +00:00
. configure -menu .mbar
2006-11-21 04:01:47 +00:00
# -- Repository Menu
2006-11-18 08:27:23 +00:00
#
2006-11-21 04:01:47 +00:00
menu .mbar.repository
2007-01-29 05:50:41 +00:00
.mbar.repository add command \
-label { Browse Current Branch} \
2007-01-29 07:52:06 +00:00
-command { new_browser $current_branch } \
2007-01-29 05:50:41 +00:00
-font font_ui
2007-02-09 00:10:52 +00:00
trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
2007-01-29 05:50:41 +00:00
.mbar.repository add separator
2006-11-22 01:33:09 +00:00
.mbar.repository add command \
-label { Visualize Current Branch} \
2007-02-09 00:10:52 +00:00
-command { do_gitk $current_branch } \
2006-11-12 05:40:38 +00:00
-font font_ui
2007-02-09 00:10:52 +00:00
trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
2007-01-25 18:01:16 +00:00
.mbar.repository add command \
-label { Visualize All Branches} \
2007-02-09 00:10:52 +00:00
-command { do_gitk --all} \
2007-01-25 18:01:16 +00:00
-font font_ui
2006-11-22 01:33:09 +00:00
.mbar.repository add separator
2006-11-21 03:22:10 +00:00
2007-02-08 23:03:41 +00:00
if { [ is_enabled multicommit] } {
2007-01-24 20:21:01 +00:00
.mbar.repository add command -label { Database Statistics} \
-command do_stats \
-font font_ui
2007-01-20 23:38:12 +00:00
.mbar.repository add command -label { Compress Database} \
-command do_gc \
2006-11-12 21:20:36 +00:00
-font font_ui
2006-11-16 03:35:26 +00:00
2006-11-21 04:01:47 +00:00
.mbar.repository add command -label { Verify Database} \
2006-11-21 02:43:41 +00:00
-command do_fsck_objects \
-font font_ui
2006-11-21 04:01:47 +00:00
.mbar.repository add separator
2006-11-21 03:22:10 +00:00
2007-01-29 01:58:47 +00:00
if { [ is_Cygwin] } {
.mbar.repository add command \
-label { Create Desktop Icon} \
-command do_cygwin_shortcut \
-font font_ui
} elseif { [ is_Windows] } {
2006-11-21 04:01:47 +00:00
.mbar.repository add command \
2006-11-16 03:35:26 +00:00
-label { Create Desktop Icon} \
-command do_windows_shortcut \
-font font_ui
2006-11-18 05:31:00 +00:00
} elseif { [ is_MacOSX] } {
2006-11-21 04:01:47 +00:00
.mbar.repository add command \
2006-11-18 05:31:00 +00:00
-label { Create Desktop Icon} \
-command do_macosx_app \
-font font_ui
2006-11-16 03:35:26 +00:00
}
2006-11-12 21:20:36 +00:00
}
2006-11-25 08:38:39 +00:00
2006-11-21 04:01:47 +00:00
.mbar.repository add command -label Quit \
2006-11-06 19:20:27 +00:00
-command do_quit \
2006-11-07 00:12:58 +00:00
-accelerator $M1T -Q \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-06 19:20:27 +00:00
2006-11-11 20:51:41 +00:00
# -- Edit Menu
#
menu .mbar.edit
.mbar.edit add command -label Undo \
-command { catch { [ focus] edit undo} } \
-accelerator $M1T -Z \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-11 20:51:41 +00:00
.mbar.edit add command -label Redo \
-command { catch { [ focus] edit redo} } \
-accelerator $M1T -Y \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-11 20:51:41 +00:00
.mbar.edit add separator
.mbar.edit add command -label Cut \
-command { catch { tk_textCut [ focus] } } \
-accelerator $M1T -X \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-11 20:51:41 +00:00
.mbar.edit add command -label Copy \
-command { catch { tk_textCopy [ focus] } } \
-accelerator $M1T -C \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-11 20:51:41 +00:00
.mbar.edit add command -label Paste \
-command { catch { tk_textPaste [ focus] ; [ focus] see insert} } \
-accelerator $M1T -V \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-11 20:51:41 +00:00
.mbar.edit add command -label Delete \
-command { catch { [ focus] delete sel.first sel.last} } \
-accelerator Del \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-11 20:51:41 +00:00
.mbar.edit add separator
.mbar.edit add command -label { Select All} \
-command { catch { [ focus] tag add sel 0.0 end} } \
-accelerator $M1T -A \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-11 20:51:41 +00:00
2006-11-25 08:38:39 +00:00
# -- Branch Menu
#
2007-02-08 23:10:05 +00:00
if { [ is_enabled branch] } {
2006-11-24 22:30:12 +00:00
menu .mbar.branch
.mbar.branch add command -label { Create...} \
-command do_create_branch \
2007-01-21 06:34:55 +00:00
-accelerator $M1T -N \
2006-11-24 22:30:12 +00:00
-font font_ui
lappend disable_on_lock [ list .mbar.branch entryconf \
[ .mbar.branch index last] -state]
.mbar.branch add command -label { Delete...} \
-command do_delete_branch \
-font font_ui
lappend disable_on_lock [ list .mbar.branch entryconf \
[ .mbar.branch index last] -state]
2007-02-26 16:22:10 +00:00
.mbar.branch add command -label { Reset...} \
-command do_reset_hard \
-font font_ui
lappend disable_on_lock [ list .mbar.branch entryconf \
[ .mbar.branch index last] -state]
2006-11-24 22:30:12 +00:00
}
2006-11-06 19:20:27 +00:00
# -- Commit Menu
2006-11-18 08:27:23 +00:00
#
2007-02-09 00:10:52 +00:00
if { [ is_enabled multicommit] || [ is_enabled singlecommit] } {
menu .mbar.commit
.mbar.commit add radiobutton \
-label { New Commit} \
-command do_select_commit_type \
-variable selected_commit_type \
-value new \
-font font_ui
lappend disable_on_lock \
[ list .mbar.commit entryconf [ .mbar.commit index last] -state]
2006-11-19 01:59:49 +00:00
2007-02-09 00:10:52 +00:00
.mbar.commit add radiobutton \
-label { Amend Last Commit} \
-command do_select_commit_type \
-variable selected_commit_type \
-value amend \
-font font_ui
lappend disable_on_lock \
[ list .mbar.commit entryconf [ .mbar.commit index last] -state]
2006-11-19 01:59:49 +00:00
2007-02-09 00:10:52 +00:00
.mbar.commit add separator
2006-11-19 01:59:49 +00:00
2007-02-09 00:10:52 +00:00
.mbar.commit add command -label Rescan \
-command do_rescan \
-accelerator F5 \
-font font_ui
lappend disable_on_lock \
[ list .mbar.commit entryconf [ .mbar.commit index last] -state]
2006-11-19 01:59:49 +00:00
2007-02-09 00:10:52 +00:00
.mbar.commit add command -label { Add To Commit} \
-command do_add_selection \
-font font_ui
lappend disable_on_lock \
[ list .mbar.commit entryconf [ .mbar.commit index last] -state]
2006-11-19 01:59:49 +00:00
2007-02-09 00:44:49 +00:00
.mbar.commit add command -label { Add Existing To Commit} \
2007-02-09 00:10:52 +00:00
-command do_add_all \
-accelerator $M1T -I \
-font font_ui
lappend disable_on_lock \
[ list .mbar.commit entryconf [ .mbar.commit index last] -state]
2006-11-19 01:59:49 +00:00
2007-02-09 00:10:52 +00:00
.mbar.commit add command -label { Unstage From Commit} \
-command do_unstage_selection \
-font font_ui
lappend disable_on_lock \
[ list .mbar.commit entryconf [ .mbar.commit index last] -state]
2006-11-24 02:40:45 +00:00
2007-02-09 00:10:52 +00:00
.mbar.commit add command -label { Revert Changes} \
-command do_revert_selection \
-font font_ui
lappend disable_on_lock \
[ list .mbar.commit entryconf [ .mbar.commit index last] -state]
2006-11-24 02:40:45 +00:00
2007-02-09 00:10:52 +00:00
.mbar.commit add separator
2006-11-19 05:29:55 +00:00
2007-02-09 00:10:52 +00:00
.mbar.commit add command -label { Sign Off} \
-command do_signoff \
-accelerator $M1T -S \
-font font_ui
2006-11-19 01:59:49 +00:00
2007-02-09 00:10:52 +00:00
.mbar.commit add command -label Commit \
-command do_commit \
-accelerator $M1T -Return \
-font font_ui
lappend disable_on_lock \
[ list .mbar.commit entryconf [ .mbar.commit index last] -state]
}
2006-11-06 19:20:27 +00:00
2007-02-26 16:17:11 +00:00
# -- Merge Menu
#
if { [ is_enabled branch] } {
menu .mbar.merge
.mbar.merge add command -label { Local Merge...} \
-command do_local_merge \
-font font_ui
lappend disable_on_lock \
[ list .mbar.merge entryconf [ .mbar.merge index last] -state]
.mbar.merge add command -label { Abort Merge...} \
-command do_reset_hard \
-font font_ui
lappend disable_on_lock \
[ list .mbar.merge entryconf [ .mbar.merge index last] -state]
}
# -- Transport Menu
#
if { [ is_enabled transport] } {
menu .mbar.fetch
menu .mbar.push
.mbar.push add command -label { Push...} \
-command do_push_anywhere \
-font font_ui
}
2006-11-21 07:33:56 +00:00
if { [ is_MacOSX] } {
# -- Apple Menu (Mac OS X only)
#
.mbar add cascade -label Apple -menu .mbar.apple
menu .mbar.apple
2007-01-21 02:48:56 +00:00
.mbar.apple add command -label "About [appname]" \
2006-11-21 07:33:56 +00:00
-command do_about \
-font font_ui
2007-02-14 05:10:20 +00:00
.mbar.apple add command -label "Options..." \
2006-11-21 07:33:56 +00:00
-command do_options \
-font font_ui
} else {
# -- Edit Menu
#
.mbar.edit add separator
.mbar.edit add command -label { Options...} \
-command do_options \
-font font_ui
2006-12-08 03:07:38 +00:00
# -- Tools Menu
#
2007-01-21 01:53:37 +00:00
if { [ file exists /usr/local/miga/lib/gui-miga]
&& [ file exists .pvcsrc] } {
2006-12-08 03:07:38 +00:00
proc do_miga { } {
2007-01-21 02:48:56 +00:00
global ui_status_value
2006-12-08 03:07:38 +00:00
if { ![ lock_index update] } return
set cmd [ list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\"" ]
set miga_fd [ open " | $cmd " r]
fconfigure $miga_fd -blocking 0
fileevent $miga_fd readable [ list miga_done $miga_fd ]
set ui_status_value { Running miga...}
}
proc miga_done { fd} {
read $fd 512
if { [ eof $fd ] } {
close $fd
unlock_index
rescan [ list set ui_status_value { Ready.} ]
}
}
.mbar add cascade -label Tools -menu .mbar.tools
menu .mbar.tools
.mbar.tools add command -label "Migrate" \
-command do_miga \
-font font_ui
lappend disable_on_lock \
[ list .mbar.tools entryconf [ .mbar.tools index last] -state]
}
2007-01-29 01:00:36 +00:00
}
2006-12-08 03:07:38 +00:00
2007-01-29 01:00:36 +00:00
# -- Help Menu
#
2007-03-27 10:29:08 +00:00
.mbar add cascade -label Help -menu .mbar.help -font font_ui
2007-01-29 01:00:36 +00:00
menu .mbar.help
2006-11-21 07:33:56 +00:00
2007-01-29 01:00:36 +00:00
if { ![ is_MacOSX] } {
2007-01-21 02:48:56 +00:00
.mbar.help add command -label "About [appname]" \
2006-11-21 07:33:56 +00:00
-command do_about \
-font font_ui
}
2006-11-21 04:55:51 +00:00
2007-01-29 01:00:36 +00:00
set browser { }
catch { set browser $repo_config ( instaweb.browser) }
2007-01-29 01:58:47 +00:00
set doc_path [ file dirname [ gitexec] ]
2007-01-29 01:00:36 +00:00
set doc_path [ file join $doc_path Documentation index.html]
2007-01-29 01:58:47 +00:00
if { [ is_Cygwin] } {
2007-02-19 00:06:09 +00:00
set doc_path [ exec cygpath --mixed $doc_path ]
2007-01-29 01:00:36 +00:00
}
if { $browser eq { } } {
if { [ is_MacOSX] } {
set browser open
2007-01-29 01:58:47 +00:00
} elseif { [ is_Cygwin] } {
2007-01-29 01:00:36 +00:00
set program_files [ file dirname [ exec cygpath --windir] ]
set program_files [ file join $program_files { Program Files} ]
set firefox [ file join $program_files { Mozilla Firefox} firefox.exe]
set ie [ file join $program_files { Internet Explorer} IEXPLORE.EXE]
if { [ file exists $firefox ] } {
set browser $firefox
} elseif { [ file exists $ie ] } {
set browser $ie
}
unset program_files firefox ie
}
}
if { [ file isfile $doc_path ] } {
set doc_url " file: $doc_path "
} else {
set doc_url { http://www.kernel.org/pub/software/scm/git/docs/}
}
if { $browser ne { } } {
.mbar.help add command -label { Online Documentation} \
-command [ list exec $browser $doc_url & ] \
-font font_ui
}
unset browser doc_path doc_url
2006-11-21 04:55:51 +00:00
2007-02-09 00:10:52 +00:00
# -- Standard bindings
#
bind . <Destroy> do_quit
bind all <$M1B -Key-q> do_quit
bind all <$M1B -Key-Q> do_quit
bind all <$M1B -Key-w> { destroy [ winfo toplevel %W] }
bind all <$M1B -Key-W> { destroy [ winfo toplevel %W] }
# -- Not a normal commit type invocation? Do that instead!
#
2007-02-09 00:41:32 +00:00
switch -- $subcommand {
2007-02-16 05:24:03 +00:00
browser {
if { [ llength $argv ] != 1} {
puts stderr " usage: $argv0 browser commit "
exit 1
}
set current_branch [ lindex $argv 0]
new_browser $current_branch
return
}
2007-02-09 00:10:52 +00:00
blame {
2007-02-09 00:41:32 +00:00
if { [ llength $argv ] != 2} {
2007-02-09 00:10:52 +00:00
puts stderr " usage: $argv0 blame commit path "
exit 1
}
2007-02-09 00:41:32 +00:00
set current_branch [ lindex $argv 0]
show_blame $current_branch [ lindex $argv 1]
return
}
citool -
gui {
if { [ llength $argv ] != 0} {
puts -nonewline stderr " usage: $argv0 "
if { $subcommand ne { gui} && [ appname] ne " git- $subcommand " } {
puts -nonewline stderr " $subcommand "
}
puts stderr { }
exit 1
}
# fall through to setup UI for commits
2007-02-09 00:10:52 +00:00
}
default {
2007-02-21 06:24:57 +00:00
puts stderr " usage: $argv0 \[{blame|browser|citool}\] "
2007-02-09 00:10:52 +00:00
exit 1
}
}
2006-11-24 20:38:18 +00:00
# -- Branch Control
#
frame .branch \
-borderwidth 1 \
-relief sunken
label .branch.l1 \
-text { Current Branch:} \
-anchor w \
-justify left \
-font font_ui
label .branch.cb \
-textvariable current_branch \
-anchor w \
-justify left \
-font font_ui
pack .branch.l1 -side left
pack .branch.cb -side left -fill x
pack .branch -side top -fill x
2006-11-06 19:20:27 +00:00
# -- Main Window Layout
2006-11-18 08:27:23 +00:00
#
2006-11-06 19:20:27 +00:00
panedwindow .vpane -orient vertical
panedwindow .vpane.files -orient horizontal
2007-01-21 22:50:42 +00:00
.vpane add .vpane.files -sticky nsew -height 100 -width 200
2006-11-06 19:20:27 +00:00
pack .vpane -anchor n -side top -fill both -expand 1
# -- Index File List
2006-11-18 08:27:23 +00:00
#
2007-01-21 22:50:42 +00:00
frame .vpane.files.index -height 100 -width 200
2007-01-21 03:45:19 +00:00
label .vpane.files.index.title -text { Changes To Be Committed} \
2006-11-06 19:20:27 +00:00
-background green \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-06 19:20:27 +00:00
text $ui_index -background white -borderwidth 0 \
2007-01-21 22:50:42 +00:00
-width 20 -height 10 \
2007-01-21 19:58:01 +00:00
-wrap none \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-12 01:33:30 +00:00
-cursor $cursor_ptr \
2007-01-21 19:58:01 +00:00
-xscrollcommand { .vpane.files.index.sx set} \
-yscrollcommand { .vpane.files.index.sy set} \
2006-11-06 19:20:27 +00:00
-state disabled
2007-01-21 19:58:01 +00:00
scrollbar .vpane.files.index.sx -orient h -command [ list $ui_index xview]
scrollbar .vpane.files.index.sy -orient v -command [ list $ui_index yview]
2006-11-06 19:20:27 +00:00
pack .vpane.files.index.title -side top -fill x
2007-01-21 19:58:01 +00:00
pack .vpane.files.index.sx -side bottom -fill x
pack .vpane.files.index.sy -side right -fill y
2006-11-06 19:20:27 +00:00
pack $ui_index -side left -fill both -expand 1
.vpane.files add .vpane.files.index -sticky nsew
2007-01-21 03:06:51 +00:00
# -- Working Directory File List
2006-11-18 08:27:23 +00:00
#
2007-01-21 22:50:42 +00:00
frame .vpane.files.workdir -height 100 -width 200
2007-01-21 03:45:19 +00:00
label .vpane.files.workdir.title -text { Changed But Not Updated} \
2006-11-06 19:20:27 +00:00
-background red \
2006-11-12 05:40:38 +00:00
-font font_ui
2007-01-21 03:06:51 +00:00
text $ui_workdir -background white -borderwidth 0 \
2007-01-21 22:50:42 +00:00
-width 20 -height 10 \
2007-01-21 19:58:01 +00:00
-wrap none \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-12 01:33:30 +00:00
-cursor $cursor_ptr \
2007-01-21 19:58:01 +00:00
-xscrollcommand { .vpane.files.workdir.sx set} \
-yscrollcommand { .vpane.files.workdir.sy set} \
2006-11-06 19:20:27 +00:00
-state disabled
2007-01-21 19:58:01 +00:00
scrollbar .vpane.files.workdir.sx -orient h -command [ list $ui_workdir xview]
scrollbar .vpane.files.workdir.sy -orient v -command [ list $ui_workdir yview]
2007-01-21 03:06:51 +00:00
pack .vpane.files.workdir.title -side top -fill x
2007-01-21 19:58:01 +00:00
pack .vpane.files.workdir.sx -side bottom -fill x
pack .vpane.files.workdir.sy -side right -fill y
2007-01-21 03:06:51 +00:00
pack $ui_workdir -side left -fill both -expand 1
.vpane.files add .vpane.files.workdir -sticky nsew
2006-11-06 19:20:27 +00:00
2007-01-21 03:06:51 +00:00
foreach i [ list $ui_index $ui_workdir ] {
2006-11-13 21:06:38 +00:00
$i tag conf in_diff -font font_uibold
$i tag conf in_sel \
-background [ $i cget -foreground] \
-foreground [ $i cget -background]
}
unset i
2006-11-06 21:07:32 +00:00
2006-11-08 01:27:46 +00:00
# -- Diff and Commit Area
2006-11-18 08:27:23 +00:00
#
2006-11-12 11:53:56 +00:00
frame .vpane.lower -height 300 -width 400
2006-11-08 01:27:46 +00:00
frame .vpane.lower.commarea
frame .vpane.lower.diff -relief sunken -borderwidth 1
pack .vpane.lower.commarea -side top -fill x
pack .vpane.lower.diff -side bottom -fill both -expand 1
2007-01-24 20:21:01 +00:00
.vpane add .vpane.lower -sticky nsew
2006-11-06 19:20:27 +00:00
# -- Commit Area Buttons
2006-11-18 08:27:23 +00:00
#
2006-11-08 01:27:46 +00:00
frame .vpane.lower.commarea.buttons
label .vpane.lower.commarea.buttons.l -text { } \
2006-11-06 19:20:27 +00:00
-anchor w \
-justify left \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-08 01:27:46 +00:00
pack .vpane.lower.commarea.buttons.l -side top -fill x
pack .vpane.lower.commarea.buttons -side left -fill y
2006-11-06 21:07:32 +00:00
2006-11-08 01:27:46 +00:00
button .vpane.lower.commarea.buttons.rescan -text { Rescan} \
2006-11-06 19:20:27 +00:00
-command do_rescan \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-08 01:27:46 +00:00
pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2006-11-12 00:40:33 +00:00
lappend disable_on_lock \
{ .vpane.lower.commarea.buttons.rescan conf -state}
2006-11-06 21:07:32 +00:00
2007-02-09 00:44:49 +00:00
button .vpane.lower.commarea.buttons.incall -text { Add Existing} \
2007-01-21 04:07:04 +00:00
-command do_add_all \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-09 03:48:34 +00:00
pack .vpane.lower.commarea.buttons.incall -side top -fill x
2006-11-12 00:40:33 +00:00
lappend disable_on_lock \
{ .vpane.lower.commarea.buttons.incall conf -state}
2006-11-06 21:07:32 +00:00
2006-11-08 01:27:46 +00:00
button .vpane.lower.commarea.buttons.signoff -text { Sign Off} \
2006-11-06 21:07:32 +00:00
-command do_signoff \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-08 01:27:46 +00:00
pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2006-11-06 21:07:32 +00:00
2006-11-08 01:27:46 +00:00
button .vpane.lower.commarea.buttons.commit -text { Commit} \
2006-11-06 19:20:27 +00:00
-command do_commit \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-08 01:27:46 +00:00
pack .vpane.lower.commarea.buttons.commit -side top -fill x
2006-11-12 00:40:33 +00:00
lappend disable_on_lock \
{ .vpane.lower.commarea.buttons.commit conf -state}
2006-11-06 19:20:27 +00:00
# -- Commit Message Buffer
2006-11-18 08:27:23 +00:00
#
2006-11-08 01:27:46 +00:00
frame .vpane.lower.commarea.buffer
2006-11-19 01:59:49 +00:00
frame .vpane.lower.commarea.buffer.header
2006-11-08 01:27:46 +00:00
set ui_comm .vpane.lower.commarea.buffer.t
2006-11-19 01:59:49 +00:00
set ui_coml .vpane.lower.commarea.buffer.header.l
radiobutton .vpane.lower.commarea.buffer.header.new \
-text { New Commit} \
-command do_select_commit_type \
-variable selected_commit_type \
-value new \
-font font_ui
lappend disable_on_lock \
[ list .vpane.lower.commarea.buffer.header.new conf -state]
radiobutton .vpane.lower.commarea.buffer.header.amend \
-text { Amend Last Commit} \
-command do_select_commit_type \
-variable selected_commit_type \
-value amend \
-font font_ui
lappend disable_on_lock \
[ list .vpane.lower.commarea.buffer.header.amend conf -state]
2006-11-18 08:27:23 +00:00
label $ui_coml \
2006-11-06 19:20:27 +00:00
-anchor w \
-justify left \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-18 07:50:58 +00:00
proc trace_commit_type { varname args} {
global ui_coml commit_type
switch -glob -- $commit_type {
initial { set txt { Initial Commit Message:} }
amend { set txt { Amended Commit Message:} }
amend-initial { set txt { Amended Initial Commit Message:} }
2006-11-21 02:27:22 +00:00
amend-merge { set txt { Amended Merge Commit Message:} }
2006-11-18 07:50:58 +00:00
merge { set txt { Merge Commit Message:} }
* { set txt { Commit Message:} }
}
$ui_coml conf -text $txt
}
trace add variable commit_type write trace_commit_type
2006-11-19 01:59:49 +00:00
pack $ui_coml -side left -fill x
pack .vpane.lower.commarea.buffer.header.amend -side right
pack .vpane.lower.commarea.buffer.header.new -side right
2006-11-06 19:20:27 +00:00
text $ui_comm -background white -borderwidth 1 \
2006-11-11 20:51:41 +00:00
-undo true \
2006-11-11 21:16:25 +00:00
-maxundo 20 \
2006-11-11 20:51:41 +00:00
-autoseparators true \
2006-11-06 19:20:27 +00:00
-relief sunken \
2006-11-08 01:27:46 +00:00
-width 75 -height 9 -wrap none \
2006-11-12 05:40:38 +00:00
-font font_diff \
2006-11-12 01:33:30 +00:00
-yscrollcommand { .vpane.lower.commarea.buffer.sby set}
2006-11-12 00:40:33 +00:00
scrollbar .vpane.lower.commarea.buffer.sby \
-command [ list $ui_comm yview]
2006-11-19 01:59:49 +00:00
pack .vpane.lower.commarea.buffer.header -side top -fill x
2006-11-08 01:27:46 +00:00
pack .vpane.lower.commarea.buffer.sby -side right -fill y
2006-11-06 19:20:27 +00:00
pack $ui_comm -side left -fill y
2006-11-08 01:27:46 +00:00
pack .vpane.lower.commarea.buffer -side left -fill y
2006-11-12 01:24:23 +00:00
# -- Commit Message Buffer Context Menu
#
2006-11-15 23:55:05 +00:00
set ctxm .vpane.lower.commarea.buffer.ctxm
menu $ctxm -tearoff 0
$ctxm add command \
-label { Cut} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-15 23:55:05 +00:00
-command { tk_textCut $ui_comm }
$ctxm add command \
-label { Copy} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-15 23:55:05 +00:00
-command { tk_textCopy $ui_comm }
$ctxm add command \
-label { Paste} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-15 23:55:05 +00:00
-command { tk_textPaste $ui_comm }
$ctxm add command \
-label { Delete} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-15 23:55:05 +00:00
-command { $ui_comm delete sel.first sel.last}
$ctxm add separator
$ctxm add command \
-label { Select All} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2007-01-22 23:31:12 +00:00
-command { focus $ui_comm ; $ui_comm tag add sel 0.0 end}
2006-11-15 23:55:05 +00:00
$ctxm add command \
-label { Copy All} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-15 23:55:05 +00:00
-command {
2006-11-12 01:24:23 +00:00
$ui_comm tag add sel 0.0 end
tk_textCopy $ui_comm
$ui_comm tag remove sel 0.0 end
2006-11-15 23:55:05 +00:00
}
$ctxm add separator
$ctxm add command \
-label { Sign Off} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-12 01:24:23 +00:00
-command do_signoff
2006-11-15 23:55:05 +00:00
bind_button3 $ui_comm " tk_popup $ctxm %X %Y "
2006-11-12 01:24:23 +00:00
2006-11-08 01:27:46 +00:00
# -- Diff Header
2006-11-18 08:27:23 +00:00
#
2007-01-21 16:37:58 +00:00
proc trace_current_diff_path { varname args} {
global current_diff_path diff_actions file_states
if { $current_diff_path eq { } } {
2006-11-15 23:55:05 +00:00
set s { }
set f { }
set p { }
set o disabled
} else {
2007-01-21 16:37:58 +00:00
set p $current_diff_path
2006-11-15 23:55:05 +00:00
set s [ mapdesc [ lindex $file_states ( $p ) 0] $p ]
set f { File:}
set p [ escape_path $p ]
set o normal
}
.vpane.lower.diff.header.status configure -text $s
.vpane.lower.diff.header.file configure -text $f
.vpane.lower.diff.header.path configure -text $p
foreach w $diff_actions {
uplevel #0 $w $o
}
}
2007-01-21 16:37:58 +00:00
trace add variable current_diff_path write trace_current_diff_path
2006-11-15 23:55:05 +00:00
2006-11-08 01:27:46 +00:00
frame .vpane.lower.diff.header -background orange
2006-11-15 23:55:05 +00:00
label .vpane.lower.diff.header.status \
2006-11-13 03:06:37 +00:00
-background orange \
-width $max_status_desc \
-anchor w \
-justify left \
-font font_ui
2006-11-15 23:55:05 +00:00
label .vpane.lower.diff.header.file \
2006-11-08 01:27:46 +00:00
-background orange \
2006-11-15 23:55:05 +00:00
-anchor w \
-justify left \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-15 23:55:05 +00:00
label .vpane.lower.diff.header.path \
2006-11-08 01:27:46 +00:00
-background orange \
2006-11-13 05:48:44 +00:00
-anchor w \
-justify left \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-15 23:55:05 +00:00
pack .vpane.lower.diff.header.status -side left
pack .vpane.lower.diff.header.file -side left
pack .vpane.lower.diff.header.path -fill x
set ctxm .vpane.lower.diff.header.ctxm
menu $ctxm -tearoff 0
$ctxm add command \
-label { Copy} \
2006-11-13 02:11:12 +00:00
-font font_ui \
2006-11-13 05:48:44 +00:00
-command {
clipboard clear
clipboard append \
-format STRING \
-type STRING \
2007-01-21 16:37:58 +00:00
-- $current_diff_path
2006-11-13 05:48:44 +00:00
}
2006-11-15 23:55:05 +00:00
lappend diff_actions [ list $ctxm entryconf [ $ctxm index last] -state]
bind_button3 .vpane.lower.diff.header.path " tk_popup $ctxm %X %Y "
2006-11-08 01:27:46 +00:00
# -- Diff Body
2006-11-18 08:27:23 +00:00
#
2006-11-08 01:27:46 +00:00
frame .vpane.lower.diff.body
set ui_diff .vpane.lower.diff.body.t
text $ui_diff -background white -borderwidth 0 \
-width 80 -height 15 -wrap none \
2006-11-12 05:40:38 +00:00
-font font_diff \
2006-11-08 01:27:46 +00:00
-xscrollcommand { .vpane.lower.diff.body.sbx set} \
-yscrollcommand { .vpane.lower.diff.body.sby set} \
-state disabled
scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
-command [ list $ui_diff xview]
scrollbar .vpane.lower.diff.body.sby -orient vertical \
-command [ list $ui_diff yview]
pack .vpane.lower.diff.body.sbx -side bottom -fill x
pack .vpane.lower.diff.body.sby -side right -fill y
pack $ui_diff -side left -fill both -expand 1
pack .vpane.lower.diff.header -side top -fill x
pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2007-01-25 02:30:23 +00:00
$ui_diff tag conf d_cr -elide true
2007-01-21 19:49:45 +00:00
$ui_diff tag conf d_@ -foreground blue -font font_diffbold
$ui_diff tag conf d_+ -foreground { #00a000}
2007-01-21 18:12:02 +00:00
$ui_diff tag conf d_- -foreground red
2007-01-21 19:49:45 +00:00
$ui_diff tag conf d_++ -foreground { #00a000}
2007-01-21 18:12:02 +00:00
$ui_diff tag conf d_-- -foreground red
$ui_diff tag conf d_+s \
2007-01-21 19:49:45 +00:00
-foreground { #00a000} \
-background { #e2effa}
2007-01-21 18:12:02 +00:00
$ui_diff tag conf d_-s \
-foreground red \
2007-01-21 19:49:45 +00:00
-background { #e2effa}
2007-01-21 18:12:02 +00:00
$ui_diff tag conf d_s+ \
2007-01-21 19:49:45 +00:00
-foreground { #00a000} \
-background ivory1
2007-01-21 18:12:02 +00:00
$ui_diff tag conf d_s- \
-foreground red \
2007-01-21 19:49:45 +00:00
-background ivory1
2007-01-21 18:12:02 +00:00
$ui_diff tag conf d<<< <<< < \
-foreground orange \
-font font_diffbold
$ui_diff tag conf d = = = = = = = \
-foreground orange \
-font font_diffbold
$ui_diff tag conf d>>>>>>> \
-foreground orange \
-font font_diffbold
2006-11-06 19:20:27 +00:00
2007-01-21 19:49:45 +00:00
$ui_diff tag raise sel
2006-11-12 01:24:23 +00:00
# -- Diff Body Context Menu
#
2006-11-15 23:55:05 +00:00
set ctxm .vpane.lower.diff.body.ctxm
menu $ctxm -tearoff 0
2007-01-21 18:27:43 +00:00
$ctxm add command \
-label { Refresh} \
-font font_ui \
-command reshow_diff
2007-01-25 01:39:30 +00:00
lappend diff_actions [ list $ctxm entryconf [ $ctxm index last] -state]
2006-11-15 23:55:05 +00:00
$ctxm add command \
-label { Copy} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-15 23:55:05 +00:00
-command { tk_textCopy $ui_diff }
lappend diff_actions [ list $ctxm entryconf [ $ctxm index last] -state]
$ctxm add command \
-label { Select All} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2007-01-22 23:31:12 +00:00
-command { focus $ui_diff ; $ui_diff tag add sel 0.0 end}
2006-11-15 23:55:05 +00:00
lappend diff_actions [ list $ctxm entryconf [ $ctxm index last] -state]
$ctxm add command \
-label { Copy All} \
2006-11-12 05:40:38 +00:00
-font font_ui \
2006-11-15 23:55:05 +00:00
-command {
2006-11-12 01:24:23 +00:00
$ui_diff tag add sel 0.0 end
tk_textCopy $ui_diff
$ui_diff tag remove sel 0.0 end
2006-11-15 23:55:05 +00:00
}
lappend diff_actions [ list $ctxm entryconf [ $ctxm index last] -state]
$ctxm add separator
2007-01-25 02:20:57 +00:00
$ctxm add command \
-label { Apply/Reverse Hunk} \
-font font_ui \
-command { apply_hunk $cursorX $cursorY }
set ui_diff_applyhunk [ $ctxm index last]
lappend diff_actions [ list $ctxm entryconf $ui_diff_applyhunk -state]
$ctxm add separator
2006-11-15 23:55:05 +00:00
$ctxm add command \
-label { Decrease Font Size} \
2006-11-12 05:40:38 +00:00
-font font_ui \
-command { incr_font_size font_diff -1}
2006-11-15 23:55:05 +00:00
lappend diff_actions [ list $ctxm entryconf [ $ctxm index last] -state]
$ctxm add command \
-label { Increase Font Size} \
2006-11-12 05:40:38 +00:00
-font font_ui \
-command { incr_font_size font_diff 1}
2006-11-15 23:55:05 +00:00
lappend diff_actions [ list $ctxm entryconf [ $ctxm index last] -state]
$ctxm add separator
$ctxm add command \
-label { Show Less Context} \
2006-11-13 00:20:02 +00:00
-font font_ui \
2006-11-15 23:55:05 +00:00
-command { if { $repo_config ( gui.diffcontext) >= 2} {
2006-11-13 00:20:02 +00:00
incr repo_config( gui.diffcontext) -1
reshow_diff
} }
2006-11-15 23:55:05 +00:00
lappend diff_actions [ list $ctxm entryconf [ $ctxm index last] -state]
$ctxm add command \
-label { Show More Context} \
2006-11-13 00:20:02 +00:00
-font font_ui \
2006-11-15 23:55:05 +00:00
-command {
2006-11-13 00:20:02 +00:00
incr repo_config( gui.diffcontext)
reshow_diff
2006-11-15 23:55:05 +00:00
}
lappend diff_actions [ list $ctxm entryconf [ $ctxm index last] -state]
$ctxm add separator
$ctxm add command -label { Options...} \
2006-11-12 11:53:56 +00:00
-font font_ui \
-command do_options
2007-01-25 02:20:57 +00:00
bind_button3 $ui_diff "
set cursorX %x
set cursorY %y
if { \$ ui_index eq \$ current_diff_side} {
$ctxm entryconf $ui_diff_applyhunk -label { Unstage Hunk From Commit}
} else {
$ctxm entryconf $ui_diff_applyhunk -label { Stage Hunk For Commit}
}
tk_popup $ctxm %X %Y
"
2007-01-25 17:55:20 +00:00
unset ui_diff_applyhunk
2006-11-12 01:24:23 +00:00
2006-11-06 19:20:27 +00:00
# -- Status Bar
2006-11-15 23:55:05 +00:00
#
2006-11-06 19:20:27 +00:00
label .status -textvariable ui_status_value \
-anchor w \
-justify left \
-borderwidth 1 \
-relief sunken \
2006-11-12 05:40:38 +00:00
-font font_ui
2006-11-06 19:20:27 +00:00
pack .status -anchor w -side bottom -fill x
2006-11-09 04:42:51 +00:00
# -- Load geometry
2006-11-15 23:55:05 +00:00
#
2006-11-09 04:42:51 +00:00
catch {
2006-11-12 08:47:00 +00:00
set gm $repo_config ( gui.geometry)
2006-11-12 00:32:24 +00:00
wm geometry . [ lindex $gm 0]
.vpane sash place 0 \
[ lindex [ .vpane sash coord 0] 0] \
[ lindex $gm 1]
.vpane.files sash place 0 \
[ lindex $gm 2] \
[ lindex [ .vpane.files sash coord 0] 1]
unset gm
2006-11-12 00:40:33 +00:00
}
2006-11-09 04:42:51 +00:00
2006-11-06 19:20:27 +00:00
# -- Key Bindings
2006-11-15 23:55:05 +00:00
#
2006-11-07 01:50:59 +00:00
bind $ui_comm <$M1B -Key-Return> { do_commit; break}
2007-01-21 04:07:04 +00:00
bind $ui_comm <$M1B -Key-i> { do_add_all; break}
bind $ui_comm <$M1B -Key-I> { do_add_all; break}
2006-11-11 20:51:41 +00:00
bind $ui_comm <$M1B -Key-x> { tk_textCut %W; break}
bind $ui_comm <$M1B -Key-X> { tk_textCut %W; break}
bind $ui_comm <$M1B -Key-c> { tk_textCopy %W; break}
bind $ui_comm <$M1B -Key-C> { tk_textCopy %W; break}
bind $ui_comm <$M1B -Key-v> { tk_textPaste %W; %W see insert; break}
bind $ui_comm <$M1B -Key-V> { tk_textPaste %W; %W see insert; break}
bind $ui_comm <$M1B -Key-a> { %W tag add sel 0.0 end; break}
bind $ui_comm <$M1B -Key-A> { %W tag add sel 0.0 end; break}
bind $ui_diff <$M1B -Key-x> { tk_textCopy %W; break}
bind $ui_diff <$M1B -Key-X> { tk_textCopy %W; break}
bind $ui_diff <$M1B -Key-c> { tk_textCopy %W; break}
bind $ui_diff <$M1B -Key-C> { tk_textCopy %W; break}
bind $ui_diff <$M1B -Key-v> { break}
bind $ui_diff <$M1B -Key-V> { break}
bind $ui_diff <$M1B -Key-a> { %W tag add sel 0.0 end; break}
bind $ui_diff <$M1B -Key-A> { %W tag add sel 0.0 end; break}
2006-11-11 21:16:25 +00:00
bind $ui_diff <Key-Up> { catch { %W yview scroll -1 units} ; break}
bind $ui_diff <Key-Down> { catch { %W yview scroll 1 units} ; break}
bind $ui_diff <Key-Left> { catch { %W xview scroll -1 units} ; break}
bind $ui_diff <Key-Right> { catch { %W xview scroll 1 units} ; break}
2007-01-25 17:57:57 +00:00
bind $ui_diff <Button-1> { focus %W}
2006-11-11 20:16:01 +00:00
2007-02-08 23:10:05 +00:00
if { [ is_enabled branch] } {
2007-01-21 06:34:55 +00:00
bind . <$M1B -Key-n> do_create_branch
bind . <$M1B -Key-N> do_create_branch
}
2006-11-07 07:57:46 +00:00
bind all <Key-F5> do_rescan
bind all <$M1B -Key-r> do_rescan
bind all <$M1B -Key-R> do_rescan
bind . <$M1B -Key-s> do_signoff
bind . <$M1B -Key-S> do_signoff
2007-01-21 04:07:04 +00:00
bind . <$M1B -Key-i> do_add_all
bind . <$M1B -Key-I> do_add_all
2006-11-07 07:57:46 +00:00
bind . <$M1B -Key-Return> do_commit
2007-01-21 03:06:51 +00:00
foreach i [ list $ui_index $ui_workdir ] {
2006-11-13 21:06:38 +00:00
bind $i <Button-1> " toggle_or_diff $i %x %y; break "
bind $i <$M1B -Button-1> " add_one_to_selection $i %x %y; break "
bind $i <Shift-Button-1> " add_range_to_selection $i %x %y; break "
2006-11-06 19:20:27 +00:00
}
2006-11-12 01:00:35 +00:00
unset i
set file_lists( $ui_index ) [ list]
2007-01-21 03:06:51 +00:00
set file_lists( $ui_workdir ) [ list]
2006-11-18 08:27:23 +00:00
2007-01-21 02:48:56 +00:00
wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
2006-11-06 19:20:27 +00:00
focus -force $ui_comm
2006-11-21 20:28:14 +00:00
2006-11-25 08:38:39 +00:00
# -- Warn the user about environmental problems. Cygwin's Tcl
# does *not* pass its env array onto any processes it spawns.
# This means that git processes get none of our environment.
2006-11-21 20:28:14 +00:00
#
2007-01-29 01:58:47 +00:00
if { [ is_Cygwin] } {
2006-11-21 20:28:14 +00:00
set ignored_env 0
set suggest_user { }
set msg " Possible environment issues exist.
The following environment variables are probably
going to be ignored by any Git subprocess run
2007-01-21 02:48:56 +00:00
by [ appname] :
2006-11-21 20:28:14 +00:00
"
foreach name [ array names env] {
switch -regexp -- $name {
{ ^GIT_INDEX_FILE$} -
{ ^GIT_OBJECT_DIRECTORY$} -
{ ^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
{ ^GIT_DIFF_OPTS$} -
{ ^GIT_EXTERNAL_DIFF$} -
{ ^GIT_PAGER$} -
{ ^GIT_TRACE$} -
{ ^GIT_CONFIG$} -
{ ^GIT_CONFIG_LOCAL$} -
{ ^GIT_( AUTHOR| COMMITTER) _DATE$} {
append msg " - $name \n "
incr ignored_env
}
{ ^GIT_( AUTHOR| COMMITTER) _( NAME| EMAIL) $} {
append msg " - $name \n "
incr ignored_env
set suggest_user $name
}
}
}
if { $ignored_env > 0} {
append msg "
This is due to a known issue with the
Tcl binary distributed by Cygwin."
if { $suggest_user ne { } } {
append msg "
A good replacement for $suggest_user
is placing values for the user.name and
user.email settings into your personal
~/.gitconfig file.
"
}
warn_popup $msg
}
unset ignored_env msg suggest_user name
}
2006-11-25 08:38:39 +00:00
# -- Only initialize complex UI if we are going to stay running.
#
2007-02-08 23:10:05 +00:00
if { [ is_enabled transport] } {
2006-11-12 21:20:36 +00:00
load_all_remotes
2006-11-25 08:35:33 +00:00
load_all_heads
2006-11-25 08:38:39 +00:00
2007-01-21 06:31:14 +00:00
populate_branch_menu
2007-01-25 22:16:22 +00:00
populate_fetch_menu
populate_push_menu
2006-11-12 21:20:36 +00:00
}
2006-11-25 08:38:39 +00:00
2007-01-21 02:23:21 +00:00
# -- Only suggest a gc run if we are going to stay running.
#
2007-02-08 23:03:41 +00:00
if { [ is_enabled multicommit] } {
2007-01-21 02:23:21 +00:00
set object_limit 2000
if { [ is_Windows] } { set object_limit 200}
2007-02-13 03:48:56 +00:00
regexp { ^( [ 0-9] +) objects,} [ git count-objects] _junk objects_current
2007-01-21 02:23:21 +00:00
if { $objects_current >= $object_limit } {
if { [ ask_popup \
" This repository currently has $objects_current loose objects.
2007-03-27 10:31:55 +00:00
To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
2007-01-21 02:23:21 +00:00
Compress the database now?" ] eq yes} {
do_gc
}
}
unset object_limit _junk objects_current
}
2006-11-18 08:31:25 +00:00
lock_index begin-read
2006-11-14 06:29:32 +00:00
after 1 do_rescan