2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 set appname
[lindex
[file split $argv0] end
]
13 ######################################################################
17 proc is_many_config
{name
} {
18 switch
-glob -- $name {
27 proc load_config
{include_global
} {
28 global repo_config global_config default_config
30 array
unset global_config
31 if {$include_global} {
33 set fd_rc
[open
"| git repo-config --global --list" r
]
34 while {[gets
$fd_rc line
] >= 0} {
35 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
36 if {[is_many_config
$name]} {
37 lappend global_config
($name) $value
39 set global_config
($name) $value
47 array
unset repo_config
49 set fd_rc
[open
"| git repo-config --list" r
]
50 while {[gets
$fd_rc line
] >= 0} {
51 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
52 if {[is_many_config
$name]} {
53 lappend repo_config
($name) $value
55 set repo_config
($name) $value
62 foreach name
[array names default_config
] {
63 if {[catch
{set v
$global_config($name)}]} {
64 set global_config
($name) $default_config($name)
66 if {[catch
{set v
$repo_config($name)}]} {
67 set repo_config
($name) $default_config($name)
73 global default_config font_descs
74 global repo_config global_config
75 global repo_config_new global_config_new
77 foreach option
$font_descs {
78 set name
[lindex
$option 0]
79 set font
[lindex
$option 1]
80 font configure
$font \
81 -family $global_config_new(gui.
$font^^family
) \
82 -size $global_config_new(gui.
$font^^size
)
83 font configure
${font}bold \
84 -family $global_config_new(gui.
$font^^family
) \
85 -size $global_config_new(gui.
$font^^size
)
86 set global_config_new
(gui.
$name) [font configure
$font]
87 unset global_config_new
(gui.
$font^^family
)
88 unset global_config_new
(gui.
$font^^size
)
91 foreach name
[array names default_config
] {
92 set value
$global_config_new($name)
93 if {$value ne
$global_config($name)} {
94 if {$value eq
$default_config($name)} {
95 catch
{exec git repo-config
--global --unset $name}
97 regsub
-all "\[{}\]" $value {"} value
98 exec git repo-config --global $name $value
100 set global_config($name) $value
101 if {$value eq $repo_config($name)} {
102 catch {exec git repo-config --unset $name}
103 set repo_config($name) $value
108 foreach name [array names default_config] {
109 set value $repo_config_new($name)
110 if {$value ne $repo_config($name)} {
111 if {$value eq $global_config($name)} {
112 catch {exec git repo-config --unset $name}
114 regsub -all "\
[{}\
]" $value {"} value
115 exec git repo-config
$name $value
117 set repo_config
($name) $value
122 proc error_popup
{msg
} {
123 global gitdir appname
128 append title
[lindex \
129 [file split [file normalize
[file dirname $gitdir]]] \
137 -title "$title: error" \
141 proc info_popup
{msg
} {
142 global gitdir appname
147 append title
[lindex \
148 [file split [file normalize
[file dirname $gitdir]]] \
160 ######################################################################
164 if { [catch
{set cdup
[exec git rev-parse
--show-cdup]} err
]
165 ||
[catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
166 catch
{wm withdraw .
}
167 error_popup
"Cannot find the git directory:\n\n$err"
176 if {$appname eq
{git-citool
}} {
180 ######################################################################
188 set disable_on_lock
[list
]
189 set index_lock_type none
195 proc lock_index
{type} {
196 global index_lock_type disable_on_lock
198 if {$index_lock_type eq
{none
}} {
199 set index_lock_type
$type
200 foreach w
$disable_on_lock {
201 uplevel
#0 $w disabled
204 } elseif
{$index_lock_type eq
{begin-update
} && $type eq
{update
}} {
205 set index_lock_type
$type
211 proc unlock_index
{} {
212 global index_lock_type disable_on_lock
214 set index_lock_type none
215 foreach w
$disable_on_lock {
220 ######################################################################
224 proc repository_state
{hdvar ctvar
} {
226 upvar
$hdvar hd
$ctvar ct
228 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
230 } elseif
{[file exists
[file join $gitdir MERGE_HEAD
]]} {
237 proc rescan
{after
} {
238 global HEAD PARENT commit_type
239 global ui_index ui_other ui_status_value ui_comm
240 global rescan_active file_states
243 if {$rescan_active > 0 ||
![lock_index
read]} return
245 repository_state new_HEAD new_type
246 if {$commit_type eq
{amend
}
247 && $new_type eq
{normal
}
248 && $new_HEAD eq
$HEAD} {
252 set commit_type
$new_type
255 array
unset file_states
257 if {![$ui_comm edit modified
]
258 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
259 if {[load_message GITGUI_MSG
]} {
260 } elseif
{[load_message MERGE_MSG
]} {
261 } elseif
{[load_message SQUASH_MSG
]} {
263 $ui_comm edit modified false
267 if {$repo_config(gui.trustmtime
) eq
{true
}} {
268 rescan_stage2
{} $after
271 set ui_status_value
{Refreshing
file status...
}
272 set cmd
[list git update-index
]
274 lappend cmd
--unmerged
275 lappend cmd
--ignore-missing
276 lappend cmd
--refresh
277 set fd_rf
[open
"| $cmd" r
]
278 fconfigure
$fd_rf -blocking 0 -translation binary
279 fileevent
$fd_rf readable \
280 [list rescan_stage2
$fd_rf $after]
284 proc rescan_stage2
{fd after
} {
285 global gitdir PARENT commit_type
286 global ui_index ui_other ui_status_value ui_comm
288 global buf_rdi buf_rdf buf_rlo
292 if {![eof
$fd]} return
296 set ls_others
[list | git ls-files
--others -z \
297 --exclude-per-directory=.gitignore
]
298 set info_exclude
[file join $gitdir info exclude
]
299 if {[file readable
$info_exclude]} {
300 lappend ls_others
"--exclude-from=$info_exclude"
308 set ui_status_value
{Scanning
for modified files ...
}
309 set fd_di
[open
"| git diff-index --cached -z $PARENT" r
]
310 set fd_df
[open
"| git diff-files -z" r
]
311 set fd_lo
[open
$ls_others r
]
313 fconfigure
$fd_di -blocking 0 -translation binary
314 fconfigure
$fd_df -blocking 0 -translation binary
315 fconfigure
$fd_lo -blocking 0 -translation binary
316 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
317 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
318 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
321 proc load_message
{file} {
322 global gitdir ui_comm
324 set f
[file join $gitdir $file]
325 if {[file isfile
$f]} {
326 if {[catch
{set fd
[open
$f r
]}]} {
329 set content
[string trim
[read $fd]]
331 $ui_comm delete
0.0 end
332 $ui_comm insert end
$content
338 proc read_diff_index
{fd after
} {
341 append buf_rdi
[read $fd]
343 set n
[string length
$buf_rdi]
345 set z1
[string first
"\0" $buf_rdi $c]
348 set z2
[string first
"\0" $buf_rdi $z1]
354 [string range
$buf_rdi $z1 $z2] \
355 [string index
$buf_rdi [expr {$z1 - 2}]]_
359 set buf_rdi
[string range
$buf_rdi $c end
]
364 rescan_done
$fd buf_rdi
$after
367 proc read_diff_files
{fd after
} {
370 append buf_rdf
[read $fd]
372 set n
[string length
$buf_rdf]
374 set z1
[string first
"\0" $buf_rdf $c]
377 set z2
[string first
"\0" $buf_rdf $z1]
383 [string range
$buf_rdf $z1 $z2] \
384 _
[string index
$buf_rdf [expr {$z1 - 2}]]
388 set buf_rdf
[string range
$buf_rdf $c end
]
393 rescan_done
$fd buf_rdf
$after
396 proc read_ls_others
{fd after
} {
399 append buf_rlo
[read $fd]
400 set pck
[split $buf_rlo "\0"]
401 set buf_rlo
[lindex
$pck end
]
402 foreach p
[lrange
$pck 0 end-1
] {
405 rescan_done
$fd buf_rlo
$after
408 proc rescan_done
{fd buf after
} {
410 global file_states repo_config
413 if {![eof
$fd]} return
416 if {[incr rescan_active
-1] > 0} return
422 if {$repo_config(gui.partialinclude
) ne
{true
}} {
424 foreach path
[array names file_states
] {
425 switch
-- [lindex
$file_states($path) 0] {
427 MM
{lappend pathList
$path}
430 if {$pathList ne
{}} {
432 "Updating included files" \
434 [concat
{reshow_diff
;} $after]
443 proc prune_selection
{} {
444 global file_states selected_paths
446 foreach path
[array names selected_paths
] {
447 if {[catch
{set still_here
$file_states($path)}]} {
448 unset selected_paths
($path)
453 ######################################################################
458 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
460 $ui_diff conf
-state normal
461 $ui_diff delete
0.0 end
462 $ui_diff conf
-state disabled
464 set ui_fname_value
{}
465 set ui_fstatus_value
{}
467 $ui_index tag remove in_diff
0.0 end
468 $ui_other tag remove in_diff
0.0 end
471 proc reshow_diff
{} {
472 global ui_fname_value ui_status_value file_states
474 if {$ui_fname_value eq
{}
475 ||
[catch
{set s
$file_states($ui_fname_value)}]} {
478 show_diff
$ui_fname_value
482 proc handle_empty_diff
{} {
483 global ui_fname_value file_states file_lists
485 set path
$ui_fname_value
486 set s
$file_states($path)
487 if {[lindex
$s 0] ne
{_M
}} return
489 info_popup
"No differences detected.
491 [short_path $path] has no changes.
493 The modification date of this file was updated
494 by another application and you currently have
495 the Trust File Modification Timestamps option
496 enabled, so Git did not automatically detect
497 that there are no content differences in this
500 This file will now be removed from the modified
501 files list, to prevent possible confusion.
503 if {[catch
{exec git update-index
-- $path} err
]} {
504 error_popup
"Failed to refresh index:\n\n$err"
508 set old_w
[mapcol
[lindex
$file_states($path) 0] $path]
509 set lno
[lsearch
-sorted $file_lists($old_w) $path]
511 set file_lists
($old_w) \
512 [lreplace
$file_lists($old_w) $lno $lno]
514 $old_w conf
-state normal
515 $old_w delete
$lno.0 [expr {$lno + 1}].0
516 $old_w conf
-state disabled
520 proc show_diff
{path
{w
{}} {lno
{}}} {
521 global file_states file_lists
522 global PARENT diff_3way diff_active repo_config
523 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
525 if {$diff_active ||
![lock_index
read]} return
528 if {$w eq
{} ||
$lno == {}} {
529 foreach w
[array names file_lists
] {
530 set lno
[lsearch
-sorted $file_lists($w) $path]
537 if {$w ne
{} && $lno >= 1} {
538 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
541 set s
$file_states($path)
545 set ui_fname_value
$path
546 set ui_fstatus_value
[mapdesc
$m $path]
547 set ui_status_value
"Loading diff of [escape_path $path]..."
549 set cmd
[list | git diff-index
]
550 lappend cmd
--no-color
551 if {$repo_config(gui.diffcontext
) > 0} {
552 lappend cmd
"-U$repo_config(gui.diffcontext)"
562 set fd
[open
$path r
]
563 set content
[read $fd]
568 set ui_status_value
"Unable to display [escape_path $path]"
569 error_popup
"Error loading file:\n\n$err"
572 $ui_diff conf
-state normal
573 $ui_diff insert end
$content
574 $ui_diff conf
-state disabled
577 set ui_status_value
{Ready.
}
586 if {[catch
{set fd
[open
$cmd r
]} err
]} {
589 set ui_status_value
"Unable to display [escape_path $path]"
590 error_popup
"Error loading diff:\n\n$err"
594 fconfigure
$fd -blocking 0 -translation auto
595 fileevent
$fd readable
[list read_diff
$fd]
598 proc read_diff
{fd
} {
599 global ui_diff ui_status_value diff_3way diff_active
602 while {[gets
$fd line
] >= 0} {
603 if {[string match
{diff --git *} $line]} continue
604 if {[string match
{diff --combined *} $line]} continue
605 if {[string match
{--- *} $line]} continue
606 if {[string match
{+++ *} $line]} continue
607 if {[string match index
* $line]} {
608 if {[string first
, $line] >= 0} {
613 $ui_diff conf
-state normal
615 set x
[string index
$line 0]
620 default
{set tags
{}}
623 set x
[string range
$line 0 1]
625 default
{set tags
{}}
627 "++" {set tags dp
; set x
" +"}
628 " +" {set tags
{di bold
}; set x
"++"}
629 "+ " {set tags dni
; set x
"-+"}
630 "--" {set tags dm
; set x
" -"}
631 " -" {set tags
{dm bold
}; set x
"--"}
632 "- " {set tags di
; set x
"+-"}
633 default
{set tags
{}}
635 set line
[string replace
$line 0 1 $x]
637 $ui_diff insert end
$line $tags
638 $ui_diff insert end
"\n"
639 $ui_diff conf
-state disabled
646 set ui_status_value
{Ready.
}
648 if {$repo_config(gui.trustmtime
) eq
{true
}
649 && [$ui_diff index end
] eq
{2.0}} {
655 ######################################################################
659 proc load_last_commit
{} {
660 global HEAD PARENT commit_type ui_comm
662 if {$commit_type eq
{amend
}} return
663 if {$commit_type ne
{normal
}} {
664 error_popup
"Can't amend a $commit_type commit."
672 set fd
[open
"| git cat-file commit $HEAD" r
]
673 while {[gets
$fd line
] > 0} {
674 if {[string match
{parent
*} $line]} {
675 set parent
[string range
$line 7 end
]
679 set msg
[string trim
[read $fd]]
682 error_popup
"Error loading commit data for amend:\n\n$err"
686 if {$parent_count == 0} {
687 set commit_type amend
690 rescan
{set ui_status_value
{Ready.
}}
691 } elseif
{$parent_count == 1} {
692 set commit_type amend
694 $ui_comm delete
0.0 end
695 $ui_comm insert end
$msg
696 $ui_comm edit modified false
698 rescan
{set ui_status_value
{Ready.
}}
700 error_popup
{You can
't amend a merge commit.}
705 proc commit_tree {} {
706 global tcl_platform HEAD gitdir commit_type file_states
708 global ui_status_value ui_comm
710 if {![lock_index update]} return
712 # -- Our in memory state should match the repository.
714 repository_state curHEAD cur_type
715 if {$commit_type eq {amend}
716 && $cur_type eq {normal}
717 && $curHEAD eq $HEAD} {
718 } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
719 error_popup {Last scanned state does not match repository state.
721 Its highly likely that another Git program modified the
722 repository since our last scan. A rescan is required
726 rescan {set ui_status_value {Ready.}}
730 # -- At least one file should differ in the index.
733 foreach path [array names file_states] {
734 set s $file_states($path)
735 switch -glob -- [lindex $s 0] {
739 M? {set files_ready 1; break}
741 error_popup "Unmerged files cannot be committed.
743 File [short_path $path] has merge conflicts.
744 You must resolve them and include the file before committing.
750 error_popup "Unknown file state [lindex $s 0] detected.
752 File [short_path $path] cannot be committed by this program.
758 error_popup {No included files to commit.
760 You must include at least 1 file before you can commit.
766 # -- A message is required.
768 set msg [string trim [$ui_comm get 1.0 end]]
770 error_popup {Please supply a commit message.
772 A good commit message has the following format:
774 - First line: Describe in one sentance what you did.
776 - Remaining lines: Describe why this change is good.
782 # -- Ask the pre-commit hook for the go-ahead.
784 set pchook [file join $gitdir hooks pre-commit]
785 if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
786 set pchook [list sh -c [concat \
787 "if test -x \"$pchook\";" \
788 "then exec \"$pchook\" 2>&1;" \
790 } elseif {[file executable $pchook]} {
791 set pchook [list $pchook |& cat]
796 set ui_status_value {Calling pre-commit hook...}
798 set fd_ph [open "| $pchook" r]
799 fconfigure $fd_ph -blocking 0 -translation binary
800 fileevent $fd_ph readable \
801 [list commit_stage1 $fd_ph $curHEAD $msg]
803 commit_stage2 $curHEAD $msg
807 proc commit_stage1 {fd_ph curHEAD msg} {
808 global pch_error ui_status_value
810 append pch_error [read $fd_ph]
811 fconfigure $fd_ph -blocking 1
813 if {[catch {close $fd_ph}]} {
814 set ui_status_value {Commit declined by pre-commit hook.}
815 hook_failed_popup pre-commit $pch_error
818 commit_stage2 $curHEAD $msg
822 fconfigure $fd_ph -blocking 0
826 proc commit_stage2 {curHEAD msg} {
827 global ui_status_value
829 # -- Write the tree in the background.
831 set ui_status_value {Committing changes...}
832 set fd_wt [open "| git write-tree" r]
833 fileevent $fd_wt readable [list commit_stage3 $fd_wt $curHEAD $msg]
836 proc commit_stage3 {fd_wt curHEAD msg} {
837 global single_commit gitdir HEAD PARENT commit_type tcl_platform
838 global ui_status_value ui_comm
839 global file_states selected_paths
842 if {$tree_id eq {} || [catch {close $fd_wt} err]} {
843 error_popup "write-tree failed:\n\n$err"
844 set ui_status_value {Commit failed.}
849 # -- Create the commit.
851 set cmd [list git commit-tree $tree_id]
853 lappend cmd -p $PARENT
855 if {$commit_type eq {merge}} {
857 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
858 while {[gets $fd_mh merge_head] >= 0} {
859 lappend cmd -p $merge_head
863 error_popup "Loading MERGE_HEAD failed:\n\n$err"
864 set ui_status_value {Commit failed.}
870 # git commit-tree writes to stderr during initial commit.
871 lappend cmd 2>/dev/null
874 if {[catch {set cmt_id [eval exec $cmd]} err]} {
875 error_popup "commit-tree failed:\n\n$err"
876 set ui_status_value {Commit failed.}
881 # -- Update the HEAD ref.
884 if {$commit_type ne {normal}} {
885 append reflogm " ($commit_type)"
887 set i [string first "\n" $msg]
889 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
891 append reflogm {: } $msg
893 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
894 if {[catch {eval exec $cmd} err]} {
895 error_popup "update-ref failed:\n\n$err"
896 set ui_status_value {Commit failed.}
901 # -- Cleanup after ourselves.
903 catch {file delete [file join $gitdir MERGE_HEAD]}
904 catch {file delete [file join $gitdir MERGE_MSG]}
905 catch {file delete [file join $gitdir SQUASH_MSG]}
906 catch {file delete [file join $gitdir GITGUI_MSG]}
908 # -- Let rerere do its thing.
910 if {[file isdirectory [file join $gitdir rr-cache]]} {
911 catch {exec git rerere}
914 # -- Run the post-commit hook.
916 set pchook [file join $gitdir hooks post-commit]
917 if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
918 set pchook [list sh -c [concat \
919 "if test -x \"$pchook\";" \
920 "then exec \"$pchook\";" \
922 } elseif {![file executable $pchook]} {
926 catch {exec $pchook &}
929 $ui_comm delete 0.0 end
930 $ui_comm edit modified false
933 if {$single_commit} do_quit
935 # -- Update status without invoking any git commands.
937 set commit_type normal
941 foreach path [array names file_states] {
942 set s $file_states($path)
947 D? {set m _[string index $m 1]}
951 unset file_states($path)
952 catch {unset selected_paths($path)}
954 lset file_states($path) 0 $m
961 set ui_status_value \
962 "Changes committed as [string range $cmt_id 0 7]."
965 ######################################################################
969 proc fetch_from {remote} {
970 set w [new_console "fetch $remote" \
971 "Fetching new changes from $remote"]
972 set cmd [list git fetch]
977 proc pull_remote {remote branch} {
978 global HEAD commit_type file_states repo_config
980 if {![lock_index update]} return
982 # -- Our in memory state should match the repository.
984 repository_state curHEAD cur_type
985 if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
986 error_popup {Last scanned state does not match repository state.
988 Its highly likely that another Git program modified the
989 repository since our last scan. A rescan is required
990 before a pull can be started.
993 rescan {set ui_status_value {Ready.}}
997 # -- No differences should exist before a pull.
999 if {[array size file_states] != 0} {
1000 error_popup {Uncommitted but modified files are present.
1002 You should not perform a pull with unmodified files in your working
1003 directory as Git would be unable to recover from an incorrect merge.
1005 Commit or throw away all changes before starting a pull operation.
1011 set w [new_console "pull $remote $branch" \
1012 "Pulling new changes from branch $branch in $remote"]
1013 set cmd [list git pull]
1014 if {$repo_config(gui.pullsummary) eq {false}} {
1015 lappend cmd --no-summary
1019 console_exec $w $cmd [list post_pull_remote $remote $branch]
1022 proc post_pull_remote {remote branch success} {
1023 global HEAD PARENT commit_type
1024 global ui_status_value
1028 repository_state HEAD commit_type
1030 set $ui_status_value "Pulling $branch from $remote complete."
1032 set m "Conflicts detected while pulling $branch from $remote."
1033 rescan "set ui_status_value {$m}"
1037 proc push_to {remote} {
1038 set w [new_console "push $remote" \
1039 "Pushing changes to $remote"]
1040 set cmd [list git push]
1042 console_exec $w $cmd
1045 ######################################################################
1049 proc mapcol {state path} {
1050 global all_cols ui_other
1052 if {[catch {set r $all_cols($state)}]} {
1053 puts "error: no column for state={$state} $path"
1059 proc mapicon {state path} {
1062 if {[catch {set r $all_icons($state)}]} {
1063 puts "error: no icon for state={$state} $path"
1069 proc mapdesc {state path} {
1072 if {[catch {set r $all_descs($state)}]} {
1073 puts "error: no desc for state={$state} $path"
1079 proc escape_path {path} {
1080 regsub -all "\n" $path "\\n" path
1084 proc short_path {path} {
1085 return [escape_path [lindex [file split $path] end]]
1090 proc merge_state {path new_state} {
1091 global file_states next_icon_id
1093 set s0 [string index $new_state 0]
1094 set s1 [string index $new_state 1]
1096 if {[catch {set info $file_states($path)}]} {
1098 set icon n[incr next_icon_id]
1100 set state [lindex $info 0]
1101 set icon [lindex $info 1]
1105 set s0 [string index $state 0]
1106 } elseif {$s0 eq {*}} {
1111 set s1 [string index $state 1]
1112 } elseif {$s1 eq {*}} {
1116 set file_states($path) [list $s0$s1 $icon]
1120 proc display_file {path state} {
1121 global file_states file_lists selected_paths rescan_active
1123 set old_m [merge_state $path $state]
1124 if {$rescan_active > 0} return
1126 set s $file_states($path)
1127 set new_m [lindex $s 0]
1128 set new_w [mapcol $new_m $path]
1129 set old_w [mapcol $old_m $path]
1130 set new_icon [mapicon $new_m $path]
1132 if {$new_w ne $old_w} {
1133 set lno [lsearch -sorted $file_lists($old_w) $path]
1136 $old_w conf -state normal
1137 $old_w delete $lno.0 [expr {$lno + 1}].0
1138 $old_w conf -state disabled
1141 lappend file_lists($new_w) $path
1142 set file_lists($new_w) [lsort $file_lists($new_w)]
1143 set lno [lsearch -sorted $file_lists($new_w) $path]
1145 $new_w conf -state normal
1146 $new_w image create $lno.0 \
1147 -align center -padx 5 -pady 1 \
1148 -name [lindex $s 1] \
1150 $new_w insert $lno.1 "[escape_path $path]\n"
1151 if {[catch {set in_sel $selected_paths($path)}]} {
1155 $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1157 $new_w conf -state disabled
1158 } elseif {$new_icon ne [mapicon $old_m $path]} {
1159 $new_w conf -state normal
1160 $new_w image conf [lindex $s 1] -image $new_icon
1161 $new_w conf -state disabled
1165 proc display_all_files {} {
1166 global ui_index ui_other
1167 global file_states file_lists
1168 global last_clicked selected_paths
1170 $ui_index conf -state normal
1171 $ui_other conf -state normal
1173 $ui_index delete 0.0 end
1174 $ui_other delete 0.0 end
1177 set file_lists($ui_index) [list]
1178 set file_lists($ui_other) [list]
1180 foreach path [lsort [array names file_states]] {
1181 set s $file_states($path)
1183 set w [mapcol $m $path]
1184 lappend file_lists($w) $path
1185 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1186 $w image create end \
1187 -align center -padx 5 -pady 1 \
1188 -name [lindex $s 1] \
1189 -image [mapicon $m $path]
1190 $w insert end "[escape_path $path]\n"
1191 if {[catch {set in_sel $selected_paths($path)}]} {
1195 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1199 $ui_index conf -state disabled
1200 $ui_other conf -state disabled
1203 proc update_index {msg pathList after} {
1204 global update_index_cp update_index_rsd ui_status_value
1206 if {![lock_index update]} return
1208 set update_index_cp 0
1209 set update_index_rsd 0
1210 set pathList [lsort $pathList]
1211 set totalCnt [llength $pathList]
1212 set batch [expr {int($totalCnt * .01) + 1}]
1213 if {$batch > 25} {set batch 25}
1215 set ui_status_value [format \
1216 "$msg... %i/%i files (%.2f%%)" \
1220 set fd [open "| git update-index --add --remove -z --stdin" w]
1226 fileevent $fd writable [list \
1227 write_update_index \
1237 proc write_update_index {fd pathList totalCnt batch msg after} {
1238 global update_index_cp update_index_rsd ui_status_value
1239 global file_states ui_fname_value
1241 if {$update_index_cp >= $totalCnt} {
1244 if {$update_index_rsd} reshow_diff
1249 for {set i $batch} \
1250 {$update_index_cp < $totalCnt && $i > 0} \
1252 set path [lindex $pathList $update_index_cp]
1253 incr update_index_cp
1255 switch -- [lindex $file_states($path) 0] {
1265 puts -nonewline $fd $path
1266 puts -nonewline $fd "\0"
1267 display_file $path $new
1268 if {$ui_fname_value eq $path} {
1269 set update_index_rsd 1
1273 set ui_status_value [format \
1274 "$msg... %i/%i files (%.2f%%)" \
1277 [expr {100.0 * $update_index_cp / $totalCnt}]]
1280 ######################################################################
1282 ## remote management
1284 proc load_all_remotes {} {
1285 global gitdir all_remotes repo_config
1287 set all_remotes [list]
1288 set rm_dir [file join $gitdir remotes]
1289 if {[file isdirectory $rm_dir]} {
1290 set all_remotes [concat $all_remotes [glob \
1294 -directory $rm_dir *]]
1297 foreach line [array names repo_config remote.*.url] {
1298 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1299 lappend all_remotes $name
1303 set all_remotes [lsort -unique $all_remotes]
1306 proc populate_remote_menu {m pfx op} {
1309 foreach remote $all_remotes {
1310 $m add command -label "$pfx $remote..." \
1311 -command [list $op $remote] \
1316 proc populate_pull_menu {m} {
1317 global gitdir repo_config all_remotes disable_on_lock
1319 foreach remote $all_remotes {
1321 if {[array get repo_config remote.$remote.url] ne {}} {
1322 if {[array get repo_config remote.$remote.fetch] ne {}} {
1323 regexp {^([^:]+):} \
1324 [lindex $repo_config(remote.$remote.fetch) 0] \
1329 set fd [open [file join $gitdir remotes $remote] r]
1330 while {[gets $fd line] >= 0} {
1331 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1340 regsub ^refs/heads/ $rb {} rb_short
1341 if {$rb_short ne {}} {
1343 -label "Branch $rb_short from $remote..." \
1344 -command [list pull_remote $remote $rb] \
1346 lappend disable_on_lock \
1347 [list $m entryconf [$m index last] -state]
1352 ######################################################################
1357 #define mask_width 14
1358 #define mask_height 15
1359 static unsigned char mask_bits[] = {
1360 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1361 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1362 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1365 image create bitmap file_plain -background white -foreground black -data {
1366 #define plain_width 14
1367 #define plain_height 15
1368 static unsigned char plain_bits[] = {
1369 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1370 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1371 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1372 } -maskdata $filemask
1374 image create bitmap file_mod -background white -foreground blue -data {
1375 #define mod_width 14
1376 #define mod_height 15
1377 static unsigned char mod_bits[] = {
1378 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1379 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1380 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1381 } -maskdata $filemask
1383 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1384 #define file_fulltick_width 14
1385 #define file_fulltick_height 15
1386 static unsigned char file_fulltick_bits[] = {
1387 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1388 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1389 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1390 } -maskdata $filemask
1392 image create bitmap file_parttick -background white -foreground "#005050" -data {
1393 #define parttick_width 14
1394 #define parttick_height 15
1395 static unsigned char parttick_bits[] = {
1396 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1397 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1398 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1399 } -maskdata $filemask
1401 image create bitmap file_question -background white -foreground black -data {
1402 #define file_question_width 14
1403 #define file_question_height 15
1404 static unsigned char file_question_bits[] = {
1405 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1406 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1407 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1408 } -maskdata $filemask
1410 image create bitmap file_removed -background white -foreground red -data {
1411 #define file_removed_width 14
1412 #define file_removed_height 15
1413 static unsigned char file_removed_bits[] = {
1414 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1415 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1416 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1417 } -maskdata $filemask
1419 image create bitmap file_merge -background white -foreground blue -data {
1420 #define file_merge_width 14
1421 #define file_merge_height 15
1422 static unsigned char file_merge_bits[] = {
1423 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1424 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1425 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1426 } -maskdata $filemask
1428 set ui_index .vpane.files.index.list
1429 set ui_other .vpane.files.other.list
1430 set max_status_desc 0
1432 {__ i plain "Unmodified"}
1433 {_M i mod "Modified"}
1434 {M_ i fulltick "Included in commit"}
1435 {MM i parttick "Partially included"}
1437 {_O o plain "Untracked"}
1438 {A_ o fulltick "Added by commit"}
1439 {AM o parttick "Partially added"}
1440 {AD o question "Added (but now gone)"}
1442 {_D i question "Missing"}
1443 {D_ i removed "Removed by commit"}
1444 {DD i removed "Removed by commit"}
1445 {DO i removed "Removed (still exists)"}
1447 {UM i merge "Merge conflicts"}
1448 {U_ i merge "Merge conflicts"}
1450 if {$max_status_desc < [string length [lindex $i 3]]} {
1451 set max_status_desc [string length [lindex $i 3]]
1453 if {[lindex $i 1] eq {i}} {
1454 set all_cols([lindex $i 0]) $ui_index
1456 set all_cols([lindex $i 0]) $ui_other
1458 set all_icons([lindex $i 0]) file_[lindex $i 2]
1459 set all_descs([lindex $i 0]) [lindex $i 3]
1463 ######################################################################
1468 global tcl_platform tk_library
1469 if {$tcl_platform(platform) eq {unix}
1470 && $tcl_platform(os) eq {Darwin}
1471 && [string match /Library/Frameworks/* $tk_library]} {
1477 proc bind_button3 {w cmd} {
1478 bind $w <Any-Button-3> $cmd
1480 bind $w <Control-Button-1> $cmd
1484 proc incr_font_size {font {amt 1}} {
1485 set sz [font configure $font -size]
1487 font configure $font -size $sz
1488 font configure ${font}bold -size $sz
1491 proc hook_failed_popup {hook msg} {
1492 global gitdir appname
1498 label $w.m.l1 -text "$hook hook failed:" \
1503 -background white -borderwidth 1 \
1505 -width 80 -height 10 \
1507 -yscrollcommand [list $w.m.sby set]
1509 -text {You must correct the above errors before committing.} \
1513 scrollbar $w.m.sby -command [list $w.m.t yview]
1514 pack $w.m.l1 -side top -fill x
1515 pack $w.m.l2 -side bottom -fill x
1516 pack $w.m.sby -side right -fill y
1517 pack $w.m.t -side left -fill both -expand 1
1518 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1520 $w.m.t insert 1.0 $msg
1521 $w.m.t conf -state disabled
1523 button $w.ok -text OK \
1526 -command "destroy $w"
1527 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1529 bind $w <Visibility> "grab $w; focus $w"
1530 bind $w <Key-Return> "destroy $w"
1531 wm title $w "$appname ([lindex [file split \
1532 [file normalize [file dirname $gitdir]]] \
1537 set next_console_id 0
1539 proc new_console {short_title long_title} {
1540 global next_console_id console_data
1541 set w .console[incr next_console_id]
1542 set console_data($w) [list $short_title $long_title]
1543 return [console_init $w]
1546 proc console_init {w} {
1547 global console_cr console_data
1548 global gitdir appname M1B
1550 set console_cr($w) 1.0
1553 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1558 -background white -borderwidth 1 \
1560 -width 80 -height 10 \
1563 -yscrollcommand [list $w.m.sby set]
1564 label $w.m.s -text {Working... please wait...} \
1568 scrollbar $w.m.sby -command [list $w.m.t yview]
1569 pack $w.m.l1 -side top -fill x
1570 pack $w.m.s -side bottom -fill x
1571 pack $w.m.sby -side right -fill y
1572 pack $w.m.t -side left -fill both -expand 1
1573 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1575 menu $w.ctxm -tearoff 0
1576 $w.ctxm add command -label "Copy" \
1578 -command "tk_textCopy $w.m.t"
1579 $w.ctxm add command -label "Select All" \
1581 -command "$w.m.t tag add sel 0.0 end"
1582 $w.ctxm add command -label "Copy All" \
1585 $w.m.t tag add sel 0.0 end
1587 $w.m.t tag remove sel 0.0 end
1590 button $w.ok -text {Close} \
1593 -command "destroy $w"
1594 pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1596 bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1597 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1598 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1599 bind $w <Visibility> "focus $w"
1600 wm title $w "$appname ([lindex [file split \
1601 [file normalize [file dirname $gitdir]]] \
1602 end]): [lindex $console_data($w) 0]"
1606 proc console_exec {w cmd {after {}}} {
1609 # -- Windows tosses the enviroment when we exec our child.
1610 # But most users need that so we have to relogin. :-(
1612 if {$tcl_platform(platform) eq {windows}} {
1613 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1616 # -- Tcl won't
let us redirect both stdout and stderr to
1617 # the same pipe. So pass it through cat...
1619 set cmd
[concat |
$cmd |
& cat]
1621 set fd_f
[open
$cmd r
]
1622 fconfigure
$fd_f -blocking 0 -translation binary
1623 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
1626 proc console_read
{w fd after
} {
1627 global console_cr console_data
1631 if {![winfo exists
$w]} {console_init
$w}
1632 $w.m.t conf
-state normal
1634 set n
[string length
$buf]
1636 set cr
[string first
"\r" $buf $c]
1637 set lf
[string first
"\n" $buf $c]
1638 if {$cr < 0} {set cr
[expr {$n + 1}]}
1639 if {$lf < 0} {set lf
[expr {$n + 1}]}
1642 $w.m.t insert end
[string range
$buf $c $lf]
1643 set console_cr
($w) [$w.m.t index
{end
-1c}]
1647 $w.m.t delete
$console_cr($w) end
1648 $w.m.t insert end
"\n"
1649 $w.m.t insert end
[string range
$buf $c $cr]
1654 $w.m.t conf
-state disabled
1658 fconfigure
$fd -blocking 1
1660 if {[catch
{close
$fd}]} {
1661 if {![winfo exists
$w]} {console_init
$w}
1662 $w.m.s conf
-background red
-text {Error
: Command Failed
}
1663 $w.ok conf
-state normal
1665 } elseif
{[winfo exists
$w]} {
1666 $w.m.s conf
-background green
-text {Success
}
1667 $w.ok conf
-state normal
1670 array
unset console_cr
$w
1671 array
unset console_data
$w
1673 uplevel
#0 $after $ok
1677 fconfigure
$fd -blocking 0
1680 ######################################################################
1684 set starting_gitk_msg
{Please
wait... Starting gitk...
}
1687 global tcl_platform ui_status_value starting_gitk_msg
1689 set ui_status_value
$starting_gitk_msg
1691 if {$ui_status_value eq
$starting_gitk_msg} {
1692 set ui_status_value
{Ready.
}
1696 if {$tcl_platform(platform
) eq
{windows
}} {
1704 set w
[new_console
"repack" "Repacking the object database"]
1705 set cmd
[list git repack
]
1708 console_exec
$w $cmd
1714 global gitdir ui_comm is_quitting repo_config
1716 if {$is_quitting} return
1719 # -- Stash our current commit buffer.
1721 set save
[file join $gitdir GITGUI_MSG
]
1722 set msg
[string trim
[$ui_comm get
0.0 end
]]
1723 if {[$ui_comm edit modified
] && $msg ne
{}} {
1725 set fd
[open
$save w
]
1726 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
1729 } elseif
{$msg eq
{} && [file exists
$save]} {
1733 # -- Stash our current window geometry into this repository.
1735 set cfg_geometry
[list
]
1736 lappend cfg_geometry
[wm geometry .
]
1737 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1738 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1739 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
1742 if {$cfg_geometry ne
$rc_geometry} {
1743 catch
{exec git repo-config gui.geometry
$cfg_geometry}
1750 rescan
{set ui_status_value
{Ready.
}}
1753 proc do_include_all
{} {
1756 if {![lock_index begin-update
]} return
1759 foreach path
[array names file_states
] {
1760 set s
$file_states($path)
1766 _D
{lappend pathList
$path}
1769 if {$pathList eq
{}} {
1773 "Including all modified files" \
1775 {set ui_status_value
{Ready to commit.
}}
1779 set GIT_COMMITTER_IDENT
{}
1781 proc do_signoff
{} {
1782 global ui_comm GIT_COMMITTER_IDENT
1784 if {$GIT_COMMITTER_IDENT eq
{}} {
1785 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
1786 error_popup
"Unable to obtain your identity:\n\n$err"
1789 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1790 $me me GIT_COMMITTER_IDENT
]} {
1791 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1796 set sob
"Signed-off-by: $GIT_COMMITTER_IDENT"
1797 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
1798 if {$last ne
$sob} {
1799 $ui_comm edit separator
1801 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
1802 $ui_comm insert end
"\n"
1804 $ui_comm insert end
"\n$sob"
1805 $ui_comm edit separator
1810 proc do_amend_last
{} {
1818 proc do_options
{} {
1819 global appname gitdir font_descs
1820 global repo_config global_config
1821 global repo_config_new global_config_new
1823 array
unset repo_config_new
1824 array
unset global_config_new
1825 foreach name
[array names repo_config
] {
1826 set repo_config_new
($name) $repo_config($name)
1829 foreach name
[array names repo_config
] {
1831 gui.diffcontext
{continue}
1833 set repo_config_new
($name) $repo_config($name)
1835 foreach name
[array names global_config
] {
1836 set global_config_new
($name) $global_config($name)
1838 set reponame
[lindex
[file split \
1839 [file normalize
[file dirname $gitdir]]] \
1842 set w .options_editor
1844 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1846 label
$w.header
-text "$appname Options" \
1848 pack
$w.header
-side top
-fill x
1851 button
$w.buttons.restore
-text {Restore Defaults
} \
1853 -command do_restore_defaults
1854 pack
$w.buttons.restore
-side left
1855 button
$w.buttons.save
-text Save \
1857 -command [list do_save_config
$w]
1858 pack
$w.buttons.save
-side right
1859 button
$w.buttons.cancel
-text {Cancel
} \
1861 -command [list destroy
$w]
1862 pack
$w.buttons.cancel
-side right
1863 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1865 labelframe
$w.repo
-text "$reponame Repository" \
1867 -relief raised
-borderwidth 2
1868 labelframe
$w.global
-text {Global
(All Repositories
)} \
1870 -relief raised
-borderwidth 2
1871 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
1872 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
1875 {b partialinclude
{Allow Partially Included Files
}}
1876 {b pullsummary
{Show Pull Summary
}}
1877 {b trustmtime
{Trust File Modification Timestamps
}}
1878 {i diffcontext
{Number of Diff Context Lines
}}
1880 set type [lindex
$option 0]
1881 set name
[lindex
$option 1]
1882 set text
[lindex
$option 2]
1883 foreach f
{repo global
} {
1886 checkbutton
$w.
$f.
$name -text $text \
1887 -variable ${f}_config_new
(gui.
$name) \
1891 pack
$w.
$f.
$name -side top
-anchor w
1895 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
1896 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
1897 spinbox
$w.
$f.
$name.v \
1898 -textvariable ${f}_config_new
(gui.
$name) \
1899 -from 1 -to 99 -increment 1 \
1902 pack
$w.
$f.
$name.v
-side right
-anchor e
1903 pack
$w.
$f.
$name -side top
-anchor w
-fill x
1909 set all_fonts
[lsort
[font families
]]
1910 foreach option
$font_descs {
1911 set name
[lindex
$option 0]
1912 set font
[lindex
$option 1]
1913 set text
[lindex
$option 2]
1915 set global_config_new
(gui.
$font^^family
) \
1916 [font configure
$font -family]
1917 set global_config_new
(gui.
$font^^size
) \
1918 [font configure
$font -size]
1920 frame
$w.global.
$name
1921 label
$w.global.
$name.l
-text "$text:" -font font_ui
1922 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
1923 eval tk_optionMenu
$w.global.
$name.family \
1924 global_config_new
(gui.
$font^^family
) \
1926 spinbox
$w.global.
$name.size \
1927 -textvariable global_config_new
(gui.
$font^^size
) \
1928 -from 2 -to 80 -increment 1 \
1931 pack
$w.global.
$name.size
-side right
-anchor e
1932 pack
$w.global.
$name.family
-side right
-anchor e
1933 pack
$w.global.
$name -side top
-anchor w
-fill x
1936 bind $w <Visibility
> "grab $w; focus $w"
1937 bind $w <Key-Escape
> "destroy $w"
1938 wm title
$w "$appname ($reponame): Options"
1942 proc do_restore_defaults
{} {
1943 global font_descs default_config repo_config
1944 global repo_config_new global_config_new
1946 foreach name
[array names default_config
] {
1947 set repo_config_new
($name) $default_config($name)
1948 set global_config_new
($name) $default_config($name)
1951 foreach option
$font_descs {
1952 set name
[lindex
$option 0]
1953 set repo_config
(gui.
$name) $default_config(gui.
$name)
1957 foreach option
$font_descs {
1958 set name
[lindex
$option 0]
1959 set font
[lindex
$option 1]
1960 set global_config_new
(gui.
$font^^family
) \
1961 [font configure
$font -family]
1962 set global_config_new
(gui.
$font^^size
) \
1963 [font configure
$font -size]
1967 proc do_save_config
{w
} {
1968 if {[catch
{save_config
} err
]} {
1969 error_popup
"Failed to completely save options:\n\n$err"
1975 proc toggle_or_diff
{w x y
} {
1976 global file_lists ui_index ui_other
1977 global last_clicked selected_paths
1979 set pos
[split [$w index @
$x,$y] .
]
1980 set lno
[lindex
$pos 0]
1981 set col [lindex
$pos 1]
1982 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
1988 set last_clicked
[list
$w $lno]
1989 array
unset selected_paths
1990 $ui_index tag remove in_sel
0.0 end
1991 $ui_other tag remove in_sel
0.0 end
1995 "Including [short_path $path]" \
1997 {set ui_status_value
{Ready.
}}
1999 show_diff
$path $w $lno
2003 proc add_one_to_selection
{w x y
} {
2005 global last_clicked selected_paths
2007 set pos
[split [$w index @
$x,$y] .
]
2008 set lno
[lindex
$pos 0]
2009 set col [lindex
$pos 1]
2010 set path
[lindex
$file_lists($w) [expr {$lno - 1}]]
2016 set last_clicked
[list
$w $lno]
2017 if {[catch
{set in_sel
$selected_paths($path)}]} {
2021 unset selected_paths
($path)
2022 $w tag remove in_sel
$lno.0 [expr {$lno + 1}].0
2024 set selected_paths
($path) 1
2025 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
2029 proc add_range_to_selection
{w x y
} {
2031 global last_clicked selected_paths
2033 if {[lindex
$last_clicked 0] ne
$w} {
2034 toggle_or_diff
$w $x $y
2038 set pos
[split [$w index @
$x,$y] .
]
2039 set lno
[lindex
$pos 0]
2040 set lc
[lindex
$last_clicked 1]
2049 foreach path
[lrange
$file_lists($w) \
2050 [expr {$begin - 1}] \
2051 [expr {$end - 1}]] {
2052 set selected_paths
($path) 1
2054 $w tag add in_sel
$begin.0 [expr {$end + 1}].0
2057 ######################################################################
2061 set cursor_ptr arrow
2062 font create font_diff
-family Courier
-size 10
2066 eval font configure font_ui
[font actual
[.dummy cget
-font]]
2070 font create font_uibold
2071 font create font_diffbold
2075 if {$tcl_platform(platform
) eq
{windows
}} {
2078 } elseif
{[is_MacOSX
]} {
2083 proc apply_config
{} {
2084 global repo_config font_descs
2086 foreach option
$font_descs {
2087 set name
[lindex
$option 0]
2088 set font
[lindex
$option 1]
2090 foreach
{cn cv
} $repo_config(gui.
$name) {
2091 font configure
$font $cn $cv
2094 error_popup
"Invalid font specified in gui.$name:\n\n$err"
2096 foreach
{cn cv
} [font configure
$font] {
2097 font configure
${font}bold
$cn $cv
2099 font configure
${font}bold
-weight bold
2103 set default_config
(gui.trustmtime
) false
2104 set default_config
(gui.pullsummary
) true
2105 set default_config
(gui.partialinclude
) false
2106 set default_config
(gui.diffcontext
) 5
2107 set default_config
(gui.fontui
) [font configure font_ui
]
2108 set default_config
(gui.fontdiff
) [font configure font_diff
]
2110 {fontui font_ui
{Main Font
}}
2111 {fontdiff font_diff
{Diff
/Console Font
}}
2116 ######################################################################
2121 menu .mbar
-tearoff 0
2122 .mbar add cascade
-label Project
-menu .mbar.project
2123 .mbar add cascade
-label Edit
-menu .mbar.edit
2124 .mbar add cascade
-label Commit
-menu .mbar.commit
2125 if {!$single_commit} {
2126 .mbar add cascade
-label Fetch
-menu .mbar.fetch
2127 .mbar add cascade
-label Pull
-menu .mbar.pull
2128 .mbar add cascade
-label Push
-menu .mbar.push
2130 . configure
-menu .mbar
2134 .mbar.project add
command -label Visualize \
2137 if {!$single_commit} {
2138 .mbar.project add
command -label {Repack Database
} \
2139 -command do_repack \
2142 .mbar.project add
command -label Quit \
2144 -accelerator $M1T-Q \
2150 .mbar.edit add
command -label Undo \
2151 -command {catch
{[focus
] edit undo
}} \
2152 -accelerator $M1T-Z \
2154 .mbar.edit add
command -label Redo \
2155 -command {catch
{[focus
] edit redo
}} \
2156 -accelerator $M1T-Y \
2158 .mbar.edit add separator
2159 .mbar.edit add
command -label Cut \
2160 -command {catch
{tk_textCut
[focus
]}} \
2161 -accelerator $M1T-X \
2163 .mbar.edit add
command -label Copy \
2164 -command {catch
{tk_textCopy
[focus
]}} \
2165 -accelerator $M1T-C \
2167 .mbar.edit add
command -label Paste \
2168 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
2169 -accelerator $M1T-V \
2171 .mbar.edit add
command -label Delete \
2172 -command {catch
{[focus
] delete sel.first sel.last
}} \
2175 .mbar.edit add separator
2176 .mbar.edit add
command -label {Select All
} \
2177 -command {catch
{[focus
] tag add sel
0.0 end
}} \
2178 -accelerator $M1T-A \
2180 .mbar.edit add separator
2181 .mbar.edit add
command -label {Options...
} \
2182 -command do_options \
2187 .mbar.commit add
command -label Rescan \
2188 -command do_rescan \
2191 lappend disable_on_lock \
2192 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2193 .mbar.commit add
command -label {Amend Last Commit
} \
2194 -command do_amend_last \
2196 lappend disable_on_lock \
2197 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2198 .mbar.commit add
command -label {Include All Files
} \
2199 -command do_include_all \
2200 -accelerator $M1T-I \
2202 lappend disable_on_lock \
2203 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2204 .mbar.commit add
command -label {Sign Off
} \
2205 -command do_signoff \
2206 -accelerator $M1T-S \
2208 .mbar.commit add
command -label Commit \
2209 -command do_commit \
2210 -accelerator $M1T-Return \
2212 lappend disable_on_lock \
2213 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
2215 if {!$single_commit} {
2226 # -- Main Window Layout
2227 panedwindow .vpane
-orient vertical
2228 panedwindow .vpane.files
-orient horizontal
2229 .vpane add .vpane.files
-sticky nsew
-height 100 -width 400
2230 pack .vpane
-anchor n
-side top
-fill both
-expand 1
2232 # -- Index File List
2233 frame .vpane.files.index
-height 100 -width 400
2234 label .vpane.files.index.title
-text {Modified Files
} \
2237 text
$ui_index -background white
-borderwidth 0 \
2238 -width 40 -height 10 \
2240 -cursor $cursor_ptr \
2241 -yscrollcommand {.vpane.files.index.sb
set} \
2243 scrollbar .vpane.files.index.sb
-command [list
$ui_index yview
]
2244 pack .vpane.files.index.title
-side top
-fill x
2245 pack .vpane.files.index.sb
-side right
-fill y
2246 pack
$ui_index -side left
-fill both
-expand 1
2247 .vpane.files add .vpane.files.index
-sticky nsew
2249 # -- Other (Add) File List
2250 frame .vpane.files.other
-height 100 -width 100
2251 label .vpane.files.other.title
-text {Untracked Files
} \
2254 text
$ui_other -background white
-borderwidth 0 \
2255 -width 40 -height 10 \
2257 -cursor $cursor_ptr \
2258 -yscrollcommand {.vpane.files.other.sb
set} \
2260 scrollbar .vpane.files.other.sb
-command [list
$ui_other yview
]
2261 pack .vpane.files.other.title
-side top
-fill x
2262 pack .vpane.files.other.sb
-side right
-fill y
2263 pack
$ui_other -side left
-fill both
-expand 1
2264 .vpane.files add .vpane.files.other
-sticky nsew
2266 foreach i
[list
$ui_index $ui_other] {
2267 $i tag conf in_diff
-font font_uibold
2268 $i tag conf in_sel \
2269 -background [$i cget
-foreground] \
2270 -foreground [$i cget
-background]
2274 # -- Diff and Commit Area
2275 frame .vpane.lower
-height 300 -width 400
2276 frame .vpane.lower.commarea
2277 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
2278 pack .vpane.lower.commarea
-side top
-fill x
2279 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
2280 .vpane add .vpane.lower
-stick nsew
2282 # -- Commit Area Buttons
2283 frame .vpane.lower.commarea.buttons
2284 label .vpane.lower.commarea.buttons.l
-text {} \
2288 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
2289 pack .vpane.lower.commarea.buttons
-side left
-fill y
2291 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
2292 -command do_rescan \
2294 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
2295 lappend disable_on_lock \
2296 {.vpane.lower.commarea.buttons.rescan conf
-state}
2298 button .vpane.lower.commarea.buttons.amend
-text {Amend Last
} \
2299 -command do_amend_last \
2301 pack .vpane.lower.commarea.buttons.amend
-side top
-fill x
2302 lappend disable_on_lock \
2303 {.vpane.lower.commarea.buttons.amend conf
-state}
2305 button .vpane.lower.commarea.buttons.incall
-text {Include All
} \
2306 -command do_include_all \
2308 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
2309 lappend disable_on_lock \
2310 {.vpane.lower.commarea.buttons.incall conf
-state}
2312 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
2313 -command do_signoff \
2315 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
2317 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
2318 -command do_commit \
2320 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
2321 lappend disable_on_lock \
2322 {.vpane.lower.commarea.buttons.commit conf
-state}
2324 # -- Commit Message Buffer
2325 frame .vpane.lower.commarea.buffer
2326 set ui_comm .vpane.lower.commarea.buffer.t
2327 set ui_coml .vpane.lower.commarea.buffer.l
2328 label
$ui_coml -text {Commit Message
:} \
2332 trace add variable commit_type
write {uplevel
#0 {
2333 switch
-glob $commit_type \
2334 initial
{$ui_coml conf
-text {Initial Commit Message
:}} \
2335 amend
{$ui_coml conf
-text {Amended Commit Message
:}} \
2336 merge
{$ui_coml conf
-text {Merge Commit Message
:}} \
2337 * {$ui_coml conf
-text {Commit Message
:}}
2339 text
$ui_comm -background white
-borderwidth 1 \
2342 -autoseparators true \
2344 -width 75 -height 9 -wrap none \
2346 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
2347 scrollbar .vpane.lower.commarea.buffer.sby \
2348 -command [list
$ui_comm yview
]
2349 pack
$ui_coml -side top
-fill x
2350 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
2351 pack
$ui_comm -side left
-fill y
2352 pack .vpane.lower.commarea.buffer
-side left
-fill y
2354 # -- Commit Message Buffer Context Menu
2356 menu
$ui_comm.ctxm
-tearoff 0
2357 $ui_comm.ctxm add
command -label "Cut" \
2359 -command "tk_textCut $ui_comm"
2360 $ui_comm.ctxm add
command -label "Copy" \
2362 -command "tk_textCopy $ui_comm"
2363 $ui_comm.ctxm add
command -label "Paste" \
2365 -command "tk_textPaste $ui_comm"
2366 $ui_comm.ctxm add
command -label "Delete" \
2368 -command "$ui_comm delete sel.first sel.last"
2369 $ui_comm.ctxm add separator
2370 $ui_comm.ctxm add
command -label "Select All" \
2372 -command "$ui_comm tag add sel 0.0 end"
2373 $ui_comm.ctxm add
command -label "Copy All" \
2376 $ui_comm tag add sel 0.0 end
2377 tk_textCopy $ui_comm
2378 $ui_comm tag remove sel 0.0 end
2380 $ui_comm.ctxm add separator
2381 $ui_comm.ctxm add
command -label "Sign Off" \
2384 bind_button3
$ui_comm "tk_popup $ui_comm.ctxm %X %Y"
2387 set ui_fname_value
{}
2388 set ui_fstatus_value
{}
2389 frame .vpane.lower.
diff.header
-background orange
2390 label .vpane.lower.
diff.header.l4 \
2391 -textvariable ui_fstatus_value \
2392 -background orange \
2393 -width $max_status_desc \
2397 label .vpane.lower.
diff.header.l1
-text {File
:} \
2398 -background orange \
2400 set ui_fname .vpane.lower.
diff.header.l2
2402 -textvariable ui_fname_value \
2403 -background orange \
2407 menu
$ui_fname.ctxm
-tearoff 0
2408 $ui_fname.ctxm add
command -label "Copy" \
2417 bind_button3
$ui_fname "tk_popup $ui_fname.ctxm %X %Y"
2418 pack .vpane.lower.
diff.header.l4
-side left
2419 pack .vpane.lower.
diff.header.l1
-side left
2420 pack
$ui_fname -fill x
2423 frame .vpane.lower.
diff.body
2424 set ui_diff .vpane.lower.
diff.body.t
2425 text
$ui_diff -background white
-borderwidth 0 \
2426 -width 80 -height 15 -wrap none \
2428 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
2429 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
2431 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
2432 -command [list
$ui_diff xview
]
2433 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
2434 -command [list
$ui_diff yview
]
2435 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
2436 pack .vpane.lower.
diff.body.sby
-side right
-fill y
2437 pack
$ui_diff -side left
-fill both
-expand 1
2438 pack .vpane.lower.
diff.header
-side top
-fill x
2439 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
2441 $ui_diff tag conf dm
-foreground red
2442 $ui_diff tag conf dp
-foreground blue
2443 $ui_diff tag conf di
-foreground {#00a000}
2444 $ui_diff tag conf dni
-foreground {#a000a0}
2445 $ui_diff tag conf da
-font font_diffbold
2446 $ui_diff tag conf bold
-font font_diffbold
2448 # -- Diff Body Context Menu
2450 menu
$ui_diff.ctxm
-tearoff 0
2451 $ui_diff.ctxm add
command -label "Copy" \
2453 -command "tk_textCopy $ui_diff"
2454 $ui_diff.ctxm add
command -label "Select All" \
2456 -command "$ui_diff tag add sel 0.0 end"
2457 $ui_diff.ctxm add
command -label "Copy All" \
2460 $ui_diff tag add sel 0.0 end
2461 tk_textCopy $ui_diff
2462 $ui_diff tag remove sel 0.0 end
2464 $ui_diff.ctxm add separator
2465 $ui_diff.ctxm add
command -label "Decrease Font Size" \
2467 -command {incr_font_size font_diff
-1}
2468 $ui_diff.ctxm add
command -label "Increase Font Size" \
2470 -command {incr_font_size font_diff
1}
2471 $ui_diff.ctxm add separator
2472 $ui_diff.ctxm add
command -label "Show Less Context" \
2474 -command {if {$ui_fname_value ne
{}
2475 && $repo_config(gui.diffcontext
) >= 2} {
2476 incr repo_config
(gui.diffcontext
) -1
2479 $ui_diff.ctxm add
command -label "Show More Context" \
2481 -command {if {$ui_fname_value ne
{}} {
2482 incr repo_config
(gui.diffcontext
)
2485 $ui_diff.ctxm add separator
2486 $ui_diff.ctxm add
command -label {Options...
} \
2489 bind_button3
$ui_diff "tk_popup $ui_diff.ctxm %X %Y"
2492 set ui_status_value
{Initializing...
}
2493 label .status
-textvariable ui_status_value \
2499 pack .status
-anchor w
-side bottom
-fill x
2503 set gm
$repo_config(gui.geometry
)
2504 wm geometry .
[lindex
$gm 0]
2505 .vpane sash place
0 \
2506 [lindex
[.vpane sash coord
0] 0] \
2508 .vpane.files sash place
0 \
2510 [lindex
[.vpane.files sash coord
0] 1]
2515 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2516 bind $ui_comm <$M1B-Key-i> {do_include_all
;break}
2517 bind $ui_comm <$M1B-Key-I> {do_include_all
;break}
2518 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2519 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2520 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2521 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2522 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2523 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2524 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2525 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2527 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2528 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2529 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2530 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2531 bind $ui_diff <$M1B-Key-v> {break}
2532 bind $ui_diff <$M1B-Key-V> {break}
2533 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2534 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2535 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2536 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2537 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2538 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2540 bind .
<Destroy
> do_quit
2541 bind all
<Key-F5
> do_rescan
2542 bind all
<$M1B-Key-r> do_rescan
2543 bind all
<$M1B-Key-R> do_rescan
2544 bind .
<$M1B-Key-s> do_signoff
2545 bind .
<$M1B-Key-S> do_signoff
2546 bind .
<$M1B-Key-i> do_include_all
2547 bind .
<$M1B-Key-I> do_include_all
2548 bind .
<$M1B-Key-Return> do_commit
2549 bind all
<$M1B-Key-q> do_quit
2550 bind all
<$M1B-Key-Q> do_quit
2551 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2552 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2553 foreach i
[list
$ui_index $ui_other] {
2554 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
2555 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
2556 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
2560 set file_lists
($ui_index) [list
]
2561 set file_lists
($ui_other) [list
]
2563 wm title .
"$appname ([file normalize [file dirname $gitdir]])"
2564 focus
-force $ui_comm
2565 if {!$single_commit} {
2567 populate_remote_menu .mbar.fetch From fetch_from
2568 populate_remote_menu .mbar.push To push_to
2569 populate_pull_menu .mbar.pull