2 # Tcl ignores the next line -*- tcl -*- \
5 set appvers
{@@GIT_VERSION@@
}
7 Copyright ©
2006, 2007 Shawn Pearce
, Paul Mackerras.
9 This program is free software
; you can redistribute it and
/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation
; either version
2 of the License
, or
12 (at your option
) any later version.
14 This program is distributed
in the hope that it will be useful
,
15 but WITHOUT ANY WARRANTY
; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License
for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program
; if not
, write to the Free Software
21 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}
23 ######################################################################
27 set _appname
[lindex
[file split $argv0] end
]
41 return [eval [concat
[list
file join $_gitdir] $args]]
49 ######################################################################
53 proc is_many_config
{name
} {
54 switch
-glob -- $name {
63 proc load_config
{include_global
} {
64 global repo_config global_config default_config
66 array
unset global_config
67 if {$include_global} {
69 set fd_rc
[open
"| git repo-config --global --list" r
]
70 while {[gets
$fd_rc line
] >= 0} {
71 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
72 if {[is_many_config
$name]} {
73 lappend global_config
($name) $value
75 set global_config
($name) $value
83 array
unset repo_config
85 set fd_rc
[open
"| git repo-config --list" r
]
86 while {[gets
$fd_rc line
] >= 0} {
87 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
88 if {[is_many_config
$name]} {
89 lappend repo_config
($name) $value
91 set repo_config
($name) $value
98 foreach name
[array names default_config
] {
99 if {[catch
{set v
$global_config($name)}]} {
100 set global_config
($name) $default_config($name)
102 if {[catch
{set v
$repo_config($name)}]} {
103 set repo_config
($name) $default_config($name)
108 proc save_config
{} {
109 global default_config font_descs
110 global repo_config global_config
111 global repo_config_new global_config_new
113 foreach option
$font_descs {
114 set name
[lindex
$option 0]
115 set font
[lindex
$option 1]
116 font configure
$font \
117 -family $global_config_new(gui.
$font^^family
) \
118 -size $global_config_new(gui.
$font^^size
)
119 font configure
${font}bold \
120 -family $global_config_new(gui.
$font^^family
) \
121 -size $global_config_new(gui.
$font^^size
)
122 set global_config_new
(gui.
$name) [font configure
$font]
123 unset global_config_new
(gui.
$font^^family
)
124 unset global_config_new
(gui.
$font^^size
)
127 foreach name
[array names default_config
] {
128 set value
$global_config_new($name)
129 if {$value ne
$global_config($name)} {
130 if {$value eq
$default_config($name)} {
131 catch
{exec git repo-config
--global --unset $name}
133 regsub
-all "\[{}\]" $value {"} value
134 exec git repo-config --global $name $value
136 set global_config($name) $value
137 if {$value eq $repo_config($name)} {
138 catch {exec git repo-config --unset $name}
139 set repo_config($name) $value
144 foreach name [array names default_config] {
145 set value $repo_config_new($name)
146 if {$value ne $repo_config($name)} {
147 if {$value eq $global_config($name)} {
148 catch {exec git repo-config --unset $name}
150 regsub -all "\
[{}\
]" $value {"} value
151 exec git repo-config
$name $value
153 set repo_config
($name) $value
158 proc error_popup
{msg
} {
160 if {[reponame
] ne
{}} {
161 append title
" ([reponame])"
163 set cmd
[list tk_messageBox \
166 -title "$title: error" \
168 if {[winfo ismapped .
]} {
169 lappend cmd
-parent .
174 proc warn_popup
{msg
} {
176 if {[reponame
] ne
{}} {
177 append title
" ([reponame])"
179 set cmd
[list tk_messageBox \
182 -title "$title: warning" \
184 if {[winfo ismapped .
]} {
185 lappend cmd
-parent .
190 proc info_popup
{msg
} {
192 if {[reponame
] ne
{}} {
193 append title
" ([reponame])"
203 proc ask_popup
{msg
} {
205 if {[reponame
] ne
{}} {
206 append title
" ([reponame])"
208 return [tk_messageBox \
216 ######################################################################
220 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
221 && [catch
{set _gitdir
[exec git rev-parse
--git-dir]} err
]} {
222 catch
{wm withdraw .
}
223 error_popup
"Cannot find the git directory:\n\n$err"
226 if {![file isdirectory
$_gitdir]} {
227 catch
{wm withdraw .
}
228 error_popup
"Git directory not found:\n\n$_gitdir"
231 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
232 catch
{wm withdraw .
}
233 error_popup
"Cannot use funny .git directory:\n\n$gitdir"
236 if {[catch
{cd [file dirname $_gitdir]} err
]} {
237 catch
{wm withdraw .
}
238 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
241 set _reponame
[lindex
[file split \
242 [file normalize
[file dirname $_gitdir]]] \
246 if {[appname
] eq
{git-citool
}} {
250 ######################################################################
258 set disable_on_lock
[list
]
259 set index_lock_type none
261 proc lock_index
{type} {
262 global index_lock_type disable_on_lock
264 if {$index_lock_type eq
{none
}} {
265 set index_lock_type
$type
266 foreach w
$disable_on_lock {
267 uplevel
#0 $w disabled
270 } elseif
{$index_lock_type eq
"begin-$type"} {
271 set index_lock_type
$type
277 proc unlock_index
{} {
278 global index_lock_type disable_on_lock
280 set index_lock_type none
281 foreach w
$disable_on_lock {
286 ######################################################################
290 proc repository_state
{ctvar hdvar mhvar
} {
291 global current_branch
292 upvar
$ctvar ct
$hdvar hd
$mhvar mh
296 if {[catch
{set current_branch
[exec git symbolic-ref HEAD
]}]} {
297 set current_branch
{}
299 regsub ^refs
/((heads|tags|remotes
)/)? \
305 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
311 set merge_head
[gitdir MERGE_HEAD
]
312 if {[file exists
$merge_head]} {
314 set fd_mh
[open
$merge_head r
]
315 while {[gets
$fd_mh line
] >= 0} {
326 global PARENT empty_tree
328 set p
[lindex
$PARENT 0]
332 if {$empty_tree eq
{}} {
333 set empty_tree
[exec git mktree
<< {}]
338 proc rescan
{after
{honor_trustmtime
1}} {
339 global HEAD PARENT MERGE_HEAD commit_type
340 global ui_index ui_workdir ui_status_value ui_comm
341 global rescan_active file_states
344 if {$rescan_active > 0 ||
![lock_index
read]} return
346 repository_state newType newHEAD newMERGE_HEAD
347 if {[string match amend
* $commit_type]
348 && $newType eq
{normal
}
349 && $newHEAD eq
$HEAD} {
353 set MERGE_HEAD
$newMERGE_HEAD
354 set commit_type
$newType
357 array
unset file_states
359 if {![$ui_comm edit modified
]
360 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
361 if {[load_message GITGUI_MSG
]} {
362 } elseif
{[load_message MERGE_MSG
]} {
363 } elseif
{[load_message SQUASH_MSG
]} {
366 $ui_comm edit modified false
369 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
370 rescan_stage2
{} $after
373 set ui_status_value
{Refreshing
file status...
}
374 set cmd
[list git update-index
]
376 lappend cmd
--unmerged
377 lappend cmd
--ignore-missing
378 lappend cmd
--refresh
379 set fd_rf
[open
"| $cmd" r
]
380 fconfigure
$fd_rf -blocking 0 -translation binary
381 fileevent
$fd_rf readable \
382 [list rescan_stage2
$fd_rf $after]
386 proc rescan_stage2
{fd after
} {
387 global ui_status_value
388 global rescan_active buf_rdi buf_rdf buf_rlo
392 if {![eof
$fd]} return
396 set ls_others
[list | git ls-files
--others -z \
397 --exclude-per-directory=.gitignore
]
398 set info_exclude
[gitdir info exclude
]
399 if {[file readable
$info_exclude]} {
400 lappend ls_others
"--exclude-from=$info_exclude"
408 set ui_status_value
{Scanning
for modified files ...
}
409 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
410 set fd_df
[open
"| git diff-files -z" r
]
411 set fd_lo
[open
$ls_others r
]
413 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
414 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
415 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
416 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
417 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
418 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
421 proc load_message
{file} {
425 if {[file isfile
$f]} {
426 if {[catch
{set fd
[open
$f r
]}]} {
429 set content
[string trim
[read $fd]]
431 regsub
-all -line {[ \r\t]+$
} $content {} content
432 $ui_comm delete
0.0 end
433 $ui_comm insert end
$content
439 proc read_diff_index
{fd after
} {
442 append buf_rdi
[read $fd]
444 set n
[string length
$buf_rdi]
446 set z1
[string first
"\0" $buf_rdi $c]
449 set z2
[string first
"\0" $buf_rdi $z1]
453 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
454 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
456 [encoding convertfrom
$p] \
458 [list
[lindex
$i 0] [lindex
$i 2]] \
464 set buf_rdi
[string range
$buf_rdi $c end
]
469 rescan_done
$fd buf_rdi
$after
472 proc read_diff_files
{fd after
} {
475 append buf_rdf
[read $fd]
477 set n
[string length
$buf_rdf]
479 set z1
[string first
"\0" $buf_rdf $c]
482 set z2
[string first
"\0" $buf_rdf $z1]
486 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
487 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
489 [encoding convertfrom
$p] \
492 [list
[lindex
$i 0] [lindex
$i 2]]
497 set buf_rdf
[string range
$buf_rdf $c end
]
502 rescan_done
$fd buf_rdf
$after
505 proc read_ls_others
{fd after
} {
508 append buf_rlo
[read $fd]
509 set pck
[split $buf_rlo "\0"]
510 set buf_rlo
[lindex
$pck end
]
511 foreach p
[lrange
$pck 0 end-1
] {
512 merge_state
[encoding convertfrom
$p] ?O
514 rescan_done
$fd buf_rlo
$after
517 proc rescan_done
{fd buf after
} {
519 global file_states repo_config
522 if {![eof
$fd]} return
525 if {[incr rescan_active
-1] > 0} return
534 proc prune_selection
{} {
535 global file_states selected_paths
537 foreach path
[array names selected_paths
] {
538 if {[catch
{set still_here
$file_states($path)}]} {
539 unset selected_paths
($path)
544 ######################################################################
549 global ui_diff current_diff_path current_diff_header
550 global ui_index ui_workdir
552 $ui_diff conf
-state normal
553 $ui_diff delete
0.0 end
554 $ui_diff conf
-state disabled
556 set current_diff_path
{}
557 set current_diff_header
{}
559 $ui_index tag remove in_diff
0.0 end
560 $ui_workdir tag remove in_diff
0.0 end
563 proc reshow_diff
{} {
564 global ui_status_value file_states file_lists
565 global current_diff_path current_diff_side
567 set p
$current_diff_path
569 ||
$current_diff_side eq
{}
570 ||
[catch
{set s
$file_states($p)}]
571 ||
[lsearch
-sorted -exact $file_lists($current_diff_side) $p] == -1} {
574 show_diff
$p $current_diff_side
578 proc handle_empty_diff
{} {
579 global current_diff_path file_states file_lists
581 set path
$current_diff_path
582 set s
$file_states($path)
583 if {[lindex
$s 0] ne
{_M
}} return
585 info_popup
"No differences detected.
587 [short_path $path] has no changes.
589 The modification date of this file was updated
590 by another application, but the content within
591 the file was not changed.
593 A rescan will be automatically started to find
594 other files which may have the same state."
597 display_file
$path __
598 rescan
{set ui_status_value
{Ready.
}} 0
601 proc show_diff
{path w
{lno
{}}} {
602 global file_states file_lists
603 global is_3way_diff diff_active repo_config
604 global ui_diff ui_status_value ui_index ui_workdir
605 global current_diff_path current_diff_side current_diff_header
607 if {$diff_active ||
![lock_index
read]} return
611 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
617 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
620 set s
$file_states($path)
624 set current_diff_path
$path
625 set current_diff_side
$w
626 set current_diff_header
{}
627 set ui_status_value
"Loading diff of [escape_path $path]..."
629 # - Git won't give us the diff, there's nothing to compare to!
632 set max_sz
[expr {128 * 1024}]
634 set fd
[open
$path r
]
635 set content
[read $fd $max_sz]
637 set sz
[file size
$path]
641 set ui_status_value
"Unable to display [escape_path $path]"
642 error_popup
"Error loading file:\n\n$err"
645 $ui_diff conf
-state normal
646 if {![catch
{set type [exec file $path]}]} {
647 set n
[string length
$path]
648 if {[string equal
-length $n $path $type]} {
649 set type [string range
$type $n end
]
650 regsub
{^
:?\s
*} $type {} type
652 $ui_diff insert end
"* $type\n" d_@
654 if {[string first
"\0" $content] != -1} {
655 $ui_diff insert end \
656 "* Binary file (not showing content)." \
660 $ui_diff insert end \
661 "* Untracked file is $sz bytes.
662 * Showing only first $max_sz bytes.
665 $ui_diff insert end
$content
667 $ui_diff insert end
"
668 * Untracked file clipped here by [appname].
669 * To see the entire file, use an external editor.
673 $ui_diff conf
-state disabled
676 set ui_status_value
{Ready.
}
681 if {$w eq
$ui_index} {
682 lappend cmd diff-index
684 } elseif
{$w eq
$ui_workdir} {
685 if {[string index
$m 0] eq
{U
}} {
688 lappend cmd diff-files
693 lappend cmd
--no-color
694 if {$repo_config(gui.diffcontext
) > 0} {
695 lappend cmd
"-U$repo_config(gui.diffcontext)"
697 if {$w eq
$ui_index} {
703 if {[catch
{set fd
[open
$cmd r
]} err
]} {
706 set ui_status_value
"Unable to display [escape_path $path]"
707 error_popup
"Error loading diff:\n\n$err"
715 fileevent
$fd readable
[list read_diff
$fd]
718 proc read_diff
{fd
} {
719 global ui_diff ui_status_value diff_active
720 global is_3way_diff current_diff_header
722 $ui_diff conf
-state normal
723 while {[gets
$fd line
] >= 0} {
724 # -- Cleanup uninteresting diff header lines.
726 if { [string match
{diff --git *} $line]
727 ||
[string match
{diff --cc *} $line]
728 ||
[string match
{diff --combined *} $line]
729 ||
[string match
{--- *} $line]
730 ||
[string match
{+++ *} $line]} {
731 append current_diff_header
$line "\n"
734 if {[string match
{index
*} $line]} continue
735 if {$line eq
{deleted
file mode
120000}} {
736 set line
"deleted symlink"
739 # -- Automatically detect if this is a 3 way diff.
741 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
743 if {[string match
{mode
*} $line]
744 ||
[string match
{new
file *} $line]
745 ||
[string match
{deleted
file *} $line]
746 ||
[string match
{Binary files
* and
* differ
} $line]
747 ||
$line eq
{\ No newline
at end of
file}
748 ||
[regexp
{^\
* Unmerged path
} $line]} {
750 } elseif
{$is_3way_diff} {
751 set op
[string range
$line 0 1]
761 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
762 set line
[string replace
$line 0 1 { }]
769 puts
"error: Unhandled 3 way diff marker: {$op}"
774 set op
[string index
$line 0]
780 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
781 set line
[string replace
$line 0 0 { }]
788 puts
"error: Unhandled 2 way diff marker: {$op}"
793 $ui_diff insert end
$line $tags
794 if {[string index
$line end
] eq
"\r"} {
795 $ui_diff tag add d_cr
{end
- 2c
}
797 $ui_diff insert end
"\n" $tags
799 $ui_diff conf
-state disabled
805 set ui_status_value
{Ready.
}
807 if {[$ui_diff index end
] eq
{2.0}} {
813 proc apply_hunk
{x y
} {
814 global current_diff_path current_diff_header current_diff_side
815 global ui_diff ui_index file_states
817 if {$current_diff_path eq
{} ||
$current_diff_header eq
{}} return
818 if {![lock_index apply_hunk
]} return
820 set apply_cmd
{git apply
--cached --whitespace=nowarn
}
821 set mi
[lindex
$file_states($current_diff_path) 0]
822 if {$current_diff_side eq
$ui_index} {
824 lappend apply_cmd
--reverse
825 if {[string index
$mi 0] ne
{M
}} {
831 if {[string index
$mi 1] ne
{M
}} {
837 set s_lno
[lindex
[split [$ui_diff index @
$x,$y] .
] 0]
838 set s_lno
[$ui_diff search
-backwards -regexp ^@@
$s_lno.0 0.0]
844 set e_lno
[$ui_diff search
-forwards -regexp ^@@
"$s_lno + 1 lines" end
]
850 set p
[open
"| $apply_cmd" w
]
851 fconfigure
$p -translation binary
-encoding binary
852 puts
-nonewline $p $current_diff_header
853 puts
-nonewline $p [$ui_diff get
$s_lno $e_lno]
855 error_popup
"Failed to $mode selected hunk.\n\n$err"
860 $ui_diff conf
-state normal
861 $ui_diff delete
$s_lno $e_lno
862 $ui_diff conf
-state disabled
864 if {[$ui_diff get
1.0 end
] eq
"\n"} {
870 if {$current_diff_side eq
$ui_index} {
872 } elseif
{[string index
$mi 0] eq
{_
}} {
878 display_file
$current_diff_path $mi
884 ######################################################################
888 proc load_last_commit
{} {
889 global HEAD PARENT MERGE_HEAD commit_type ui_comm
892 if {[llength
$PARENT] == 0} {
893 error_popup
{There is nothing to amend.
895 You are about to create the initial commit.
896 There is no commit before this to amend.
901 repository_state curType curHEAD curMERGE_HEAD
902 if {$curType eq
{merge
}} {
903 error_popup
{Cannot amend
while merging.
905 You are currently
in the middle of a merge that
906 has not been fully completed. You cannot amend
907 the prior commit unless you first abort the
908 current merge activity.
916 set fd
[open
"| git cat-file commit $curHEAD" r
]
917 fconfigure
$fd -encoding binary
-translation lf
918 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
921 while {[gets
$fd line
] > 0} {
922 if {[string match
{parent
*} $line]} {
923 lappend parents
[string range
$line 7 end
]
924 } elseif
{[string match
{encoding
*} $line]} {
925 set enc
[string tolower
[string range
$line 9 end
]]
928 fconfigure
$fd -encoding $enc
929 set msg
[string trim
[read $fd]]
932 error_popup
"Error loading commit data for amend:\n\n$err"
938 set MERGE_HEAD
[list
]
939 switch
-- [llength
$parents] {
940 0 {set commit_type amend-initial
}
941 1 {set commit_type amend
}
942 default
{set commit_type amend-merge
}
945 $ui_comm delete
0.0 end
946 $ui_comm insert end
$msg
948 $ui_comm edit modified false
949 rescan
{set ui_status_value
{Ready.
}}
952 proc create_new_commit
{} {
953 global commit_type ui_comm
955 set commit_type normal
956 $ui_comm delete
0.0 end
958 $ui_comm edit modified false
959 rescan
{set ui_status_value
{Ready.
}}
962 set GIT_COMMITTER_IDENT
{}
964 proc committer_ident
{} {
965 global GIT_COMMITTER_IDENT
967 if {$GIT_COMMITTER_IDENT eq
{}} {
968 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
969 error_popup
"Unable to obtain your identity:\n\n$err"
972 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
973 $me me GIT_COMMITTER_IDENT
]} {
974 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
979 return $GIT_COMMITTER_IDENT
982 proc commit_tree
{} {
983 global HEAD commit_type file_states ui_comm repo_config
984 global ui_status_value pch_error
986 if {![lock_index update
]} return
987 if {[committer_ident
] eq
{}} return
989 # -- Our in memory state should match the repository.
991 repository_state curType curHEAD curMERGE_HEAD
992 if {[string match amend
* $commit_type]
993 && $curType eq
{normal
}
994 && $curHEAD eq
$HEAD} {
995 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
996 info_popup
{Last scanned state does not match repository state.
998 Another Git program has modified this repository
999 since the last scan. A rescan must be performed
1000 before another commit can be created.
1002 The rescan will be automatically started now.
1005 rescan
{set ui_status_value
{Ready.
}}
1009 # -- At least one file should differ in the index.
1012 foreach path
[array names file_states
] {
1013 switch
-glob -- [lindex
$file_states($path) 0] {
1017 M?
{set files_ready
1}
1019 error_popup
"Unmerged files cannot be committed.
1021 File [short_path $path] has merge conflicts.
1022 You must resolve them and add the file before committing.
1028 error_popup
"Unknown file state [lindex $s 0] detected.
1030 File [short_path $path] cannot be committed by this program.
1035 if {!$files_ready} {
1036 info_popup
{No changes to commit.
1038 You must add
at least
1 file before you can commit.
1044 # -- A message is required.
1046 set msg
[string trim
[$ui_comm get
1.0 end
]]
1047 regsub
-all -line {[ \t\r]+$
} $msg {} msg
1049 error_popup
{Please supply a commit message.
1051 A good commit message has the following format
:
1053 - First line
: Describe
in one sentance what you did.
1054 - Second line
: Blank
1055 - Remaining lines
: Describe why this change is good.
1061 # -- Run the pre-commit hook.
1063 set pchook
[gitdir hooks pre-commit
]
1065 # On Cygwin [file executable] might lie so we need to ask
1066 # the shell if the hook is executable. Yes that's annoying.
1068 if {[is_Windows
] && [file isfile
$pchook]} {
1069 set pchook
[list sh
-c [concat \
1070 "if test -x \"$pchook\";" \
1071 "then exec \"$pchook\" 2>&1;" \
1073 } elseif
{[file executable
$pchook]} {
1074 set pchook
[list
$pchook |
& cat]
1076 commit_writetree
$curHEAD $msg
1080 set ui_status_value
{Calling pre-commit hook...
}
1082 set fd_ph
[open
"| $pchook" r
]
1083 fconfigure
$fd_ph -blocking 0 -translation binary
1084 fileevent
$fd_ph readable \
1085 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
1088 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
1089 global pch_error ui_status_value
1091 append pch_error
[read $fd_ph]
1092 fconfigure
$fd_ph -blocking 1
1094 if {[catch
{close
$fd_ph}]} {
1095 set ui_status_value
{Commit declined by pre-commit hook.
}
1096 hook_failed_popup pre-commit
$pch_error
1099 commit_writetree
$curHEAD $msg
1104 fconfigure
$fd_ph -blocking 0
1107 proc commit_writetree
{curHEAD msg
} {
1108 global ui_status_value
1110 set ui_status_value
{Committing changes...
}
1111 set fd_wt
[open
"| git write-tree" r
]
1112 fileevent
$fd_wt readable \
1113 [list commit_committree
$fd_wt $curHEAD $msg]
1116 proc commit_committree
{fd_wt curHEAD msg
} {
1117 global HEAD PARENT MERGE_HEAD commit_type
1118 global single_commit all_heads current_branch
1119 global ui_status_value ui_comm selected_commit_type
1120 global file_states selected_paths rescan_active
1124 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1125 error_popup
"write-tree failed:\n\n$err"
1126 set ui_status_value
{Commit failed.
}
1131 # -- Build the message.
1133 set msg_p
[gitdir COMMIT_EDITMSG
]
1134 set msg_wt
[open
$msg_p w
]
1135 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1138 fconfigure
$msg_wt -encoding $enc -translation binary
1139 puts
-nonewline $msg_wt $msg
1142 # -- Create the commit.
1144 set cmd
[list git commit-tree
$tree_id]
1145 set parents
[concat
$PARENT $MERGE_HEAD]
1146 if {[llength
$parents] > 0} {
1147 foreach p
$parents {
1151 # git commit-tree writes to stderr during initial commit.
1152 lappend cmd
2>/dev
/null
1155 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1156 error_popup
"commit-tree failed:\n\n$err"
1157 set ui_status_value
{Commit failed.
}
1162 # -- Update the HEAD ref.
1165 if {$commit_type ne
{normal
}} {
1166 append reflogm
" ($commit_type)"
1168 set i
[string first
"\n" $msg]
1170 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1172 append reflogm
{: } $msg
1174 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1175 if {[catch
{eval exec $cmd} err
]} {
1176 error_popup
"update-ref failed:\n\n$err"
1177 set ui_status_value
{Commit failed.
}
1182 # -- Make sure our current branch exists.
1184 if {$commit_type eq
{initial
}} {
1185 lappend all_heads
$current_branch
1186 set all_heads
[lsort
-unique $all_heads]
1187 populate_branch_menu
1190 # -- Cleanup after ourselves.
1192 catch
{file delete
$msg_p}
1193 catch
{file delete
[gitdir MERGE_HEAD
]}
1194 catch
{file delete
[gitdir MERGE_MSG
]}
1195 catch
{file delete
[gitdir SQUASH_MSG
]}
1196 catch
{file delete
[gitdir GITGUI_MSG
]}
1198 # -- Let rerere do its thing.
1200 if {[file isdirectory
[gitdir rr-cache
]]} {
1201 catch
{exec git rerere
}
1204 # -- Run the post-commit hook.
1206 set pchook
[gitdir hooks post-commit
]
1207 if {[is_Windows
] && [file isfile
$pchook]} {
1208 set pchook
[list sh
-c [concat \
1209 "if test -x \"$pchook\";" \
1210 "then exec \"$pchook\";" \
1212 } elseif
{![file executable
$pchook]} {
1215 if {$pchook ne
{}} {
1216 catch
{exec $pchook &}
1219 $ui_comm delete
0.0 end
1221 $ui_comm edit modified false
1223 if {$single_commit} do_quit
1225 # -- Update in memory status
1227 set selected_commit_type new
1228 set commit_type normal
1231 set MERGE_HEAD
[list
]
1233 foreach path
[array names file_states
] {
1234 set s
$file_states($path)
1236 switch
-glob -- $m {
1244 unset file_states
($path)
1245 catch
{unset selected_paths
($path)}
1248 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1254 set file_states
($path) [list \
1255 _
[string index
$m 1] \
1266 set ui_status_value \
1267 "Changes committed as [string range $cmt_id 0 7]."
1270 ######################################################################
1274 proc fetch_from
{remote
} {
1275 set w
[new_console
"fetch $remote" \
1276 "Fetching new changes from $remote"]
1277 set cmd
[list git fetch
]
1279 console_exec
$w $cmd
1282 proc pull_remote
{remote branch
} {
1283 global HEAD commit_type file_states repo_config
1285 if {![lock_index update
]} return
1287 # -- Our in memory state should match the repository.
1289 repository_state curType curHEAD curMERGE_HEAD
1290 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1291 info_popup
{Last scanned state does not match repository state.
1293 Another Git program has modified this repository
1294 since the last scan. A rescan must be performed
1295 before a pull operation can be started.
1297 The rescan will be automatically started now.
1300 rescan
{set ui_status_value
{Ready.
}}
1304 # -- No differences should exist before a pull.
1306 if {[array size file_states
] != 0} {
1307 error_popup
{Uncommitted but modified files are present.
1309 You should not perform a pull with unmodified
1310 files
in your working directory as Git will be
1311 unable to recover from an incorrect merge.
1313 You should commit or revert all changes before
1314 starting a pull operation.
1320 set w
[new_console
"pull $remote $branch" \
1321 "Pulling new changes from branch $branch in $remote"]
1322 set cmd
[list git pull
]
1323 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1324 lappend cmd
--no-summary
1328 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1331 proc post_pull_remote
{remote branch success
} {
1332 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1333 global ui_status_value
1337 repository_state commit_type HEAD MERGE_HEAD
1339 set selected_commit_type new
1340 set ui_status_value
"Pulling $branch from $remote complete."
1342 rescan
[list
set ui_status_value \
1343 "Conflicts detected while pulling $branch from $remote."]
1347 proc push_to
{remote
} {
1348 set w
[new_console
"push $remote" \
1349 "Pushing changes to $remote"]
1350 set cmd
[list git push
]
1352 console_exec
$w $cmd
1355 ######################################################################
1359 proc mapicon
{w state path
} {
1362 if {[catch
{set r
$all_icons($state$w)}]} {
1363 puts
"error: no icon for $w state={$state} $path"
1369 proc mapdesc
{state path
} {
1372 if {[catch
{set r
$all_descs($state)}]} {
1373 puts
"error: no desc for state={$state} $path"
1379 proc escape_path
{path
} {
1380 regsub
-all "\n" $path "\\n" path
1384 proc short_path
{path
} {
1385 return [escape_path
[lindex
[file split $path] end
]]
1389 set null_sha1
[string repeat
0 40]
1391 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1392 global file_states next_icon_id null_sha1
1394 set s0
[string index
$new_state 0]
1395 set s1
[string index
$new_state 1]
1397 if {[catch
{set info
$file_states($path)}]} {
1399 set icon n
[incr next_icon_id
]
1401 set state
[lindex
$info 0]
1402 set icon
[lindex
$info 1]
1403 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1404 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1407 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1408 elseif
{$s0 eq
{_
}} {set s0 _
}
1410 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1411 elseif
{$s1 eq
{_
}} {set s1 _
}
1413 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1414 set head_info
[list
0 $null_sha1]
1415 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1416 && $head_info eq
{}} {
1417 set head_info
$index_info
1420 set file_states
($path) [list
$s0$s1 $icon \
1421 $head_info $index_info \
1426 proc display_file_helper
{w path icon_name old_m new_m
} {
1429 if {$new_m eq
{_
}} {
1430 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1432 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1434 $w conf
-state normal
1435 $w delete
$lno.0 [expr {$lno + 1}].0
1436 $w conf
-state disabled
1438 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1439 lappend file_lists
($w) $path
1440 set file_lists
($w) [lsort
-unique $file_lists($w)]
1441 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1443 $w conf
-state normal
1444 $w image create
$lno.0 \
1445 -align center
-padx 5 -pady 1 \
1447 -image [mapicon
$w $new_m $path]
1448 $w insert
$lno.1 "[escape_path $path]\n"
1449 $w conf
-state disabled
1450 } elseif
{$old_m ne
$new_m} {
1451 $w conf
-state normal
1452 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1453 $w conf
-state disabled
1457 proc display_file
{path state
} {
1458 global file_states selected_paths
1459 global ui_index ui_workdir
1461 set old_m
[merge_state
$path $state]
1462 set s
$file_states($path)
1463 set new_m
[lindex
$s 0]
1464 set icon_name
[lindex
$s 1]
1466 set o
[string index
$old_m 0]
1467 set n
[string index
$new_m 0]
1474 display_file_helper
$ui_index $path $icon_name $o $n
1476 if {[string index
$old_m 0] eq
{U
}} {
1479 set o
[string index
$old_m 1]
1481 if {[string index
$new_m 0] eq
{U
}} {
1484 set n
[string index
$new_m 1]
1486 display_file_helper
$ui_workdir $path $icon_name $o $n
1488 if {$new_m eq
{__
}} {
1489 unset file_states
($path)
1490 catch
{unset selected_paths
($path)}
1494 proc display_all_files_helper
{w path icon_name m
} {
1497 lappend file_lists
($w) $path
1498 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1499 $w image create end \
1500 -align center
-padx 5 -pady 1 \
1502 -image [mapicon
$w $m $path]
1503 $w insert end
"[escape_path $path]\n"
1506 proc display_all_files
{} {
1507 global ui_index ui_workdir
1508 global file_states file_lists
1511 $ui_index conf
-state normal
1512 $ui_workdir conf
-state normal
1514 $ui_index delete
0.0 end
1515 $ui_workdir delete
0.0 end
1518 set file_lists
($ui_index) [list
]
1519 set file_lists
($ui_workdir) [list
]
1521 foreach path
[lsort
[array names file_states
]] {
1522 set s
$file_states($path)
1524 set icon_name
[lindex
$s 1]
1526 set s
[string index
$m 0]
1527 if {$s ne
{U
} && $s ne
{_
}} {
1528 display_all_files_helper
$ui_index $path \
1532 if {[string index
$m 0] eq
{U
}} {
1535 set s
[string index
$m 1]
1538 display_all_files_helper
$ui_workdir $path \
1543 $ui_index conf
-state disabled
1544 $ui_workdir conf
-state disabled
1547 proc update_indexinfo
{msg pathList after
} {
1548 global update_index_cp ui_status_value
1550 if {![lock_index update
]} return
1552 set update_index_cp
0
1553 set pathList
[lsort
$pathList]
1554 set totalCnt
[llength
$pathList]
1555 set batch [expr {int
($totalCnt * .01) + 1}]
1556 if {$batch > 25} {set batch 25}
1558 set ui_status_value
[format \
1559 "$msg... %i/%i files (%.2f%%)" \
1563 set fd
[open
"| git update-index -z --index-info" w
]
1570 fileevent
$fd writable
[list \
1571 write_update_indexinfo \
1581 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1582 global update_index_cp ui_status_value
1583 global file_states current_diff_path
1585 if {$update_index_cp >= $totalCnt} {
1592 for {set i
$batch} \
1593 {$update_index_cp < $totalCnt && $i > 0} \
1595 set path
[lindex
$pathList $update_index_cp]
1596 incr update_index_cp
1598 set s
$file_states($path)
1599 switch
-glob -- [lindex
$s 0] {
1606 set info
[lindex
$s 2]
1607 if {$info eq
{}} continue
1609 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1610 display_file
$path $new
1613 set ui_status_value
[format \
1614 "$msg... %i/%i files (%.2f%%)" \
1617 [expr {100.0 * $update_index_cp / $totalCnt}]]
1620 proc update_index
{msg pathList after
} {
1621 global update_index_cp ui_status_value
1623 if {![lock_index update
]} return
1625 set update_index_cp
0
1626 set pathList
[lsort
$pathList]
1627 set totalCnt
[llength
$pathList]
1628 set batch [expr {int
($totalCnt * .01) + 1}]
1629 if {$batch > 25} {set batch 25}
1631 set ui_status_value
[format \
1632 "$msg... %i/%i files (%.2f%%)" \
1636 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1643 fileevent
$fd writable
[list \
1644 write_update_index \
1654 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1655 global update_index_cp ui_status_value
1656 global file_states current_diff_path
1658 if {$update_index_cp >= $totalCnt} {
1665 for {set i
$batch} \
1666 {$update_index_cp < $totalCnt && $i > 0} \
1668 set path
[lindex
$pathList $update_index_cp]
1669 incr update_index_cp
1671 switch
-glob -- [lindex
$file_states($path) 0] {
1677 if {[file exists
$path]} {
1686 puts
-nonewline $fd "[encoding convertto $path]\0"
1687 display_file
$path $new
1690 set ui_status_value
[format \
1691 "$msg... %i/%i files (%.2f%%)" \
1694 [expr {100.0 * $update_index_cp / $totalCnt}]]
1697 proc checkout_index
{msg pathList after
} {
1698 global update_index_cp ui_status_value
1700 if {![lock_index update
]} return
1702 set update_index_cp
0
1703 set pathList
[lsort
$pathList]
1704 set totalCnt
[llength
$pathList]
1705 set batch [expr {int
($totalCnt * .01) + 1}]
1706 if {$batch > 25} {set batch 25}
1708 set ui_status_value
[format \
1709 "$msg... %i/%i files (%.2f%%)" \
1713 set cmd
[list git checkout-index
]
1719 set fd
[open
"| $cmd " w
]
1726 fileevent
$fd writable
[list \
1727 write_checkout_index \
1737 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1738 global update_index_cp ui_status_value
1739 global file_states current_diff_path
1741 if {$update_index_cp >= $totalCnt} {
1748 for {set i
$batch} \
1749 {$update_index_cp < $totalCnt && $i > 0} \
1751 set path
[lindex
$pathList $update_index_cp]
1752 incr update_index_cp
1753 switch
-glob -- [lindex
$file_states($path) 0] {
1757 puts
-nonewline $fd "[encoding convertto $path]\0"
1758 display_file
$path ?_
1763 set ui_status_value
[format \
1764 "$msg... %i/%i files (%.2f%%)" \
1767 [expr {100.0 * $update_index_cp / $totalCnt}]]
1770 ######################################################################
1772 ## branch management
1774 proc is_tracking_branch
{name
} {
1775 global tracking_branches
1777 if {![catch
{set info
$tracking_branches($name)}]} {
1780 foreach t
[array names tracking_branches
] {
1781 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1788 proc load_all_heads
{} {
1791 set all_heads
[list
]
1792 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1793 while {[gets
$fd line
] > 0} {
1794 if {[is_tracking_branch
$line]} continue
1795 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1796 lappend all_heads
$name
1800 set all_heads
[lsort
$all_heads]
1803 proc populate_branch_menu
{} {
1804 global all_heads disable_on_lock
1807 set last
[$m index last
]
1808 for {set i
0} {$i <= $last} {incr i
} {
1809 if {[$m type $i] eq
{separator
}} {
1812 foreach a
$disable_on_lock {
1813 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1817 set disable_on_lock
$new_dol
1822 if {$all_heads ne
{}} {
1825 foreach b
$all_heads {
1826 $m add radiobutton \
1828 -command [list switch_branch
$b] \
1829 -variable current_branch \
1832 lappend disable_on_lock \
1833 [list
$m entryconf
[$m index last
] -state]
1837 proc all_tracking_branches
{} {
1838 global tracking_branches
1840 set all_trackings
{}
1842 foreach name
[array names tracking_branches
] {
1843 if {[regsub
{/\
*$
} $name {} name
]} {
1846 regsub ^refs
/(heads|remotes
)/ $name {} name
1847 lappend all_trackings
$name
1852 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1853 while {[gets
$fd name
] > 0} {
1854 regsub ^refs
/(heads|remotes
)/ $name {} name
1855 lappend all_trackings
$name
1860 return [lsort
-unique $all_trackings]
1863 proc do_create_branch_action
{w
} {
1864 global all_heads null_sha1 repo_config
1865 global create_branch_checkout create_branch_revtype
1866 global create_branch_head create_branch_trackinghead
1867 global create_branch_name create_branch_revexp
1869 set newbranch
$create_branch_name
1870 if {$newbranch eq
{}
1871 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1875 -title [wm title
$w] \
1877 -message "Please supply a branch name."
1878 focus
$w.desc.name_t
1881 if {![catch
{exec git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1885 -title [wm title
$w] \
1887 -message "Branch '$newbranch' already exists."
1888 focus
$w.desc.name_t
1891 if {[catch
{exec git check-ref-format
"heads/$newbranch"}]} {
1895 -title [wm title
$w] \
1897 -message "We do not like '$newbranch' as a branch name."
1898 focus
$w.desc.name_t
1903 switch
-- $create_branch_revtype {
1904 head {set rev $create_branch_head}
1905 tracking
{set rev $create_branch_trackinghead}
1906 expression
{set rev $create_branch_revexp}
1908 if {[catch
{set cmt
[exec git rev-parse
--verify "${rev}^0"]}]} {
1912 -title [wm title
$w] \
1914 -message "Invalid starting revision: $rev"
1917 set cmd
[list git update-ref
]
1919 lappend cmd
"branch: Created from $rev"
1920 lappend cmd
"refs/heads/$newbranch"
1922 lappend cmd
$null_sha1
1923 if {[catch
{eval exec $cmd} err
]} {
1927 -title [wm title
$w] \
1929 -message "Failed to create '$newbranch'.\n\n$err"
1933 lappend all_heads
$newbranch
1934 set all_heads
[lsort
$all_heads]
1935 populate_branch_menu
1937 if {$create_branch_checkout} {
1938 switch_branch
$newbranch
1942 proc radio_selector
{varname value args
} {
1943 upvar
#0 $varname var
1947 trace add variable create_branch_head
write \
1948 [list radio_selector create_branch_revtype
head]
1949 trace add variable create_branch_trackinghead
write \
1950 [list radio_selector create_branch_revtype tracking
]
1952 trace add variable delete_branch_head
write \
1953 [list radio_selector delete_branch_checktype
head]
1954 trace add variable delete_branch_trackinghead
write \
1955 [list radio_selector delete_branch_checktype tracking
]
1957 proc do_create_branch
{} {
1958 global all_heads current_branch repo_config
1959 global create_branch_checkout create_branch_revtype
1960 global create_branch_head create_branch_trackinghead
1961 global create_branch_name create_branch_revexp
1963 set w .branch_editor
1965 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1967 label
$w.header
-text {Create New Branch
} \
1969 pack
$w.header
-side top
-fill x
1972 button
$w.buttons.create
-text Create \
1975 -command [list do_create_branch_action
$w]
1976 pack
$w.buttons.create
-side right
1977 button
$w.buttons.cancel
-text {Cancel
} \
1979 -command [list destroy
$w]
1980 pack
$w.buttons.cancel
-side right
-padx 5
1981 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1983 labelframe
$w.desc \
1984 -text {Branch Description
} \
1986 label
$w.desc.name_l
-text {Name
:} -font font_ui
1987 entry
$w.desc.name_t \
1991 -textvariable create_branch_name \
1995 if {%d
== 1 && [regexp
{[~^
:?
*\
[\
0- ]} %S
]} {return 0}
1998 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
1999 grid columnconfigure
$w.desc
1 -weight 1
2000 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2002 labelframe
$w.from \
2003 -text {Starting Revision
} \
2005 radiobutton
$w.from.head_r \
2006 -text {Local Branch
:} \
2008 -variable create_branch_revtype \
2010 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2011 grid
$w.from.head_r
$w.from.head_m
-sticky w
2012 set all_trackings
[all_tracking_branches
]
2013 if {$all_trackings ne
{}} {
2014 set create_branch_trackinghead
[lindex
$all_trackings 0]
2015 radiobutton
$w.from.tracking_r \
2016 -text {Tracking Branch
:} \
2018 -variable create_branch_revtype \
2020 eval tk_optionMenu
$w.from.tracking_m \
2021 create_branch_trackinghead \
2023 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2025 radiobutton
$w.from.exp_r \
2026 -text {Revision Expression
:} \
2028 -variable create_branch_revtype \
2030 entry
$w.from.exp_t \
2034 -textvariable create_branch_revexp \
2038 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2039 if {%d
== 1 && [string length
%S
] > 0} {
2040 set create_branch_revtype expression
2044 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2045 grid columnconfigure
$w.from
1 -weight 1
2046 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2048 labelframe
$w.postActions \
2049 -text {Post Creation Actions
} \
2051 checkbutton
$w.postActions.checkout \
2052 -text {Checkout after creation
} \
2053 -variable create_branch_checkout \
2055 pack
$w.postActions.checkout
-anchor nw
2056 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2058 set create_branch_checkout
1
2059 set create_branch_head
$current_branch
2060 set create_branch_revtype
head
2061 set create_branch_name
$repo_config(gui.newbranchtemplate
)
2062 set create_branch_revexp
{}
2064 bind $w <Visibility
> "
2066 $w.desc.name_t icursor end
2067 focus $w.desc.name_t
2069 bind $w <Key-Escape
> "destroy $w"
2070 bind $w <Key-Return
> "do_create_branch_action $w;break"
2071 wm title
$w "[appname] ([reponame]): Create Branch"
2075 proc do_delete_branch_action
{w
} {
2077 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2080 switch
-- $delete_branch_checktype {
2081 head {set check_rev
$delete_branch_head}
2082 tracking
{set check_rev
$delete_branch_trackinghead}
2083 always
{set check_rev
{:none
}}
2085 if {$check_rev eq
{:none
}} {
2087 } elseif
{[catch
{set check_cmt
[exec git rev-parse
--verify "${check_rev}^0"]}]} {
2091 -title [wm title
$w] \
2093 -message "Invalid check revision: $check_rev"
2097 set to_delete
[list
]
2098 set not_merged
[list
]
2099 foreach i
[$w.list.l curselection
] {
2100 set b
[$w.list.l get
$i]
2101 if {[catch
{set o
[exec git rev-parse
--verify $b]}]} continue
2102 if {$check_cmt ne
{}} {
2103 if {$b eq
$check_rev} continue
2104 if {[catch
{set m
[exec git merge-base
$o $check_cmt]}]} continue
2106 lappend not_merged
$b
2110 lappend to_delete
[list
$b $o]
2112 if {$not_merged ne
{}} {
2113 set msg
"The following branches are not completely merged into $check_rev:
2115 - [join $not_merged "\n - "]"
2119 -title [wm title
$w] \
2123 if {$to_delete eq
{}} return
2124 if {$delete_branch_checktype eq
{always
}} {
2125 set msg
{Recovering deleted branches is difficult.
2127 Delete the selected branches?
}
2128 if {[tk_messageBox \
2131 -title [wm title
$w] \
2133 -message $msg] ne
yes} {
2139 foreach i
$to_delete {
2142 if {[catch
{exec git update-ref
-d "refs/heads/$b" $o} err
]} {
2143 append failed
" - $b: $err\n"
2145 set x
[lsearch
-sorted -exact $all_heads $b]
2147 set all_heads
[lreplace
$all_heads $x $x]
2152 if {$failed ne
{}} {
2156 -title [wm title
$w] \
2158 -message "Failed to delete branches:\n$failed"
2161 set all_heads
[lsort
$all_heads]
2162 populate_branch_menu
2166 proc do_delete_branch
{} {
2167 global all_heads tracking_branches current_branch
2168 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2170 set w .branch_editor
2172 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2174 label
$w.header
-text {Delete Local Branch
} \
2176 pack
$w.header
-side top
-fill x
2179 button
$w.buttons.create
-text Delete \
2181 -command [list do_delete_branch_action
$w]
2182 pack
$w.buttons.create
-side right
2183 button
$w.buttons.cancel
-text {Cancel
} \
2185 -command [list destroy
$w]
2186 pack
$w.buttons.cancel
-side right
-padx 5
2187 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2189 labelframe
$w.list \
2190 -text {Local Branches
} \
2195 -selectmode extended \
2197 foreach h
$all_heads {
2198 if {$h ne
$current_branch} {
2199 $w.list.l insert end
$h
2202 pack
$w.list.l
-fill both
-pady 5 -padx 5
2203 pack
$w.list
-fill both
-pady 5 -padx 5
2205 labelframe
$w.validate \
2206 -text {Delete Only If
} \
2208 radiobutton
$w.validate.head_r \
2209 -text {Merged Into Local Branch
:} \
2211 -variable delete_branch_checktype \
2213 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2214 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2215 set all_trackings
[all_tracking_branches
]
2216 if {$all_trackings ne
{}} {
2217 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2218 radiobutton
$w.validate.tracking_r \
2219 -text {Merged Into Tracking Branch
:} \
2221 -variable delete_branch_checktype \
2223 eval tk_optionMenu
$w.validate.tracking_m \
2224 delete_branch_trackinghead \
2226 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2228 radiobutton
$w.validate.always_r \
2229 -text {Always
(Do not perform merge checks
)} \
2231 -variable delete_branch_checktype \
2233 grid
$w.validate.always_r
-columnspan 2 -sticky w
2234 grid columnconfigure
$w.validate
1 -weight 1
2235 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2237 set delete_branch_head
$current_branch
2238 set delete_branch_checktype
head
2240 bind $w <Visibility
> "grab $w; focus $w"
2241 bind $w <Key-Escape
> "destroy $w"
2242 wm title
$w "[appname] ([reponame]): Delete Branch"
2246 proc switch_branch
{new_branch
} {
2247 global HEAD commit_type current_branch repo_config
2249 if {![lock_index switch
]} return
2251 # -- Our in memory state should match the repository.
2253 repository_state curType curHEAD curMERGE_HEAD
2254 if {[string match amend
* $commit_type]
2255 && $curType eq
{normal
}
2256 && $curHEAD eq
$HEAD} {
2257 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2258 info_popup
{Last scanned state does not match repository state.
2260 Another Git program has modified this repository
2261 since the last scan. A rescan must be performed
2262 before the current branch can be changed.
2264 The rescan will be automatically started now.
2267 rescan
{set ui_status_value
{Ready.
}}
2271 # -- Don't do a pointless switch.
2273 if {$current_branch eq
$new_branch} {
2278 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2279 switch_branch_stage2
{} $new_branch
2281 set ui_status_value
{Refreshing
file status...
}
2282 set cmd
[list git update-index
]
2284 lappend cmd
--unmerged
2285 lappend cmd
--ignore-missing
2286 lappend cmd
--refresh
2287 set fd_rf
[open
"| $cmd" r
]
2288 fconfigure
$fd_rf -blocking 0 -translation binary
2289 fileevent
$fd_rf readable \
2290 [list switch_branch_stage2
$fd_rf $new_branch]
2294 proc switch_branch_stage2
{fd_rf new_branch
} {
2295 global ui_status_value HEAD
2299 if {![eof
$fd_rf]} return
2303 set ui_status_value
"Updating working directory to '$new_branch'..."
2304 set cmd
[list git read-tree
]
2307 lappend cmd
--exclude-per-directory=.gitignore
2309 lappend cmd
$new_branch
2310 set fd_rt
[open
"| $cmd" r
]
2311 fconfigure
$fd_rt -blocking 0 -translation binary
2312 fileevent
$fd_rt readable \
2313 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2316 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2317 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2318 global current_branch
2319 global ui_comm ui_status_value
2321 # -- We never get interesting output on stdout; only stderr.
2324 fconfigure
$fd_rt -blocking 1
2325 if {![eof
$fd_rt]} {
2326 fconfigure
$fd_rt -blocking 0
2330 # -- The working directory wasn't in sync with the index and
2331 # we'd have to overwrite something to make the switch. A
2332 # merge is required.
2334 if {[catch
{close
$fd_rt} err
]} {
2335 regsub
{^fatal
: } $err {} err
2336 warn_popup
"File level merge required.
2340 Staying on branch '$current_branch'."
2341 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2346 # -- Update the symbolic ref. Core git doesn't even check for failure
2347 # here, it Just Works(tm). If it doesn't we are in some really ugly
2348 # state that is difficult to recover from within git-gui.
2350 if {[catch
{exec git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2351 error_popup
"Failed to set current branch.
2353 This working directory is only partially switched.
2354 We successfully updated your files, but failed to
2355 update an internal Git file.
2357 This should not have occurred. [appname] will now
2365 # -- Update our repository state. If we were previously in amend mode
2366 # we need to toss the current buffer and do a full rescan to update
2367 # our file lists. If we weren't in amend mode our file lists are
2368 # accurate and we can avoid the rescan.
2371 set selected_commit_type new
2372 if {[string match amend
* $commit_type]} {
2373 $ui_comm delete
0.0 end
2375 $ui_comm edit modified false
2376 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2378 repository_state commit_type HEAD MERGE_HEAD
2380 set ui_status_value
"Checked out branch '$current_branch'."
2384 ######################################################################
2386 ## remote management
2388 proc load_all_remotes
{} {
2390 global all_remotes tracking_branches
2392 set all_remotes
[list
]
2393 array
unset tracking_branches
2395 set rm_dir
[gitdir remotes
]
2396 if {[file isdirectory
$rm_dir]} {
2397 set all_remotes
[glob \
2401 -directory $rm_dir *]
2403 foreach name
$all_remotes {
2405 set fd
[open
[file join $rm_dir $name] r
]
2406 while {[gets
$fd line
] >= 0} {
2407 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2408 $line line src dst
]} continue
2409 if {![regexp ^refs
/ $dst]} {
2410 set dst
"refs/heads/$dst"
2412 set tracking_branches
($dst) [list
$name $src]
2419 foreach line
[array names repo_config remote.
*.url
] {
2420 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2421 lappend all_remotes
$name
2423 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2427 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2428 if {![regexp ^refs
/ $dst]} {
2429 set dst
"refs/heads/$dst"
2431 set tracking_branches
($dst) [list
$name $src]
2435 set all_remotes
[lsort
-unique $all_remotes]
2438 proc populate_fetch_menu
{} {
2439 global all_remotes repo_config
2442 foreach r
$all_remotes {
2444 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2445 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2450 set fd
[open
[gitdir remotes
$r] r
]
2451 while {[gets
$fd n
] >= 0} {
2452 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2463 -label "Fetch from $r..." \
2464 -command [list fetch_from
$r] \
2470 proc populate_push_menu
{} {
2471 global all_remotes repo_config
2475 foreach r
$all_remotes {
2477 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2478 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2483 set fd
[open
[gitdir remotes
$r] r
]
2484 while {[gets
$fd n
] >= 0} {
2485 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2499 -label "Push to $r..." \
2500 -command [list push_to
$r] \
2507 proc start_push_anywhere_action
{w
} {
2508 global push_urltype push_remote push_url push_thin push_tags
2511 switch
-- $push_urltype {
2512 remote
{set r_url
$push_remote}
2513 url
{set r_url
$push_url}
2515 if {$r_url eq
{}} return
2517 set cmd
[list git push
]
2527 foreach i
[$w.
source.l curselection
] {
2528 set b
[$w.
source.l get
$i]
2529 lappend cmd
"refs/heads/$b:refs/heads/$b"
2534 } elseif
{$cnt == 1} {
2540 set cons
[new_console
"push $r_url" "Pushing $cnt $unit to $r_url"]
2541 console_exec
$cons $cmd
2545 trace add variable push_remote
write \
2546 [list radio_selector push_urltype remote
]
2548 proc do_push_anywhere
{} {
2549 global all_heads all_remotes current_branch
2550 global push_urltype push_remote push_url push_thin push_tags
2554 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2556 label
$w.header
-text {Push Branches
} -font font_uibold
2557 pack
$w.header
-side top
-fill x
2560 button
$w.buttons.create
-text Push \
2562 -command [list start_push_anywhere_action
$w]
2563 pack
$w.buttons.create
-side right
2564 button
$w.buttons.cancel
-text {Cancel
} \
2566 -command [list destroy
$w]
2567 pack
$w.buttons.cancel
-side right
-padx 5
2568 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2570 labelframe
$w.
source \
2571 -text {Source Branches
} \
2573 listbox
$w.
source.l \
2576 -selectmode extended \
2578 foreach h
$all_heads {
2579 $w.
source.l insert end
$h
2580 if {$h eq
$current_branch} {
2581 $w.
source.l
select set end
2584 pack
$w.
source.l
-fill both
-pady 5 -padx 5
2585 pack
$w.
source -fill both
-pady 5 -padx 5
2587 labelframe
$w.dest \
2588 -text {Destination Repository
} \
2590 if {$all_remotes ne
{}} {
2591 radiobutton
$w.dest.remote_r \
2594 -variable push_urltype \
2596 eval tk_optionMenu
$w.dest.remote_m push_remote
$all_remotes
2597 grid
$w.dest.remote_r
$w.dest.remote_m
-sticky w
2598 if {[lsearch
-sorted -exact $all_remotes origin
] != -1} {
2599 set push_remote origin
2601 set push_remote
[lindex
$all_remotes 0]
2603 set push_urltype remote
2605 set push_urltype url
2607 radiobutton
$w.dest.url_r \
2608 -text {Arbitrary URL
:} \
2610 -variable push_urltype \
2612 entry
$w.dest.url_t \
2616 -textvariable push_url \
2620 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2621 if {%d
== 1 && [string length
%S
] > 0} {
2622 set push_urltype url
2626 grid
$w.dest.url_r
$w.dest.url_t
-sticky we
-padx {0 5}
2627 grid columnconfigure
$w.dest
1 -weight 1
2628 pack
$w.dest
-anchor nw
-fill x
-pady 5 -padx 5
2630 labelframe
$w.options \
2631 -text {Transfer Options
} \
2633 checkbutton
$w.options.thin \
2634 -text {Use thin pack
(for slow network connections
)} \
2635 -variable push_thin \
2637 grid
$w.options.thin
-columnspan 2 -sticky w
2638 checkbutton
$w.options.tags \
2639 -text {Include tags
} \
2640 -variable push_tags \
2642 grid
$w.options.tags
-columnspan 2 -sticky w
2643 grid columnconfigure
$w.options
1 -weight 1
2644 pack
$w.options
-anchor nw
-fill x
-pady 5 -padx 5
2650 bind $w <Visibility
> "grab $w"
2651 bind $w <Key-Escape
> "destroy $w"
2652 wm title
$w "[appname] ([reponame]): Push"
2656 ######################################################################
2661 #define mask_width 14
2662 #define mask_height 15
2663 static unsigned char mask_bits
[] = {
2664 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2665 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2666 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2669 image create bitmap file_plain
-background white
-foreground black
-data {
2670 #define plain_width 14
2671 #define plain_height 15
2672 static unsigned char plain_bits
[] = {
2673 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2674 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2675 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2676 } -maskdata $filemask
2678 image create bitmap file_mod
-background white
-foreground blue
-data {
2679 #define mod_width 14
2680 #define mod_height 15
2681 static unsigned char mod_bits
[] = {
2682 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2683 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2684 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2685 } -maskdata $filemask
2687 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
2688 #define file_fulltick_width 14
2689 #define file_fulltick_height 15
2690 static unsigned char file_fulltick_bits
[] = {
2691 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2692 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2693 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2694 } -maskdata $filemask
2696 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
2697 #define parttick_width 14
2698 #define parttick_height 15
2699 static unsigned char parttick_bits
[] = {
2700 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2701 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2702 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2703 } -maskdata $filemask
2705 image create bitmap file_question
-background white
-foreground black
-data {
2706 #define file_question_width 14
2707 #define file_question_height 15
2708 static unsigned char file_question_bits
[] = {
2709 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2710 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2711 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2712 } -maskdata $filemask
2714 image create bitmap file_removed
-background white
-foreground red
-data {
2715 #define file_removed_width 14
2716 #define file_removed_height 15
2717 static unsigned char file_removed_bits
[] = {
2718 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2719 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2720 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2721 } -maskdata $filemask
2723 image create bitmap file_merge
-background white
-foreground blue
-data {
2724 #define file_merge_width 14
2725 #define file_merge_height 15
2726 static unsigned char file_merge_bits
[] = {
2727 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2728 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2729 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2730 } -maskdata $filemask
2732 set ui_index .vpane.files.index.list
2733 set ui_workdir .vpane.files.workdir.list
2735 set all_icons
(_
$ui_index) file_plain
2736 set all_icons
(A
$ui_index) file_fulltick
2737 set all_icons
(M
$ui_index) file_fulltick
2738 set all_icons
(D
$ui_index) file_removed
2739 set all_icons
(U
$ui_index) file_merge
2741 set all_icons
(_
$ui_workdir) file_plain
2742 set all_icons
(M
$ui_workdir) file_mod
2743 set all_icons
(D
$ui_workdir) file_question
2744 set all_icons
(U
$ui_workdir) file_merge
2745 set all_icons
(O
$ui_workdir) file_plain
2747 set max_status_desc
0
2751 {_M
"Modified, not staged"}
2752 {M_
"Staged for commit"}
2753 {MM
"Portions staged for commit"}
2754 {MD
"Staged for commit, missing"}
2756 {_O
"Untracked, not staged"}
2757 {A_
"Staged for commit"}
2758 {AM
"Portions staged for commit"}
2759 {AD
"Staged for commit, missing"}
2762 {D_
"Staged for removal"}
2763 {DO
"Staged for removal, still present"}
2765 {U_
"Requires merge resolution"}
2766 {UU
"Requires merge resolution"}
2767 {UM
"Requires merge resolution"}
2768 {UD
"Requires merge resolution"}
2770 if {$max_status_desc < [string length
[lindex
$i 1]]} {
2771 set max_status_desc
[string length
[lindex
$i 1]]
2773 set all_descs
([lindex
$i 0]) [lindex
$i 1]
2777 ######################################################################
2782 global tcl_platform tk_library
2783 if {[tk windowingsystem
] eq
{aqua
}} {
2789 proc is_Windows
{} {
2791 if {$tcl_platform(platform
) eq
{windows
}} {
2797 proc bind_button3
{w cmd
} {
2798 bind $w <Any-Button-3
> $cmd
2800 bind $w <Control-Button-1
> $cmd
2804 proc incr_font_size
{font
{amt
1}} {
2805 set sz
[font configure
$font -size]
2807 font configure
$font -size $sz
2808 font configure
${font}bold
-size $sz
2811 proc hook_failed_popup
{hook msg
} {
2816 label
$w.m.l1
-text "$hook hook failed:" \
2821 -background white
-borderwidth 1 \
2823 -width 80 -height 10 \
2825 -yscrollcommand [list
$w.m.sby
set]
2827 -text {You must correct the above errors before committing.
} \
2831 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2832 pack
$w.m.l1
-side top
-fill x
2833 pack
$w.m.l2
-side bottom
-fill x
2834 pack
$w.m.sby
-side right
-fill y
2835 pack
$w.m.t
-side left
-fill both
-expand 1
2836 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2838 $w.m.t insert
1.0 $msg
2839 $w.m.t conf
-state disabled
2841 button
$w.ok
-text OK \
2844 -command "destroy $w"
2845 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2847 bind $w <Visibility
> "grab $w; focus $w"
2848 bind $w <Key-Return
> "destroy $w"
2849 wm title
$w "[appname] ([reponame]): error"
2853 set next_console_id
0
2855 proc new_console
{short_title long_title
} {
2856 global next_console_id console_data
2857 set w .console
[incr next_console_id
]
2858 set console_data
($w) [list
$short_title $long_title]
2859 return [console_init
$w]
2862 proc console_init
{w
} {
2863 global console_cr console_data M1B
2865 set console_cr
($w) 1.0
2868 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
2873 -background white
-borderwidth 1 \
2875 -width 80 -height 10 \
2878 -yscrollcommand [list
$w.m.sby
set]
2879 label
$w.m.s
-text {Working... please
wait...
} \
2883 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2884 pack
$w.m.l1
-side top
-fill x
2885 pack
$w.m.s
-side bottom
-fill x
2886 pack
$w.m.sby
-side right
-fill y
2887 pack
$w.m.t
-side left
-fill both
-expand 1
2888 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2890 menu
$w.ctxm
-tearoff 0
2891 $w.ctxm add
command -label "Copy" \
2893 -command "tk_textCopy $w.m.t"
2894 $w.ctxm add
command -label "Select All" \
2896 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
2897 $w.ctxm add
command -label "Copy All" \
2900 $w.m.t tag add sel 0.0 end
2902 $w.m.t tag remove sel 0.0 end
2905 button
$w.ok
-text {Close
} \
2908 -command "destroy $w"
2909 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2911 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
2912 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2913 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2914 bind $w <Visibility
> "focus $w"
2915 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2919 proc console_exec
{w cmd
{after
{}}} {
2920 # -- Windows tosses the enviroment when we exec our child.
2921 # But most users need that so we have to relogin. :-(
2924 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
2927 # -- Tcl won't let us redirect both stdout and stderr to
2928 # the same pipe. So pass it through cat...
2930 set cmd
[concat |
$cmd |
& cat]
2932 set fd_f
[open
$cmd r
]
2933 fconfigure
$fd_f -blocking 0 -translation binary
2934 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
2937 proc console_read
{w fd after
} {
2938 global console_cr console_data
2942 if {![winfo exists
$w]} {console_init
$w}
2943 $w.m.t conf
-state normal
2945 set n
[string length
$buf]
2947 set cr
[string first
"\r" $buf $c]
2948 set lf
[string first
"\n" $buf $c]
2949 if {$cr < 0} {set cr
[expr {$n + 1}]}
2950 if {$lf < 0} {set lf
[expr {$n + 1}]}
2953 $w.m.t insert end
[string range
$buf $c $lf]
2954 set console_cr
($w) [$w.m.t index
{end
-1c}]
2958 $w.m.t delete
$console_cr($w) end
2959 $w.m.t insert end
"\n"
2960 $w.m.t insert end
[string range
$buf $c $cr]
2965 $w.m.t conf
-state disabled
2969 fconfigure
$fd -blocking 1
2971 if {[catch
{close
$fd}]} {
2972 if {![winfo exists
$w]} {console_init
$w}
2973 $w.m.s conf
-background red
-text {Error
: Command Failed
}
2974 $w.ok conf
-state normal
2976 } elseif
{[winfo exists
$w]} {
2977 $w.m.s conf
-background green
-text {Success
}
2978 $w.ok conf
-state normal
2981 array
unset console_cr
$w
2982 array
unset console_data
$w
2984 uplevel
#0 $after $ok
2988 fconfigure
$fd -blocking 0
2991 ######################################################################
2995 set starting_gitk_msg
{Starting gitk... please
wait...
}
2997 proc do_gitk
{revs
} {
2998 global ui_status_value starting_gitk_msg
3006 set cmd
"sh -c \"exec $cmd\""
3010 if {[catch
{eval exec $cmd} err
]} {
3011 error_popup
"Failed to start gitk:\n\n$err"
3013 set ui_status_value
$starting_gitk_msg
3015 if {$ui_status_value eq
$starting_gitk_msg} {
3016 set ui_status_value
{Ready.
}
3023 set fd
[open
"| git count-objects -v" r
]
3024 while {[gets
$fd line
] > 0} {
3025 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
3026 set stats
($name) $value
3032 foreach p
[glob
-directory [gitdir objects pack
] \
3035 incr packed_sz
[file size
$p]
3037 if {$packed_sz > 0} {
3038 set stats
(size-pack
) [expr {$packed_sz / 1024}]
3043 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3045 label
$w.header
-text {Database Statistics
} \
3047 pack
$w.header
-side top
-fill x
3049 frame
$w.buttons
-border 1
3050 button
$w.buttons.close
-text Close \
3052 -command [list destroy
$w]
3053 button
$w.buttons.gc
-text {Compress Database
} \
3055 -command "destroy $w;do_gc"
3056 pack
$w.buttons.close
-side right
3057 pack
$w.buttons.gc
-side left
3058 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3060 frame
$w.stat
-borderwidth 1 -relief solid
3062 {count
{Number of loose objects
}}
3063 {size
{Disk space used by loose objects
} { KiB
}}
3064 {in-pack
{Number of packed objects
}}
3065 {packs
{Number of packs
}}
3066 {size-pack
{Disk space used by packed objects
} { KiB
}}
3067 {prune-packable
{Packed objects waiting
for pruning
}}
3068 {garbage
{Garbage files
}}
3070 set name
[lindex
$s 0]
3071 set label
[lindex
$s 1]
3072 if {[catch
{set value
$stats($name)}]} continue
3073 if {[llength
$s] > 2} {
3074 set value
"$value[lindex $s 2]"
3077 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
3078 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
3079 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
3081 pack
$w.stat
-pady 10 -padx 10
3083 bind $w <Visibility
> "grab $w; focus $w"
3084 bind $w <Key-Escape
> [list destroy
$w]
3085 bind $w <Key-Return
> [list destroy
$w]
3086 wm title
$w "[appname] ([reponame]): Database Statistics"
3091 set w
[new_console
{gc
} {Compressing the object database
}]
3092 console_exec
$w {git gc
}
3095 proc do_fsck_objects
{} {
3096 set w
[new_console
{fsck-objects
} \
3097 {Verifying the object database with fsck-objects
}]
3098 set cmd
[list git fsck-objects
]
3101 lappend cmd
--strict
3102 console_exec
$w $cmd
3108 global ui_comm is_quitting repo_config commit_type
3110 if {$is_quitting} return
3113 # -- Stash our current commit buffer.
3115 set save
[gitdir GITGUI_MSG
]
3116 set msg
[string trim
[$ui_comm get
0.0 end
]]
3117 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3118 if {(![string match amend
* $commit_type]
3119 ||
[$ui_comm edit modified
])
3122 set fd
[open
$save w
]
3123 puts
-nonewline $fd $msg
3127 catch
{file delete
$save}
3130 # -- Stash our current window geometry into this repository.
3132 set cfg_geometry
[list
]
3133 lappend cfg_geometry
[wm geometry .
]
3134 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
3135 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
3136 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
3139 if {$cfg_geometry ne
$rc_geometry} {
3140 catch
{exec git repo-config gui.geometry
$cfg_geometry}
3147 rescan
{set ui_status_value
{Ready.
}}
3150 proc unstage_helper
{txt paths
} {
3151 global file_states current_diff_path
3153 if {![lock_index begin-update
]} return
3157 foreach path
$paths {
3158 switch
-glob -- [lindex
$file_states($path) 0] {
3162 lappend pathList
$path
3163 if {$path eq
$current_diff_path} {
3164 set after
{reshow_diff
;}
3169 if {$pathList eq
{}} {
3175 [concat
$after {set ui_status_value
{Ready.
}}]
3179 proc do_unstage_selection
{} {
3180 global current_diff_path selected_paths
3182 if {[array size selected_paths
] > 0} {
3184 {Unstaging selected files from commit
} \
3185 [array names selected_paths
]
3186 } elseif
{$current_diff_path ne
{}} {
3188 "Unstaging [short_path $current_diff_path] from commit" \
3189 [list
$current_diff_path]
3193 proc add_helper
{txt paths
} {
3194 global file_states current_diff_path
3196 if {![lock_index begin-update
]} return
3200 foreach path
$paths {
3201 switch
-glob -- [lindex
$file_states($path) 0] {
3206 lappend pathList
$path
3207 if {$path eq
$current_diff_path} {
3208 set after
{reshow_diff
;}
3213 if {$pathList eq
{}} {
3219 [concat
$after {set ui_status_value
{Ready to commit.
}}]
3223 proc do_add_selection
{} {
3224 global current_diff_path selected_paths
3226 if {[array size selected_paths
] > 0} {
3228 {Adding selected files
} \
3229 [array names selected_paths
]
3230 } elseif
{$current_diff_path ne
{}} {
3232 "Adding [short_path $current_diff_path]" \
3233 [list
$current_diff_path]
3237 proc do_add_all
{} {
3241 foreach path
[array names file_states
] {
3242 switch
-glob -- [lindex
$file_states($path) 0] {
3245 ?D
{lappend paths
$path}
3248 add_helper
{Adding all changed files
} $paths
3251 proc revert_helper
{txt paths
} {
3252 global file_states current_diff_path
3254 if {![lock_index begin-update
]} return
3258 foreach path
$paths {
3259 switch
-glob -- [lindex
$file_states($path) 0] {
3263 lappend pathList
$path
3264 if {$path eq
$current_diff_path} {
3265 set after
{reshow_diff
;}
3271 set n
[llength
$pathList]
3275 } elseif
{$n == 1} {
3276 set s
"[short_path [lindex $pathList]]"
3278 set s
"these $n files"
3281 set reply
[tk_dialog \
3283 "[appname] ([reponame])" \
3284 "Revert changes in $s?
3286 Any unadded changes will be permanently lost by the revert." \
3296 [concat
$after {set ui_status_value
{Ready.
}}]
3302 proc do_revert_selection
{} {
3303 global current_diff_path selected_paths
3305 if {[array size selected_paths
] > 0} {
3307 {Reverting selected files
} \
3308 [array names selected_paths
]
3309 } elseif
{$current_diff_path ne
{}} {
3311 "Reverting [short_path $current_diff_path]" \
3312 [list
$current_diff_path]
3316 proc do_signoff
{} {
3319 set me
[committer_ident
]
3320 if {$me eq
{}} return
3322 set sob
"Signed-off-by: $me"
3323 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
3324 if {$last ne
$sob} {
3325 $ui_comm edit separator
3327 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
3328 $ui_comm insert end
"\n"
3330 $ui_comm insert end
"\n$sob"
3331 $ui_comm edit separator
3336 proc do_select_commit_type
{} {
3337 global commit_type selected_commit_type
3339 if {$selected_commit_type eq
{new
}
3340 && [string match amend
* $commit_type]} {
3342 } elseif
{$selected_commit_type eq
{amend
}
3343 && ![string match amend
* $commit_type]} {
3346 # The amend request was rejected...
3348 if {![string match amend
* $commit_type]} {
3349 set selected_commit_type new
3359 global appvers copyright
3360 global tcl_patchLevel tk_patchLevel
3364 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3366 label
$w.header
-text "About [appname]" \
3368 pack
$w.header
-side top
-fill x
3371 button
$w.buttons.close
-text {Close
} \
3373 -command [list destroy
$w]
3374 pack
$w.buttons.close
-side right
3375 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3378 -text "[appname] - a commit creation tool for Git.
3386 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
3389 append v
"[appname] version $appvers\n"
3390 append v
"[exec git version]\n"
3392 if {$tcl_patchLevel eq
$tk_patchLevel} {
3393 append v
"Tcl/Tk version $tcl_patchLevel"
3395 append v
"Tcl version $tcl_patchLevel"
3396 append v
", Tk version $tk_patchLevel"
3407 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
3409 menu
$w.ctxm
-tearoff 0
3410 $w.ctxm add
command \
3415 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3418 bind $w <Visibility
> "grab $w; focus $w"
3419 bind $w <Key-Escape
> "destroy $w"
3420 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3421 wm title
$w "About [appname]"
3425 proc do_options
{} {
3426 global repo_config global_config font_descs
3427 global repo_config_new global_config_new
3429 array
unset repo_config_new
3430 array
unset global_config_new
3431 foreach name
[array names repo_config
] {
3432 set repo_config_new
($name) $repo_config($name)
3435 foreach name
[array names repo_config
] {
3437 gui.diffcontext
{continue}
3439 set repo_config_new
($name) $repo_config($name)
3441 foreach name
[array names global_config
] {
3442 set global_config_new
($name) $global_config($name)
3445 set w .options_editor
3447 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3449 label
$w.header
-text "[appname] Options" \
3451 pack
$w.header
-side top
-fill x
3454 button
$w.buttons.restore
-text {Restore Defaults
} \
3456 -command do_restore_defaults
3457 pack
$w.buttons.restore
-side left
3458 button
$w.buttons.save
-text Save \
3460 -command [list do_save_config
$w]
3461 pack
$w.buttons.save
-side right
3462 button
$w.buttons.cancel
-text {Cancel
} \
3464 -command [list destroy
$w]
3465 pack
$w.buttons.cancel
-side right
-padx 5
3466 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3468 labelframe
$w.repo
-text "[reponame] Repository" \
3470 labelframe
$w.global
-text {Global
(All Repositories
)} \
3472 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
3473 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
3476 {b pullsummary
{Show Pull Summary
}}
3477 {b trustmtime
{Trust File Modification Timestamps
}}
3478 {i diffcontext
{Number of Diff Context Lines
}}
3479 {t newbranchtemplate
{New Branch Name Template
}}
3481 set type [lindex
$option 0]
3482 set name
[lindex
$option 1]
3483 set text
[lindex
$option 2]
3484 foreach f
{repo global
} {
3487 checkbutton
$w.
$f.
$name -text $text \
3488 -variable ${f}_config_new
(gui.
$name) \
3492 pack
$w.
$f.
$name -side top
-anchor w
3496 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
3497 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
3498 spinbox
$w.
$f.
$name.v \
3499 -textvariable ${f}_config_new
(gui.
$name) \
3500 -from 1 -to 99 -increment 1 \
3503 bind $w.
$f.
$name.v
<FocusIn
> {%W selection range
0 end
}
3504 pack
$w.
$f.
$name.v
-side right
-anchor e
-padx 5
3505 pack
$w.
$f.
$name -side top
-anchor w
-fill x
3509 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
3510 entry
$w.
$f.
$name.v \
3514 -textvariable ${f}_config_new
(gui.
$name) \
3516 pack
$w.
$f.
$name.l
-side left
-anchor w
3517 pack
$w.
$f.
$name.v
-side left
-anchor w \
3520 pack
$w.
$f.
$name -side top
-anchor w
-fill x
3526 set all_fonts
[lsort
[font families
]]
3527 foreach option
$font_descs {
3528 set name
[lindex
$option 0]
3529 set font
[lindex
$option 1]
3530 set text
[lindex
$option 2]
3532 set global_config_new
(gui.
$font^^family
) \
3533 [font configure
$font -family]
3534 set global_config_new
(gui.
$font^^size
) \
3535 [font configure
$font -size]
3537 frame
$w.global.
$name
3538 label
$w.global.
$name.l
-text "$text:" -font font_ui
3539 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
3540 eval tk_optionMenu
$w.global.
$name.family \
3541 global_config_new
(gui.
$font^^family
) \
3543 spinbox
$w.global.
$name.size \
3544 -textvariable global_config_new
(gui.
$font^^size
) \
3545 -from 2 -to 80 -increment 1 \
3548 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
3549 pack
$w.global.
$name.size
-side right
-anchor e
3550 pack
$w.global.
$name.family
-side right
-anchor e
3551 pack
$w.global.
$name -side top
-anchor w
-fill x
3554 bind $w <Visibility
> "grab $w; focus $w"
3555 bind $w <Key-Escape
> "destroy $w"
3556 wm title
$w "[appname] ([reponame]): Options"
3560 proc do_restore_defaults
{} {
3561 global font_descs default_config repo_config
3562 global repo_config_new global_config_new
3564 foreach name
[array names default_config
] {
3565 set repo_config_new
($name) $default_config($name)
3566 set global_config_new
($name) $default_config($name)
3569 foreach option
$font_descs {
3570 set name
[lindex
$option 0]
3571 set repo_config
(gui.
$name) $default_config(gui.
$name)
3575 foreach option
$font_descs {
3576 set name
[lindex
$option 0]
3577 set font
[lindex
$option 1]
3578 set global_config_new
(gui.
$font^^family
) \
3579 [font configure
$font -family]
3580 set global_config_new
(gui.
$font^^size
) \
3581 [font configure
$font -size]
3585 proc do_save_config
{w
} {
3586 if {[catch
{save_config
} err
]} {
3587 error_popup
"Failed to completely save options:\n\n$err"
3593 proc do_windows_shortcut
{} {
3597 set desktop
[exec cygpath \
3605 set fn
[tk_getSaveFile \
3607 -title "[appname] ([reponame]): Create Desktop Icon" \
3608 -initialdir $desktop \
3609 -initialfile "Git [reponame].bat"]
3613 set sh
[exec cygpath \
3617 set me
[exec cygpath \
3621 set gd
[exec cygpath \
3625 set gw
[exec cygpath \
3628 [file dirname [gitdir
]]]
3629 regsub
-all ' $me "'\\''" me
3630 regsub -all ' $gd "'\\''" gd
3631 puts $fd "@ECHO Entering $gw"
3632 puts $fd "@ECHO Starting git-gui... please wait..."
3633 puts -nonewline $fd "@\"$sh\" --login -c \""
3634 puts -nonewline $fd "GIT_DIR='$gd'"
3635 puts -nonewline $fd " '$me'"
3639 error_popup "Cannot write script:\n\n$err"
3644 proc do_macosx_app {} {
3647 set fn [tk_getSaveFile \
3649 -title "[appname] ([reponame]): Create Desktop Icon" \
3650 -initialdir [file join $env(HOME) Desktop] \
3651 -initialfile "Git [reponame].app"]
3654 set Contents [file join $fn Contents]
3655 set MacOS [file join $Contents MacOS]
3656 set exe [file join $MacOS git-gui]
3660 set fd [open [file join $Contents Info.plist] w]
3661 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3662 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3663 <plist version="1.0">
3665 <key>CFBundleDevelopmentRegion</key>
3666 <string>English</string>
3667 <key>CFBundleExecutable</key>
3668 <string>git-gui</string>
3669 <key>CFBundleIdentifier</key>
3670 <string>org.spearce.git-gui</string>
3671 <key>CFBundleInfoDictionaryVersion</key>
3672 <string>6.0</string>
3673 <key>CFBundlePackageType</key>
3674 <string>APPL</string>
3675 <key>CFBundleSignature</key>
3676 <string>????</string>
3677 <key>CFBundleVersion</key>
3678 <string>1.0</string>
3679 <key>NSPrincipalClass</key>
3680 <string>NSApplication</string>
3685 set fd [open $exe w]
3686 set gd [file normalize [gitdir]]
3687 set ep [file normalize [exec git --exec-path]]
3688 regsub -all ' $gd "'\\''" gd
3689 regsub
-all ' $ep "'\\''" ep
3690 puts $fd "#!/bin/sh"
3691 foreach name
[array names env
] {
3692 if {[string match GIT_
* $name]} {
3693 regsub
-all ' $env($name) "'\\''" v
3694 puts $fd "export $name='$v'"
3697 puts $fd "export PATH
='$ep':\
$PATH"
3698 puts $fd "export GIT_DIR
='$gd'"
3699 puts $fd "exec [file normalize
$argv0]"
3702 file attributes $exe -permissions u+x,g+x,o+x
3704 error_popup "Cannot
write icon
:\n\n$err"
3709 proc toggle_or_diff {w x y} {
3710 global file_states file_lists current_diff_path ui_index ui_workdir
3711 global last_clicked selected_paths
3713 set pos [split [$w index @$x,$y] .]
3714 set lno [lindex $pos 0]
3715 set col [lindex $pos 1]
3716 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3722 set last_clicked [list $w $lno]
3723 array unset selected_paths
3724 $ui_index tag remove in_sel 0.0 end
3725 $ui_workdir tag remove in_sel 0.0 end
3728 if {$current_diff_path eq $path} {
3729 set after {reshow_diff;}
3733 if {$w eq $ui_index} {
3735 "Unstaging
[short_path
$path] from commit
" \
3737 [concat $after {set ui_status_value {Ready.}}]
3738 } elseif {$w eq $ui_workdir} {
3740 "Adding
[short_path
$path]" \
3742 [concat $after {set ui_status_value {Ready.}}]
3745 show_diff $path $w $lno
3749 proc add_one_to_selection {w x y} {
3750 global file_lists last_clicked selected_paths
3752 set lno [lindex [split [$w index @$x,$y] .] 0]
3753 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3759 if {$last_clicked ne {}
3760 && [lindex $last_clicked 0] ne $w} {
3761 array unset selected_paths
3762 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3765 set last_clicked [list $w $lno]
3766 if {[catch {set in_sel $selected_paths($path)}]} {
3770 unset selected_paths($path)
3771 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3773 set selected_paths($path) 1
3774 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3778 proc add_range_to_selection {w x y} {
3779 global file_lists last_clicked selected_paths
3781 if {[lindex $last_clicked 0] ne $w} {
3782 toggle_or_diff $w $x $y
3786 set lno [lindex [split [$w index @$x,$y] .] 0]
3787 set lc [lindex $last_clicked 1]
3796 foreach path [lrange $file_lists($w) \
3797 [expr {$begin - 1}] \
3798 [expr {$end - 1}]] {
3799 set selected_paths($path) 1
3801 $w tag add in_sel $begin.0 [expr {$end + 1}].0
3804 ######################################################################
3808 set cursor_ptr arrow
3809 font create font_diff -family Courier -size 10
3813 eval font configure font_ui [font actual [.dummy cget -font]]
3817 font create font_uibold
3818 font create font_diffbold
3823 } elseif {[is_MacOSX]} {
3831 proc apply_config {} {
3832 global repo_config font_descs
3834 foreach option $font_descs {
3835 set name [lindex $option 0]
3836 set font [lindex $option 1]
3838 foreach {cn cv} $repo_config(gui.$name) {
3839 font configure $font $cn $cv
3842 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
3844 foreach {cn cv} [font configure $font] {
3845 font configure ${font}bold $cn $cv
3847 font configure ${font}bold -weight bold
3851 set default_config(gui.trustmtime) false
3852 set default_config(gui.pullsummary) true
3853 set default_config(gui.diffcontext) 5
3854 set default_config(gui.newbranchtemplate) {}
3855 set default_config(gui.fontui) [font configure font_ui]
3856 set default_config(gui.fontdiff) [font configure font_diff]
3858 {fontui font_ui {Main Font}}
3859 {fontdiff font_diff {Diff/Console Font}}
3864 ######################################################################
3870 menu .mbar -tearoff 0
3871 .mbar add cascade -label Repository -menu .mbar.repository
3872 .mbar add cascade -label Edit -menu .mbar.edit
3873 if {!$single_commit} {
3874 .mbar add cascade -label Branch -menu .mbar.branch
3876 .mbar add cascade -label Commit -menu .mbar.commit
3877 if {!$single_commit} {
3878 .mbar add cascade -label Fetch -menu .mbar.fetch
3879 .mbar add cascade -label Push -menu .mbar.push
3881 . configure -menu .mbar
3883 # -- Repository Menu
3885 menu .mbar.repository
3886 .mbar.repository add command \
3887 -label {Visualize Current Branch} \
3888 -command {do_gitk {}} \
3890 .mbar.repository add command \
3891 -label {Visualize All Branches} \
3892 -command {do_gitk {--all}} \
3894 .mbar.repository add separator
3896 if {!$single_commit} {
3897 .mbar.repository add command -label {Database Statistics} \
3901 .mbar.repository add command -label {Compress Database} \
3905 .mbar.repository add command -label {Verify Database} \
3906 -command do_fsck_objects \
3909 .mbar.repository add separator
3912 .mbar.repository add command \
3913 -label {Create Desktop Icon} \
3914 -command do_windows_shortcut \
3916 } elseif {[is_MacOSX]} {
3917 .mbar.repository add command \
3918 -label {Create Desktop Icon} \
3919 -command do_macosx_app \
3924 .mbar.repository add command -label Quit \
3926 -accelerator $M1T-Q \
3932 .mbar.edit add command -label Undo \
3933 -command {catch {[focus] edit undo}} \
3934 -accelerator $M1T-Z \
3936 .mbar.edit add command -label Redo \
3937 -command {catch {[focus] edit redo}} \
3938 -accelerator $M1T-Y \
3940 .mbar.edit add separator
3941 .mbar.edit add command -label Cut \
3942 -command {catch {tk_textCut [focus]}} \
3943 -accelerator $M1T-X \
3945 .mbar.edit add command -label Copy \
3946 -command {catch {tk_textCopy [focus]}} \
3947 -accelerator $M1T-C \
3949 .mbar.edit add command -label Paste \
3950 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3951 -accelerator $M1T-V \
3953 .mbar.edit add command -label Delete \
3954 -command {catch {[focus] delete sel.first sel.last}} \
3957 .mbar.edit add separator
3958 .mbar.edit add command -label {Select All} \
3959 -command {catch {[focus] tag add sel 0.0 end}} \
3960 -accelerator $M1T-A \
3965 if {!$single_commit} {
3968 .mbar.branch add command -label {Create...} \
3969 -command do_create_branch \
3970 -accelerator $M1T-N \
3972 lappend disable_on_lock [list .mbar.branch entryconf \
3973 [.mbar.branch index last] -state]
3975 .mbar.branch add command -label {Delete...} \
3976 -command do_delete_branch \
3978 lappend disable_on_lock [list .mbar.branch entryconf \
3979 [.mbar.branch index last] -state]
3986 .mbar.commit add radiobutton \
3987 -label {New Commit} \
3988 -command do_select_commit_type \
3989 -variable selected_commit_type \
3992 lappend disable_on_lock \
3993 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3995 .mbar.commit add radiobutton \
3996 -label {Amend Last Commit} \
3997 -command do_select_commit_type \
3998 -variable selected_commit_type \
4001 lappend disable_on_lock \
4002 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4004 .mbar.commit add separator
4006 .mbar.commit add command -label Rescan \
4007 -command do_rescan \
4010 lappend disable_on_lock \
4011 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4013 .mbar.commit add command -label {Add To Commit} \
4014 -command do_add_selection \
4016 lappend disable_on_lock \
4017 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4019 .mbar.commit add command -label {Add All To Commit} \
4020 -command do_add_all \
4021 -accelerator $M1T-I \
4023 lappend disable_on_lock \
4024 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4026 .mbar.commit add command -label {Unstage From Commit} \
4027 -command do_unstage_selection \
4029 lappend disable_on_lock \
4030 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4032 .mbar.commit add command -label {Revert Changes} \
4033 -command do_revert_selection \
4035 lappend disable_on_lock \
4036 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4038 .mbar.commit add separator
4040 .mbar.commit add command -label {Sign Off} \
4041 -command do_signoff \
4042 -accelerator $M1T-S \
4045 .mbar.commit add command -label Commit \
4046 -command do_commit \
4047 -accelerator $M1T-Return \
4049 lappend disable_on_lock \
4050 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4052 # -- Transport menus
4054 if {!$single_commit} {
4058 .mbar.push add command -label {Push...} \
4059 -command do_push_anywhere \
4064 # -- Apple Menu (Mac OS X only)
4066 .mbar add cascade -label Apple -menu .mbar.apple
4069 .mbar.apple add command -label "About
[appname
]" \
4072 .mbar.apple add command -label "[appname
] Options...
" \
4073 -command do_options \
4078 .mbar.edit add separator
4079 .mbar.edit add command -label {Options...} \
4080 -command do_options \
4085 if {[file exists /usr/local/miga/lib/gui-miga]
4086 && [file exists .pvcsrc]} {
4088 global ui_status_value
4089 if {![lock_index update]} return
4090 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
4091 set miga_fd [open "|
$cmd" r]
4092 fconfigure $miga_fd -blocking 0
4093 fileevent $miga_fd readable [list miga_done $miga_fd]
4094 set ui_status_value {Running miga...}
4096 proc miga_done {fd} {
4101 rescan [list set ui_status_value {Ready.}]
4104 .mbar add cascade -label Tools -menu .mbar.tools
4106 .mbar.tools add command -label "Migrate
" \
4109 lappend disable_on_lock \
4110 [list .mbar.tools entryconf [.mbar.tools index last] -state]
4115 .mbar add cascade -label Help -menu .mbar.help
4118 .mbar.help add command -label "About
[appname
]" \
4130 -text {Current Branch:} \
4135 -textvariable current_branch \
4139 pack .branch.l1 -side left
4140 pack .branch.cb -side left -fill x
4141 pack .branch -side top -fill x
4143 # -- Main Window Layout
4145 panedwindow .vpane -orient vertical
4146 panedwindow .vpane.files -orient horizontal
4147 .vpane add .vpane.files -sticky nsew -height 100 -width 200
4148 pack .vpane -anchor n -side top -fill both -expand 1
4150 # -- Index File List
4152 frame .vpane.files.index -height 100 -width 200
4153 label .vpane.files.index.title -text {Changes To Be Committed} \
4156 text $ui_index -background white -borderwidth 0 \
4157 -width 20 -height 10 \
4160 -cursor $cursor_ptr \
4161 -xscrollcommand {.vpane.files.index.sx set} \
4162 -yscrollcommand {.vpane.files.index.sy set} \
4164 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4165 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4166 pack .vpane.files.index.title -side top -fill x
4167 pack .vpane.files.index.sx -side bottom -fill x
4168 pack .vpane.files.index.sy -side right -fill y
4169 pack $ui_index -side left -fill both -expand 1
4170 .vpane.files add .vpane.files.index -sticky nsew
4172 # -- Working Directory File List
4174 frame .vpane.files.workdir -height 100 -width 200
4175 label .vpane.files.workdir.title -text {Changed But Not Updated} \
4178 text $ui_workdir -background white -borderwidth 0 \
4179 -width 20 -height 10 \
4182 -cursor $cursor_ptr \
4183 -xscrollcommand {.vpane.files.workdir.sx set} \
4184 -yscrollcommand {.vpane.files.workdir.sy set} \
4186 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4187 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4188 pack .vpane.files.workdir.title -side top -fill x
4189 pack .vpane.files.workdir.sx -side bottom -fill x
4190 pack .vpane.files.workdir.sy -side right -fill y
4191 pack $ui_workdir -side left -fill both -expand 1
4192 .vpane.files add .vpane.files.workdir -sticky nsew
4194 foreach i [list $ui_index $ui_workdir] {
4195 $i tag conf in_diff -font font_uibold
4196 $i tag conf in_sel \
4197 -background [$i cget -foreground] \
4198 -foreground [$i cget -background]
4202 # -- Diff and Commit Area
4204 frame .vpane.lower -height 300 -width 400
4205 frame .vpane.lower.commarea
4206 frame .vpane.lower.diff -relief sunken -borderwidth 1
4207 pack .vpane.lower.commarea -side top -fill x
4208 pack .vpane.lower.diff -side bottom -fill both -expand 1
4209 .vpane add .vpane.lower -sticky nsew
4211 # -- Commit Area Buttons
4213 frame .vpane.lower.commarea.buttons
4214 label .vpane.lower.commarea.buttons.l -text {} \
4218 pack .vpane.lower.commarea.buttons.l -side top -fill x
4219 pack .vpane.lower.commarea.buttons -side left -fill y
4221 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4222 -command do_rescan \
4224 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4225 lappend disable_on_lock \
4226 {.vpane.lower.commarea.buttons.rescan conf -state}
4228 button .vpane.lower.commarea.buttons.incall -text {Add All} \
4229 -command do_add_all \
4231 pack .vpane.lower.commarea.buttons.incall -side top -fill x
4232 lappend disable_on_lock \
4233 {.vpane.lower.commarea.buttons.incall conf -state}
4235 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4236 -command do_signoff \
4238 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4240 button .vpane.lower.commarea.buttons.commit -text {Commit} \
4241 -command do_commit \
4243 pack .vpane.lower.commarea.buttons.commit -side top -fill x
4244 lappend disable_on_lock \
4245 {.vpane.lower.commarea.buttons.commit conf -state}
4247 # -- Commit Message Buffer
4249 frame .vpane.lower.commarea.buffer
4250 frame .vpane.lower.commarea.buffer.header
4251 set ui_comm .vpane.lower.commarea.buffer.t
4252 set ui_coml .vpane.lower.commarea.buffer.header.l
4253 radiobutton .vpane.lower.commarea.buffer.header.new \
4254 -text {New Commit} \
4255 -command do_select_commit_type \
4256 -variable selected_commit_type \
4259 lappend disable_on_lock \
4260 [list .vpane.lower.commarea.buffer.header.new conf -state]
4261 radiobutton .vpane.lower.commarea.buffer.header.amend \
4262 -text {Amend Last Commit} \
4263 -command do_select_commit_type \
4264 -variable selected_commit_type \
4267 lappend disable_on_lock \
4268 [list .vpane.lower.commarea.buffer.header.amend conf -state]
4273 proc trace_commit_type {varname args} {
4274 global ui_coml commit_type
4275 switch -glob -- $commit_type {
4276 initial {set txt {Initial Commit Message:}}
4277 amend {set txt {Amended Commit Message:}}
4278 amend-initial {set txt {Amended Initial Commit Message:}}
4279 amend-merge {set txt {Amended Merge Commit Message:}}
4280 merge {set txt {Merge Commit Message:}}
4281 * {set txt {Commit Message:}}
4283 $ui_coml conf -text $txt
4285 trace add variable commit_type write trace_commit_type
4286 pack $ui_coml -side left -fill x
4287 pack .vpane.lower.commarea.buffer.header.amend -side right
4288 pack .vpane.lower.commarea.buffer.header.new -side right
4290 text $ui_comm -background white -borderwidth 1 \
4293 -autoseparators true \
4295 -width 75 -height 9 -wrap none \
4297 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4298 scrollbar .vpane.lower.commarea.buffer.sby \
4299 -command [list $ui_comm yview]
4300 pack .vpane.lower.commarea.buffer.header -side top -fill x
4301 pack .vpane.lower.commarea.buffer.sby -side right -fill y
4302 pack $ui_comm -side left -fill y
4303 pack .vpane.lower.commarea.buffer -side left -fill y
4305 # -- Commit Message Buffer Context Menu
4307 set ctxm .vpane.lower.commarea.buffer.ctxm
4308 menu $ctxm -tearoff 0
4312 -command {tk_textCut $ui_comm}
4316 -command {tk_textCopy $ui_comm}
4320 -command {tk_textPaste $ui_comm}
4324 -command {$ui_comm delete sel.first sel.last}
4327 -label {Select All} \
4329 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4334 $ui_comm tag add sel 0.0 end
4335 tk_textCopy $ui_comm
4336 $ui_comm tag remove sel 0.0 end
4343 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
4347 set current_diff_path {}
4348 set current_diff_side {}
4349 set diff_actions [list]
4350 proc trace_current_diff_path {varname args} {
4351 global current_diff_path diff_actions file_states
4352 if {$current_diff_path eq {}} {
4358 set p $current_diff_path
4359 set s [mapdesc [lindex $file_states($p) 0] $p]
4361 set p [escape_path $p]
4365 .vpane.lower.diff.header.status configure -text $s
4366 .vpane.lower.diff.header.file configure -text $f
4367 .vpane.lower.diff.header.path configure -text $p
4368 foreach w $diff_actions {
4372 trace add variable current_diff_path write trace_current_diff_path
4374 frame .vpane.lower.diff.header -background orange
4375 label .vpane.lower.diff.header.status \
4376 -background orange \
4377 -width $max_status_desc \
4381 label .vpane.lower.diff.header.file \
4382 -background orange \
4386 label .vpane.lower.diff.header.path \
4387 -background orange \
4391 pack .vpane.lower.diff.header.status -side left
4392 pack .vpane.lower.diff.header.file -side left
4393 pack .vpane.lower.diff.header.path -fill x
4394 set ctxm .vpane.lower.diff.header.ctxm
4395 menu $ctxm -tearoff 0
4404 -- $current_diff_path
4406 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4407 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
4411 frame .vpane.lower.diff.body
4412 set ui_diff .vpane.lower.diff.body.t
4413 text $ui_diff -background white -borderwidth 0 \
4414 -width 80 -height 15 -wrap none \
4416 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4417 -yscrollcommand {.vpane.lower.diff.body.sby set} \
4419 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4420 -command [list $ui_diff xview]
4421 scrollbar .vpane.lower.diff.body.sby -orient vertical \
4422 -command [list $ui_diff yview]
4423 pack .vpane.lower.diff.body.sbx -side bottom -fill x
4424 pack .vpane.lower.diff.body.sby -side right -fill y
4425 pack $ui_diff -side left -fill both -expand 1
4426 pack .vpane.lower.diff.header -side top -fill x
4427 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4429 $ui_diff tag conf d_cr -elide true
4430 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
4431 $ui_diff tag conf d_+ -foreground {#00a000}
4432 $ui_diff tag conf d_- -foreground red
4434 $ui_diff tag conf d_++ -foreground {#00a000}
4435 $ui_diff tag conf d_-- -foreground red
4436 $ui_diff tag conf d_+s \
4437 -foreground {#00a000} \
4438 -background {#e2effa}
4439 $ui_diff tag conf d_-s \
4441 -background {#e2effa}
4442 $ui_diff tag conf d_s+ \
4443 -foreground {#00a000} \
4445 $ui_diff tag conf d_s- \
4449 $ui_diff tag conf d<<<<<<< \
4450 -foreground orange \
4452 $ui_diff tag conf d======= \
4453 -foreground orange \
4455 $ui_diff tag conf d>>>>>>> \
4456 -foreground orange \
4459 $ui_diff tag raise sel
4461 # -- Diff Body Context Menu
4463 set ctxm .vpane.lower.diff.body.ctxm
4464 menu $ctxm -tearoff 0
4468 -command reshow_diff
4469 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4473 -command {tk_textCopy $ui_diff}
4474 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4476 -label {Select All} \
4478 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4479 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4484 $ui_diff tag add sel 0.0 end
4485 tk_textCopy $ui_diff
4486 $ui_diff tag remove sel 0.0 end
4488 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4491 -label {Apply/Reverse Hunk} \
4493 -command {apply_hunk $cursorX $cursorY}
4494 set ui_diff_applyhunk [$ctxm index last]
4495 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4498 -label {Decrease Font Size} \
4500 -command {incr_font_size font_diff -1}
4501 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4503 -label {Increase Font Size} \
4505 -command {incr_font_size font_diff 1}
4506 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4509 -label {Show Less Context} \
4511 -command {if {$repo_config(gui.diffcontext) >= 2} {
4512 incr repo_config(gui.diffcontext) -1
4515 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4517 -label {Show More Context} \
4520 incr repo_config(gui.diffcontext)
4523 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4525 $ctxm add command -label {Options...} \
4528 bind_button3 $ui_diff "
4531 if {\
$ui_index eq \
$current_diff_side} {
4532 $ctxm entryconf
$ui_diff_applyhunk -label {Unstage Hunk From Commit
}
4534 $ctxm entryconf
$ui_diff_applyhunk -label {Stage Hunk For Commit
}
4536 tk_popup
$ctxm %X
%Y
4538 unset ui_diff_applyhunk
4542 set ui_status_value {Initializing...}
4543 label .status -textvariable ui_status_value \
4549 pack .status -anchor w -side bottom -fill x
4554 set gm $repo_config(gui.geometry)
4555 wm geometry . [lindex $gm 0]
4556 .vpane sash place 0 \
4557 [lindex [.vpane sash coord 0] 0] \
4559 .vpane.files sash place 0 \
4561 [lindex [.vpane.files sash coord 0] 1]
4567 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4568 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4569 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4570 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4571 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4572 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4573 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4574 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4575 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4576 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4577 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4579 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4580 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4581 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4582 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4583 bind $ui_diff <$M1B-Key-v> {break}
4584 bind $ui_diff <$M1B-Key-V> {break}
4585 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4586 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4587 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
4588 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
4589 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
4590 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
4591 bind $ui_diff <Button-1> {focus %W}
4593 if {!$single_commit} {
4594 bind . <$M1B-Key-n> do_create_branch
4595 bind . <$M1B-Key-N> do_create_branch
4598 bind . <Destroy> do_quit
4599 bind all <Key-F5> do_rescan
4600 bind all <$M1B-Key-r> do_rescan
4601 bind all <$M1B-Key-R> do_rescan
4602 bind . <$M1B-Key-s> do_signoff
4603 bind . <$M1B-Key-S> do_signoff
4604 bind . <$M1B-Key-i> do_add_all
4605 bind . <$M1B-Key-I> do_add_all
4606 bind . <$M1B-Key-Return> do_commit
4607 bind all <$M1B-Key-q> do_quit
4608 bind all <$M1B-Key-Q> do_quit
4609 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4610 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4611 foreach i [list $ui_index $ui_workdir] {
4612 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
4613 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
4614 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
4618 set file_lists($ui_index) [list]
4619 set file_lists($ui_workdir) [list]
4623 set MERGE_HEAD [list]
4626 set current_branch {}
4627 set current_diff_path {}
4628 set selected_commit_type new
4630 wm title . "[appname
] ([file normalize
[file dirname [gitdir
]]])"
4631 focus -force $ui_comm
4633 # -- Warn the user about environmental problems. Cygwin's Tcl
4634 # does *not* pass its env array onto any processes it spawns.
4635 # This means that git processes get none of our environment.
4640 set msg "Possible environment issues exist.
4642 The following environment variables are probably
4643 going to be ignored by any Git subprocess run
4647 foreach name [array names env] {
4648 switch -regexp -- $name {
4649 {^GIT_INDEX_FILE$} -
4650 {^GIT_OBJECT_DIRECTORY$} -
4651 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4653 {^GIT_EXTERNAL_DIFF$} -
4657 {^GIT_CONFIG_LOCAL$} -
4658 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4659 append msg " - $name\n"
4662 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4663 append msg " - $name\n"
4665 set suggest_user $name
4669 if {$ignored_env > 0} {
4671 This is due to a known issue with the
4672 Tcl binary distributed by Cygwin.
"
4674 if {$suggest_user ne {}} {
4677 A good replacement
for $suggest_user
4678 is placing values
for the user.name and
4679 user.email settings into your personal
4685 unset ignored_env msg suggest_user name
4688 # -- Only initialize complex UI if we are going to stay running.
4690 if {!$single_commit} {
4694 populate_branch_menu
4699 # -- Only suggest a gc run if we are going to stay running.
4701 if {!$single_commit} {
4702 set object_limit 2000
4703 if {[is_Windows]} {set object_limit 200}
4704 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4705 if {$objects_current >= $object_limit} {
4707 "This repository currently has
$objects_current loose objects.
4709 To maintain optimal performance it is strongly
4710 recommended that you
compress the database
4711 when
more than
$object_limit loose objects exist.
4713 Compress the database now?
"] eq yes} {
4717 unset object_limit _junk objects_current
4720 lock_index begin-read