From 77f648edb69dba164e2e32f33ab009fa33c3d9f1 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Mon, 12 Feb 2024 23:32:44 -0500 Subject: [PATCH 01/16] git-gui: require git >= 2.36 git-gui since commit d6967022 explicitly requires version >= 1.5.0, and this coded requirement has never been changed. But, since 0730a5a3a git-gui actually requires git 2.36, providing 'git hook run.' git-gui throws an error if that command is not supported. So, let's update the requirement checking code to 2.36, and throw a more useful error if this is not met. Signed-off-by: Mark Levedahl --- git-gui.sh | 49 ++++++++++++++++--------------------------------- 1 file changed, 16 insertions(+), 33 deletions(-) diff --git a/git-gui.sh b/git-gui.sh index c77c05edde..d896382b8c 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -992,6 +992,8 @@ if {$_git eq {}} { ## ## version check +set MIN_GIT_VERSION 2.36 + if {[catch {set _git_version [git --version]} err]} { catch {wm withdraw .} tk_messageBox \ @@ -1002,9 +1004,10 @@ if {[catch {set _git_version [git --version]} err]} { $err -[appname] requires Git 1.5.0 or later." +[appname] requires Git $MIN_GIT_VERSION or later." exit 1 } + if {![regsub {^git version } $_git_version {} _git_version]} { catch {wm withdraw .} tk_messageBox \ @@ -1029,25 +1032,19 @@ proc get_trimmed_version {s} { set _real_git_version $_git_version set _git_version [get_trimmed_version $_git_version] -if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} { +if {[catch {set vcheck [package vcompare $_git_version $MIN_GIT_VERSION]}] || + [expr $vcheck < 0] } { + + set msg1 [mc "Insufficient git version, require: "] + set msg2 [mc "git returned:"] + set message "$msg1 $MIN_GIT_VERSION\n$msg2 $_real_git_version" catch {wm withdraw .} - if {[tk_messageBox \ - -icon warning \ - -type yesno \ - -default no \ - -title "[appname]: warning" \ - -message [mc "Git version cannot be determined. - -%s claims it is version '%s'. - -%s requires at least Git 1.5.0 or later. - -Assume '%s' is version 1.5.0? -" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} { - set _git_version 1.5.0 - } else { - exit 1 - } + tk_messageBox \ + -icon error \ + -type ok \ + -title [mc "git-gui: fatal error"] \ + -message $message + exit 1 } unset _real_git_version @@ -1095,20 +1092,6 @@ proc git-version {args} { } } -if {[git-version < 1.5]} { - catch {wm withdraw .} - tk_messageBox \ - -icon error \ - -type ok \ - -title [mc "git-gui: fatal error"] \ - -message "[appname] requires Git 1.5.0 or later. - -You are using [git-version]: - -[git --version]" - exit 1 -} - ###################################################################### ## ## configure our library From dd7eb2d0370e0b610bcc05ab0843523c61b64c93 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Sat, 5 Apr 2025 10:18:06 -0400 Subject: [PATCH 02/16] git-gui: git ls-files knows --exclude-standard git-gui includes code to implement ls-files for git versions prior to 1.63 that did not know --exclude-standard. But, git-gui now requires git version >= 2.36, so remove the obsolete code. Signed-off-by: Mark Levedahl --- git-gui.sh | 13 +------------ 1 file changed, 1 insertion(+), 12 deletions(-) diff --git a/git-gui.sh b/git-gui.sh index d896382b8c..d5c8d2dc85 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -1536,18 +1536,7 @@ proc rescan_stage2 {fd after} { close $fd } - if {[package vcompare $::_git_version 1.6.3] >= 0} { - set ls_others [list --exclude-standard] - } else { - set ls_others [list --exclude-per-directory=.gitignore] - if {[have_info_exclude]} { - lappend ls_others "--exclude-from=[gitdir info exclude]" - } - set user_exclude [get_config core.excludesfile] - if {$user_exclude ne {} && [file readable $user_exclude]} { - lappend ls_others "--exclude-from=[file normalize $user_exclude]" - } - } + set ls_others [list --exclude-standard] set buf_rdi {} set buf_rdf {} From d342dcddcf46ffdaa41d6736c9f7657fd54d4125 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Sat, 5 Apr 2025 10:19:48 -0400 Subject: [PATCH 03/16] git-gui: git-diff-index always knows submodules git-gui asks for submodule info only on git-versions >=1.72, which introduced such capability. But, git-gui requires git version >= 2.36, so this alternate code path is obsolete. Remove it. Signed-off-by: Mark Levedahl --- git-gui.sh | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/git-gui.sh b/git-gui.sh index d5c8d2dc85..f438c89bed 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -1544,11 +1544,7 @@ proc rescan_stage2 {fd after} { set rescan_active 2 ui_status [mc "Scanning for modified files ..."] - if {[git-version >= "1.7.2"]} { - set fd_di [git_read [list diff-index --cached --ignore-submodules=dirty -z [PARENT]]] - } else { - set fd_di [git_read [list diff-index --cached -z [PARENT]]] - } + set fd_di [git_read [list diff-index --cached --ignore-submodules=dirty -z [PARENT]]] set fd_df [git_read [list diff-files -z]] fconfigure $fd_di -blocking 0 -translation binary -encoding binary From f87a36b697ca7a9415fa8773a06d943d84db1b80 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Mon, 12 Feb 2024 14:42:05 -0500 Subject: [PATCH 04/16] git-gui: use git-branch --show-current git-gui relies upon the files back-end to determine the current branch. This does not support the newer reftables backend. But, git-branch has long supported --show-current to get this same information regardless of backend cahnged. So teach git-gui to use git-branch --show-current. Signed-off-by: Mark Levedahl --- git-gui.sh | 23 ++--------------------- 1 file changed, 2 insertions(+), 21 deletions(-) diff --git a/git-gui.sh b/git-gui.sh index f438c89bed..0347d488a7 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -744,27 +744,8 @@ proc sq {value} { proc load_current_branch {} { global current_branch is_detached - set fd [safe_open_file [gitdir HEAD] r] - fconfigure $fd -translation binary -encoding utf-8 - if {[gets $fd ref] < 1} { - set ref {} - } - close $fd - - set pfx {ref: refs/heads/} - set len [string length $pfx] - if {[string equal -length $len $pfx $ref]} { - # We're on a branch. It might not exist. But - # HEAD looks good enough to be a branch. - # - set current_branch [string range $ref $len end] - set is_detached 0 - } else { - # Assume this is a detached head. - # - set current_branch HEAD - set is_detached 1 - } + set current_branch [git branch --show-current] + set is_detached [expr [string length $current_branch] == 0] } auto_load tk_optionMenu From 182e2c405f16ea491fdf3a25c6be4fa2b7fc6e47 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Mon, 12 Feb 2024 22:03:30 -0500 Subject: [PATCH 05/16] git-gui: git rev-parse knows show_toplevel git-gui has its own code to determine the worktree root for git-versions earlier than 1.7.0, where git rev-parse learned this function. git-gui requires git v2.36 or later, so delete the now obsolete alternate code. Signed-off-by: Mark Levedahl --- git-gui.sh | 15 +-------------- 1 file changed, 1 insertion(+), 14 deletions(-) diff --git a/git-gui.sh b/git-gui.sh index 0347d488a7..1e4c7601b9 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -1278,20 +1278,7 @@ if {![file isdirectory $_gitdir]} { load_config 0 apply_config -# v1.7.0 introduced --show-toplevel to return the canonical work-tree -if {[package vcompare $_git_version 1.7.0] >= 0} { - set _gitworktree [git rev-parse --show-toplevel] -} else { - # try to set work tree from environment, core.worktree or use - # cdup to obtain a relative path to the top of the worktree. If - # run from the top, the ./ prefix ensures normalize expands pwd. - if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} { - set _gitworktree [get_config core.worktree] - if {$_gitworktree eq ""} { - set _gitworktree [file normalize ./[git rev-parse --show-cdup]] - } - } -} +set _gitworktree [git rev-parse --show-toplevel] if {$_prefix ne {}} { if {$_gitworktree eq {}} { From e48c822012a79cb98ebd1c4907c6ae3081afa4d9 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 13 Feb 2024 00:09:02 -0500 Subject: [PATCH 06/16] git-gui: git-blame understands -w and textconv git-gui uses alternate code paths for git versions < 1.7.2, avoiding use of --ignore-all-space and textconv. git-gui requires git v2.36 or later, so this alternate code is obsolete. Remove it. Signed-off-by: Mark Levedahl --- lib/blame.tcl | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/lib/blame.tcl b/lib/blame.tcl index d6fd8bea91..84d57fc77c 100644 --- a/lib/blame.tcl +++ b/lib/blame.tcl @@ -470,7 +470,7 @@ method _load {jump} { $w_path conf -text [escape_path $path] set do_textconv 0 - if {![is_config_false gui.textconv] && [git-version >= 1.7.2]} { + if {![is_config_false gui.textconv]} { set filter [gitattr $path diff set] set textconv [get_config [join [list diff $filter textconv] .]] if {$filter ne {set} && $textconv ne {}} { @@ -807,9 +807,7 @@ method _read_blame {fd cur_w cur_d} { # thorough copy search; insert before the threshold set original_options [linsert $original_options 0 -C] } - if {[git-version >= 1.5.3]} { - lappend original_options -w ; # ignore indentation changes - } + lappend original_options -w ; # ignore indentation changes _exec_blame $this $w_amov @amov_data \ $original_options \ @@ -857,9 +855,7 @@ method _fullcopyblame {} { set threshold [get_config gui.copyblamethreshold] set original_options [list -C -C "-C$threshold"] - if {[git-version >= 1.5.3]} { - lappend original_options -w ; # ignore indentation changes - } + lappend original_options -w ; # ignore indentation changes # Find the line range set pos @$::cursorX,$::cursorY From 940640de8bf219b9cb17e1ee670baa170e0e75c6 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 13 Feb 2024 00:11:32 -0500 Subject: [PATCH 07/16] git-gui: git-diff knows submodules and textconv git-gui's diff functions avoid using textconv filters on git < 1.6.1, or asking about submodules on version before 1.7.2, but git-gui requires git >= v2.36. So, remove this now obsolete code. Signed-off-by: Mark Levedahl --- lib/diff.tcl | 19 +++---------------- 1 file changed, 3 insertions(+), 16 deletions(-) diff --git a/lib/diff.tcl b/lib/diff.tcl index 84f0468c7c..4b21a26acb 100644 --- a/lib/diff.tcl +++ b/lib/diff.tcl @@ -280,9 +280,7 @@ proc start_show_diff {cont_info {add_opts {}}} { if {$w eq $ui_index} { lappend cmd diff-index lappend cmd --cached - if {[git-version >= "1.7.2"]} { - lappend cmd --ignore-submodules=dirty - } + lappend cmd --ignore-submodules=dirty } elseif {$w eq $ui_workdir} { if {[string first {U} $m] >= 0} { lappend cmd diff @@ -290,17 +288,14 @@ proc start_show_diff {cont_info {add_opts {}}} { lappend cmd diff-files } } - if {![is_config_false gui.textconv] && [git-version >= 1.6.1]} { + if {![is_config_false gui.textconv]} { lappend cmd --textconv } if {[string match {160000 *} [lindex $s 2]] || [string match {160000 *} [lindex $s 3]]} { set is_submodule_diff 1 - - if {[git-version >= "1.6.6"]} { - lappend cmd --submodule - } + lappend cmd --submodule } lappend cmd -p @@ -319,14 +314,6 @@ proc start_show_diff {cont_info {add_opts {}}} { lappend cmd $path } - if {$is_submodule_diff && [git-version < "1.6.6"]} { - if {$w eq $ui_index} { - set cmd [list submodule summary --cached -- $path] - } else { - set cmd [list submodule summary --files -- $path] - } - } - if {[catch {set fd [git_read_nice $cmd]} err]} { set diff_active 0 unlock_index From e42ba88178c0088cba7cca521a671c92aaa4a300 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 13 Feb 2024 00:13:10 -0500 Subject: [PATCH 08/16] git-gui: git merge understands --strategy=recursive git-gui's merge driver includes code to invoke the recursive strategy for merging prior to git v2.5 that added a simpler syntax. As git-gui requires git v2.36 or later, let's delete the code targeting earlier git. Signed-off-by: Mark Levedahl --- lib/merge.tcl | 11 +---------- 1 file changed, 1 insertion(+), 10 deletions(-) diff --git a/lib/merge.tcl b/lib/merge.tcl index 44c3f93584..375fa19a12 100644 --- a/lib/merge.tcl +++ b/lib/merge.tcl @@ -112,16 +112,7 @@ method _start {} { close $fh set _last_merged_branch $branch - if {[git-version >= "2.5.0"]} { - set cmd [list git merge --strategy=recursive FETCH_HEAD] - } else { - set cmd [list git] - lappend cmd merge - lappend cmd --strategy=recursive - lappend cmd [git_redir [list fmt-merge-msg] [list <[gitdir FETCH_HEAD]]] - lappend cmd HEAD - lappend cmd $name - } + set cmd [list git merge --strategy=recursive FETCH_HEAD] ui_status [mc "Merging %s and %s..." $current_branch $stitle] set cons [console::new [mc "Merge"] "merge $stitle"] From 8b48034f78267c0f80a5185629bce529ad88e376 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 13 Feb 2024 00:13:45 -0500 Subject: [PATCH 09/16] git-gui: git-remote is always available git-gui checks for git version >= 1.6.6 before enabling the remotes menu. But git-gui requires git v2.36 or later, so git-remote is always available. Delete this check and always enable the menu. Signed-off-by: Mark Levedahl --- lib/remote.tcl | 2 -- 1 file changed, 2 deletions(-) diff --git a/lib/remote.tcl b/lib/remote.tcl index cf796d1601..9b49b6e462 100644 --- a/lib/remote.tcl +++ b/lib/remote.tcl @@ -233,8 +233,6 @@ proc make_sure_remote_submenues_exist {remote_m} { proc update_all_remotes_menu_entry {} { global all_remotes - if {[git-version < 1.6.6]} { return } - set have_remote 0 foreach r $all_remotes { incr have_remote From c85557098f90801583866d9829719b6e2cf4cd49 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Fri, 9 Feb 2024 17:58:04 -0500 Subject: [PATCH 10/16] git-gui: use git_init to create new repository dir When creating a new repository, git-gui creates a directory, cds to it, then runs git-init, but git-init learned to create and initialize the directory in 1.6.5. git-gui requires git version >= 2.36, so teach git-gui to use git-init's full capability. Signed-off-by: Mark Levedahl --- lib/choose_repository.tcl | 9 +-------- 1 file changed, 1 insertion(+), 8 deletions(-) diff --git a/lib/choose_repository.tcl b/lib/choose_repository.tcl index 5b361cc424..1711f7ca55 100644 --- a/lib/choose_repository.tcl +++ b/lib/choose_repository.tcl @@ -323,7 +323,7 @@ method _write_local_path {args} { } method _git_init {} { - if {[catch {file mkdir $local_path} err]} { + if {[catch {git init $local_path} err]} { error_popup [strcat \ [mc "Failed to create repository %s:" $local_path] \ "\n\n$err"] @@ -337,13 +337,6 @@ method _git_init {} { return 0 } - if {[catch {git init} err]} { - error_popup [strcat \ - [mc "Failed to create repository %s:" $local_path] \ - "\n\n$err"] - return 0 - } - _append_recentrepos [pwd] set ::_gitdir .git set ::_prefix {} From c939344b683cbad03bccda986f7babbce4d36aae Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Tue, 13 Feb 2024 00:19:56 -0500 Subject: [PATCH 11/16] git-gui: remove unused git-version git-version supports choosing different bodies of code passed into it, rather than using the more traditional if/else construct typically used. The only use of git-version in this mode was by its author in 2007, and that code has been deleted. So, delete this now unused function that was mostly ignored. Signed-off-by: Mark Levedahl --- git-gui.sh | 44 -------------------------------------------- 1 file changed, 44 deletions(-) diff --git a/git-gui.sh b/git-gui.sh index 1e4c7601b9..ef82e8bd63 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -1029,50 +1029,6 @@ if {[catch {set vcheck [package vcompare $_git_version $MIN_GIT_VERSION]}] || } unset _real_git_version -proc git-version {args} { - global _git_version - - switch [llength $args] { - 0 { - return $_git_version - } - - 2 { - set op [lindex $args 0] - set vr [lindex $args 1] - set cm [package vcompare $_git_version $vr] - return [expr $cm $op 0] - } - - 4 { - set type [lindex $args 0] - set name [lindex $args 1] - set parm [lindex $args 2] - set body [lindex $args 3] - - if {($type ne {proc} && $type ne {method})} { - error "Invalid arguments to git-version" - } - if {[llength $body] < 2 || [lindex $body end-1] ne {default}} { - error "Last arm of $type $name must be default" - } - - foreach {op vr cb} [lrange $body 0 end-2] { - if {[git-version $op $vr]} { - return [uplevel [list $type $name $parm $cb]] - } - } - - return [uplevel [list $type $name $parm [lindex $body end]]] - } - - default { - error "git-version >= x" - } - - } -} - ###################################################################### ## ## configure our library From 6ff8d68ec1adf170aa57630989fde092d18e02de Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Fri, 9 Feb 2024 18:07:45 -0500 Subject: [PATCH 12/16] git-gui: use git-clone git-gui clones a repository by invoking git-plumbing commands, in proc do_clone, rather than using git-clone. The justification was that the low-level commands are guaranteed to provide a stable interface, while the higher level commands such as git-clone may not be stable. This approach requires git-gui to continually evolve by mirroring new features in git itself, which has not happened, while the user interface in git-clone has proven very stable. Also, git-gui does directly call many other non-plumbing commands in git's repertoire. do_clone's last significant functionality change was in 2015, and updates are required for shallow clones, the reftable backend, cloning from linked worktrees, and perhaps other features and bugs. For instance, I had reports of git-gui failing to correctly clone repositories prior to 2015, resulting in essentially the patch given here. The only significant work was supporting .gitfile linked worktrees unknown to do_clone, but supported by git-clone, and none regarding the interface to git-clone itself. That interface is clearly stable enough to not be a problem. Supporting new use-cases with this requires exposing new options in the clone dialog, then passing flags to git-clone. This avoids updating do_clone to understand those options, reducing the maintenance burdens. So, teach git-gui to use git-clone. This change is in one patch as there is no obvious incremental path to migration. The existing dialog / options / status screen are unchanged, the known user-visible changes are that cloning from a working directory linked by a gitfile now works, there is no auto-fallback to a full copy when cloning linked workdirs and worktrees (meaning git-clone fails unless a full or shared copy is selected), and messages displayed are from git-clone. Signed-off-by: Mark Levedahl --- git-gui.sh | 3 + lib/choose_repository.tcl | 468 +++----------------------------------- 2 files changed, 35 insertions(+), 436 deletions(-) diff --git a/git-gui.sh b/git-gui.sh index ef82e8bd63..89e1729d1a 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -1215,6 +1215,9 @@ if {[catch { load_config 1 apply_config choose_repository::pick + if {![file isdirectory $_gitdir]} { + exit 1 + } set picked 1 } diff --git a/lib/choose_repository.tcl b/lib/choose_repository.tcl index 1711f7ca55..e74c39c34c 100644 --- a/lib/choose_repository.tcl +++ b/lib/choose_repository.tcl @@ -10,22 +10,12 @@ field w_next ; # Next button field w_quit ; # Quit button field o_cons ; # Console object (if active) -# Status mega-widget instance during _do_clone2 (used by _copy_files and -# _link_files). Widget is destroyed before _do_clone2 calls -# _do_clone_checkout -field o_status - -# Operation displayed by status mega-widget during _do_clone_checkout => -# _readtree_wait => _postcheckout_wait => _do_clone_submodules => -# _do_validate_submodule_cloning. The status mega-widget is a different -# instance than that stored in $o_status in earlier operations. -field o_status_op - field w_types ; # List of type buttons in clone field w_recentlist ; # Listbox containing recent repositories field w_localpath ; # Entry widget bound to local_path field done 0 ; # Finished picking the repository? +field clone_ok false ; # clone succeeeded field local_path {} ; # Where this repository is locally field origin_url {} ; # Where we are cloning from field origin_name origin ; # What we shall call 'origin' @@ -353,20 +343,6 @@ proc _is_git {path {outdir_var ""}} { return 1 } -proc _objdir {path} { - set objdir [file join $path .git objects] - if {[file isdirectory $objdir]} { - return $objdir - } - - set objdir [file join $path objects] - if {[file isdirectory $objdir]} { - return $objdir - } - - return {} -} - ###################################################################### ## ## Create New Repository @@ -592,14 +568,6 @@ method _do_clone2 {} { return } - if {$clone_type eq {hardlink} || $clone_type eq {shared}} { - set objdir [_objdir $origin_url] - if {$objdir eq {}} { - error_popup [mc "Not a Git repository: %s" [file tail $origin_url]] - return - } - } - set giturl $origin_url if {[file exists $local_path]} { @@ -607,434 +575,62 @@ method _do_clone2 {} { return } - if {![_git_init $this]} return - set local_path [pwd] - - if {[catch { - git config remote.$origin_name.url $giturl - git config remote.$origin_name.fetch +refs/heads/*:refs/remotes/$origin_name/* - } err]} { - error_popup [strcat [mc "Failed to configure origin"] "\n\n$err"] - return + set clone_options {--progress} + if {$recursive} { + append clone_options { --recurse-submodules} } destroy $w_body $w_next switch -exact -- $clone_type { - hardlink { - set o_status [status_bar::two_line $w_body] - pack $w_body -fill x -padx 10 -pady 10 - - set status_op [$o_status start \ - [mc "Counting objects"] \ - [mc "buckets"]] - update - - if {[file exists [file join $objdir info alternates]]} { - set pwd [pwd] - if {[catch { - file mkdir [gitdir objects info] - set f_in [safe_open_file [file join $objdir info alternates] r] - set f_cp [safe_open_file [gitdir objects info alternates] w] - fconfigure $f_in -translation binary -encoding binary - fconfigure $f_cp -translation binary -encoding binary - cd $objdir - while {[gets $f_in line] >= 0} { - puts $f_cp [file normalize $line] - } - close $f_in - close $f_cp - cd $pwd - } err]} { - catch {cd $pwd} - _clone_failed $this [mc "Unable to copy objects/info/alternates: %s" $err] - $status_op stop - return - } + full { + append clone_options { --no-hardlinks --no-local} } - - set tolink [list] - set buckets [glob \ - -tails \ - -nocomplain \ - -directory [file join $objdir] ??] - set bcnt [expr {[llength $buckets] + 2}] - set bcur 1 - $status_op update $bcur $bcnt - update - - file mkdir [file join .git objects pack] - foreach i [glob -tails -nocomplain \ - -directory [file join $objdir pack] *] { - lappend tolink [file join pack $i] + shared { + append clone_options { --shared} } - $status_op update [incr bcur] $bcnt - update - - foreach i $buckets { - file mkdir [file join .git objects $i] - foreach j [glob -tails -nocomplain \ - -directory [file join $objdir $i] *] { - lappend tolink [file join $i $j] - } - $status_op update [incr bcur] $bcnt - update - } - $status_op stop - - if {$tolink eq {}} { - info_popup [strcat \ - [mc "Nothing to clone from %s." $origin_url] \ - "\n" \ - [mc "The 'master' branch has not been initialized."] \ - ] - destroy $w_body - set done 1 - return - } - - set i [lindex $tolink 0] - if {[catch { - file link -hard \ - [file join .git objects $i] \ - [file join $objdir $i] - } err]} { - info_popup [mc "Hardlinks are unavailable. Falling back to copying."] - set i [_copy_files $this $objdir $tolink] - } else { - set i [_link_files $this $objdir [lrange $tolink 1 end]] - } - if {!$i} return - - destroy $w_body - - set o_status {} } - full { + + if {[catch { set o_cons [console::embed \ $w_body \ [mc "Cloning from %s" $origin_url]] pack $w_body -fill both -expand 1 -padx 10 $o_cons exec \ - [list git fetch --no-tags -k $origin_name] \ - [cb _do_clone_tags] - } - shared { - set fd [safe_open_file [gitdir objects info alternates] w] - fconfigure $fd -translation binary - puts $fd $objdir - close $fd - } + [list git clone {*}$clone_options $origin_url $local_path] \ + [cb _do_clone2_done] + } err]} { + error_popup [strcat [mc "Clone failed."] "\n" $err] + return } - if {$clone_type eq {hardlink} || $clone_type eq {shared}} { - if {![_clone_refs $this]} return - set pwd [pwd] - if {[catch { - cd $origin_url - set HEAD [git rev-parse --verify HEAD^0] - } err]} { - _clone_failed $this [mc "Not a Git repository: %s" [file tail $origin_url]] - return 0 - } - cd $pwd - _do_clone_checkout $this $HEAD + tkwait variable @done + if {!$clone_ok} { + error_popup [mc "Clone failed."] + return } } -method _copy_files {objdir tocopy} { - set status_op [$o_status start \ - [mc "Copying objects"] \ - [mc "KiB"]] - set tot 0 - set cmp 0 - foreach p $tocopy { - incr tot [file size [file join $objdir $p]] - } - foreach p $tocopy { - if {[catch { - set f_in [safe_open_file [file join $objdir $p] r] - set f_cp [safe_open_file [file join .git objects $p] w] - fconfigure $f_in -translation binary -encoding binary - fconfigure $f_cp -translation binary -encoding binary - - while {![eof $f_in]} { - incr cmp [fcopy $f_in $f_cp -size 16384] - $status_op update \ - [expr {$cmp / 1024}] \ - [expr {$tot / 1024}] - update - } - - close $f_in - close $f_cp - } err]} { - _clone_failed $this [mc "Unable to copy object: %s" $err] - $status_op stop - return 0 - } - } - $status_op stop - return 1 -} - -method _link_files {objdir tolink} { - set total [llength $tolink] - set status_op [$o_status start \ - [mc "Linking objects"] \ - [mc "objects"]] - for {set i 0} {$i < $total} {} { - set p [lindex $tolink $i] - if {[catch { - file link -hard \ - [file join .git objects $p] \ - [file join $objdir $p] - } err]} { - _clone_failed $this [mc "Unable to hardlink object: %s" $err] - $status_op stop - return 0 - } - - incr i - if {$i % 5 == 0} { - $status_op update $i $total - update - } - } - $status_op stop - return 1 -} - -method _clone_refs {} { - set pwd [pwd] - if {[catch {cd $origin_url} err]} { - error_popup [mc "Not a Git repository: %s" [file tail $origin_url]] - return 0 - } - set fd_in [git_read [list for-each-ref \ - --tcl \ - {--format=list %(refname) %(objectname) %(*objectname)}]] - cd $pwd - - set fd [safe_open_file [gitdir packed-refs] w] - fconfigure $fd -translation binary - puts $fd "# pack-refs with: peeled" - while {[gets $fd_in line] >= 0} { - set line [eval $line] - set refn [lindex $line 0] - set robj [lindex $line 1] - set tobj [lindex $line 2] - - if {[regsub ^refs/heads/ $refn \ - "refs/remotes/$origin_name/" refn]} { - puts $fd "$robj $refn" - } elseif {[string match refs/tags/* $refn]} { - puts $fd "$robj $refn" - if {$tobj ne {}} { - puts $fd "^$tobj" - } - } - } - close $fd_in - close $fd - return 1 -} - -method _do_clone_tags {ok} { - if {$ok} { - $o_cons exec \ - [list git fetch --tags -k $origin_name] \ - [cb _do_clone_HEAD] - } else { - $o_cons done $ok - _clone_failed $this [mc "Cannot fetch branches and objects. See console output for details."] - } -} - -method _do_clone_HEAD {ok} { - if {$ok} { - $o_cons exec \ - [list git fetch $origin_name HEAD] \ - [cb _do_clone_full_end] - } else { - $o_cons done $ok - _clone_failed $this [mc "Cannot fetch tags. See console output for details."] - } -} - -method _do_clone_full_end {ok} { +method _do_clone2_done {ok} { $o_cons done $ok - if {$ok} { - destroy $w_body - - set HEAD {} - if {[file exists [gitdir FETCH_HEAD]]} { - set fd [safe_open_file [gitdir FETCH_HEAD] r] - while {[gets $fd line] >= 0} { - if {[regexp "^(.{40})\t\t" $line line HEAD]} { - break - } - } - close $fd - } - - catch {git pack-refs} - _do_clone_checkout $this $HEAD - } else { - _clone_failed $this [mc "Cannot determine HEAD. See console output for details."] - } -} - -method _clone_failed {{why {}}} { - if {[catch {file delete -force $local_path} err]} { - set why [strcat \ - $why \ - "\n\n" \ - [mc "Unable to cleanup %s" $local_path] \ - "\n\n" \ - $err] - } - if {$why ne {}} { - update - error_popup [strcat [mc "Clone failed."] "\n" $why] - } -} - -method _do_clone_checkout {HEAD} { - if {$HEAD eq {}} { - info_popup [strcat \ - [mc "No default branch obtained."] \ - "\n" \ - [mc "The 'master' branch has not been initialized."] \ - ] - set done 1 - return - } - if {[catch { - git update-ref HEAD $HEAD^0 + if {[catch { + cd $local_path + set ::_gitdir .git + set ::_prefix {} + _append_recentrepos [pwd] } err]} { - info_popup [strcat \ - [mc "Cannot resolve %s as a commit." $HEAD^0] \ - "\n $err" \ - "\n" \ - [mc "The 'master' branch has not been initialized."] \ - ] - set done 1 - return - } - - set status [status_bar::two_line $w_body] - pack $w_body -fill x -padx 10 -pady 10 - - # We start the status operation here. - # - # This function calls _readtree_wait as a callback. - # - # _readtree_wait in turn either calls _do_clone_submodules directly, - # or calls _postcheckout_wait as a callback which then calls - # _do_clone_submodules. - # - # _do_clone_submodules calls _do_validate_submodule_cloning. - # - # _do_validate_submodule_cloning stops the status operation. - # - # There are no other calls into this chain from other code. - - set o_status_op [$status start \ - [mc "Creating working directory"] \ - [mc "files"]] - - set readtree_err {} - set fd [git_read [list read-tree \ - -m \ - -u \ - -v \ - HEAD \ - HEAD \ - ] \ - [list 2>@1]] - fconfigure $fd -blocking 0 -translation binary - fileevent $fd readable [cb _readtree_wait $fd] -} - -method _readtree_wait {fd} { - set buf [read $fd] - $o_status_op update_meter $buf - append readtree_err $buf - - fconfigure $fd -blocking 1 - if {![eof $fd]} { - fconfigure $fd -blocking 0 - return - } - - if {[catch {close $fd}]} { - set err $readtree_err - regsub {^fatal: } $err {} err - error_popup [strcat \ - [mc "Initial file checkout failed."] \ - "\n\n$err"] - return - } - - # -- Run the post-checkout hook. - # - set fd_ph [githook_read post-checkout [string repeat 0 40] \ - [git rev-parse HEAD] 1] - if {$fd_ph ne {}} { - global pch_error - set pch_error {} - fconfigure $fd_ph -blocking 0 -translation binary -eofchar {} - fileevent $fd_ph readable [cb _postcheckout_wait $fd_ph] - } else { - _do_clone_submodules $this - } -} - -method _postcheckout_wait {fd_ph} { - global pch_error - - append pch_error [read $fd_ph] - fconfigure $fd_ph -blocking 1 - if {[eof $fd_ph]} { - if {[catch {close $fd_ph}]} { - hook_failed_popup post-checkout $pch_error 0 + set ok 0 } - unset pch_error - _do_clone_submodules $this - return } - fconfigure $fd_ph -blocking 0 + if {!$ok} { + set ::_gitdir {} + set ::_prefix {} + } + set clone_ok $ok + set done 1 } -method _do_clone_submodules {} { - if {$recursive eq {true}} { - $o_status_op stop - set o_status_op {} - - destroy $w_body - - set o_cons [console::embed \ - $w_body \ - [mc "Cloning submodules"]] - pack $w_body -fill both -expand 1 -padx 10 - $o_cons exec \ - [list git submodule update --init --recursive] \ - [cb _do_validate_submodule_cloning] - } else { - set done 1 - } -} - -method _do_validate_submodule_cloning {ok} { - if {$ok} { - $o_cons done $ok - set done 1 - } else { - _clone_failed $this [mc "Cannot clone submodules."] - } -} ###################################################################### ## From 3ce650f4c93f9f3aacdb6a1d8cef21bb2009bfa3 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Mon, 21 Jul 2025 11:12:18 -0400 Subject: [PATCH 13/16] git-gui: default to full copy for linked worktrees git-gui's default clone method is git-clone's default, and this uses hardlinks rather than copying the objects directory for local repositories. However, this method explicitly fails if a symlink (or .gitfile) exists in the path to the objects directory. Thus, the default clone option fails for worktrees created by git-new-workdir or git-worktree. git-gui's original do_clone trapped this error for a symlinked git-new-workdir tree, directly falling back to a full clone, while the updated git-gui using git-clone does not. (The old do_clone could not handle gitfile linked worktrees, however). Let's apply the more friendly fallback to a full clone in both these cases where git-clone behavior throws an error on the default method. Signed-off-by: Mark Levedahl --- lib/choose_repository.tcl | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/lib/choose_repository.tcl b/lib/choose_repository.tcl index e74c39c34c..2bd230b5d2 100644 --- a/lib/choose_repository.tcl +++ b/lib/choose_repository.tcl @@ -557,6 +557,25 @@ method _update_clone {args} { method _do_clone2 {} { if {[file isdirectory $origin_url]} { set origin_url [file normalize $origin_url] + if {$clone_type eq {hardlink}} { + # cannot use hardlinks if this is a linked worktree (.gitfile or git-new-workdir) + if {[git -C $origin_url rev-parse --is-inside-work-tree] == {true}} { + set islink 0 + set dotgit [file join $origin_url .git] + if {[file isfile $dotgit]} { + set islink 1 + } else { + set objdir [file join $dotgit objects] + if {[file exists $objdir] && [file type $objdir] == {link}} { + set islink 1 + } + } + if {$islink} { + info_popup [mc "Hardlinks are unavailable. Falling back to copying."] + set clone_type full + } + } + } } if {$clone_type eq {hardlink} && ![file isdirectory $origin_url]} { From 6dfdf7bdcdcf735787e3d3dfcf3415fea1a81f8a Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Fri, 4 Apr 2025 23:08:35 -0400 Subject: [PATCH 14/16] git-gui: use dashless 'git cmd' form for read/write git-gui implements its own approach to locating and running various git subcommands, bypassing git's capabilities for running git-*. This was written in 2007: at that time, many git commands were shell-scripts stored in $(git --exec-path), git's run-command api was not well adapted to Windows and had serious performance issues when it worked at all, and running subcommand 'git foo' as 'git-foo' was common and fully supported. On Windows, git-gui searches $(git --exec-path) for builtin commands, then attempts to find an interpreter on PATH to run those, invoking these differently than on other platforms. For instance, the explicit shebang #!/usr/bin/perl found in a script will be run by the first Perl interpreter found on $PATH, which might not be at that specific location so could be different than what git would run. The various issues leading to the current implemention no longer exist. Most git commands are now builtins, links to run those are not installed in $(git --exec-path) by default (the "dashless" form is recommended instead), and git's run-command api works well everywhere. So, let's use git to launch its subcommands on all platforms. Do so by modifying procs git_read and git_write to use the "dashless" form for invoking git commands, avoiding the search for git-. This leaves _git_cmd unused with cleanup in a later patch. Signed-off-by: Mark Levedahl --- git-gui.sh | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/git-gui.sh b/git-gui.sh index 89e1729d1a..8c60bdb8cd 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -681,30 +681,30 @@ proc safe_open_command {cmd {redir {}}} { } proc git_read {cmd {redir {}}} { - set cmdp [_git_cmd [lindex $cmd 0]] - set cmd [lrange $cmd 1 end] + global _git + set cmdp [concat [list $_git] $cmd] - return [safe_open_command [concat $cmdp $cmd] $redir] + return [safe_open_command $cmdp $redir] } proc git_read_nice {cmd} { + global _git set opt [list] _lappend_nice opt - set cmdp [_git_cmd [lindex $cmd 0]] - set cmd [lrange $cmd 1 end] + set cmdp [concat [list $_git] $cmd] - return [safe_open_command [concat $opt $cmdp $cmd]] + return [safe_open_command [concat $opt $cmdp]] } proc git_write {cmd} { + global _git set cmd [make_arglist_safe $cmd] - set cmdp [_git_cmd [lindex $cmd 0]] - set cmd [lrange $cmd 1 end] + set cmdp [concat [list $_git] $cmd] - _trace_exec [concat $cmdp $cmd] - return [open [concat [list | ] $cmdp $cmd] w] + _trace_exec $cmdp + return [open [concat [list | ] $cmdp] w] } proc githook_read {hook_name args} { From eaca720ecd4368943657c470d5ce0146804d09a7 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Sun, 6 Apr 2025 11:14:35 -0400 Subject: [PATCH 15/16] git-gui: remove procs gitexec and _git_cmd gitexec looks up and caches the method to execute git subcommands using the long deprecated dashed form if found in $(git--exec-path). But, git_read and git_write now use the dashless form, by-passing gitexec. This leaves two remaining uses of gitexec: one during startup to define use of an ssh_key helper, and one in the about dialog box. These are neither performance critical nor likely to be called more than once, so do not justify an otherwise unused cacheing system. Let's change those two uses, making gitexec unused. This allows removing gitexec and _git_cmd. Signed-off-by: Mark Levedahl --- git-gui.sh | 67 +-------------------------------------------------- lib/about.tcl | 2 +- 2 files changed, 2 insertions(+), 67 deletions(-) diff --git a/git-gui.sh b/git-gui.sh index 8c60bdb8cd..9bc773d43c 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -365,7 +365,6 @@ set _appname {Git Gui} set _gitdir {} set _gitworktree {} set _isbare {} -set _gitexec {} set _githtmldir {} set _reponame {} set _shellpath {@@SHELL_PATH@@} @@ -430,20 +429,6 @@ proc gitdir {args} { return [eval [list file join $_gitdir] $args] } -proc gitexec {args} { - global _gitexec - if {$_gitexec eq {}} { - if {[catch {set _gitexec [git --exec-path]} err]} { - error "Git not installed?\n\n$err" - } - set _gitexec [file normalize $_gitexec] - } - if {$args eq {}} { - return $_gitexec - } - return [eval [list file join $_gitexec] $args] -} - proc githtmldir {args} { global _githtmldir if {$_githtmldir eq {}} { @@ -576,56 +561,6 @@ proc _trace_exec {cmd} { #'" fix poor old emacs font-lock mode -proc _git_cmd {name} { - global _git_cmd_path - - if {[catch {set v $_git_cmd_path($name)}]} { - switch -- $name { - version - - --version - - --exec-path { return [list $::_git $name] } - } - - set p [gitexec git-$name$::_search_exe] - if {[file exists $p]} { - set v [list $p] - } elseif {[is_Windows] && [file exists [gitexec git-$name]]} { - # Try to determine what sort of magic will make - # git-$name go and do its thing, because native - # Tcl on Windows doesn't know it. - # - set p [gitexec git-$name] - set f [safe_open_file $p r] - set s [gets $f] - close $f - - switch -glob -- [lindex $s 0] { - #!*sh { set i sh } - #!*perl { set i perl } - #!*python { set i python } - default { error "git-$name is not supported: $s" } - } - - upvar #0 _$i interp - if {![info exists interp]} { - set interp [_which $i] - } - if {$interp eq {}} { - error "git-$name requires $i (not in PATH)" - } - set v [concat [list $interp] [lrange $s 1 end] [list $p]] - } else { - # Assume it is builtin to git somehow and we - # aren't actually able to see a file for it. - # - set v [list $::_git $name] - } - set _git_cmd_path($name) $v - } - return $v -} - -# Run a shell command connected via pipes on stdout. # This is for use with textconv filters and uses sh -c "..." to allow it to # contain a command with arguments. We presume this # to be a shellscript that the configured shell (/bin/sh by default) knows @@ -1194,7 +1129,7 @@ set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}] # Suggest our implementation of askpass, if none is set if {![info exists env(SSH_ASKPASS)]} { - set env(SSH_ASKPASS) [gitexec git-gui--askpass] + set env(SSH_ASKPASS) [file join [git --exec-path] git-gui--askpass] } ###################################################################### diff --git a/lib/about.tcl b/lib/about.tcl index cfa50fca87..85f48709a7 100644 --- a/lib/about.tcl +++ b/lib/about.tcl @@ -44,7 +44,7 @@ proc do_about {} { set d {} append d "git wrapper: $::_git\n" - append d "git exec dir: [gitexec]\n" + append d "git exec dir: [git --exec-path]\n" append d "git-gui lib: $oguilib" paddedlabel $w.vers -text $v From f4b7ad5ab808ca733dbeede2c009faab0341b994 Mon Sep 17 00:00:00 2001 From: Mark Levedahl Date: Sat, 5 Apr 2025 08:00:00 -0400 Subject: [PATCH 16/16] git-gui: eliminate _search_exe git-gui has _search_exe as needed to give the executable suffix (.exe) on Windows. But, the prior commit eliminated the only user of this variable. Delete it. Signed-off-by: Mark Levedahl --- git-gui.sh | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/git-gui.sh b/git-gui.sh index 9bc773d43c..b361d8c8ae 100755 --- a/git-gui.sh +++ b/git-gui.sh @@ -81,10 +81,8 @@ proc is_Cygwin {} { if {[is_Windows]} { set _path_sep {;} - set _search_exe .exe } else { set _path_sep {:} - set _search_exe {} } if {[is_Windows]} { @@ -114,15 +112,15 @@ set env(PATH) [join $_search_path $_path_sep] if {[is_Windows]} { proc _which {what args} { - global _search_exe _search_path + global _search_path if {[lsearch -exact $args -script] >= 0} { set suffix {} - } elseif {[string match *$_search_exe [string tolower $what]]} { + } elseif {[string match *.exe [string tolower $what]]} { # The search string already has the file extension set suffix {} } else { - set suffix $_search_exe + set suffix .exe } foreach p $_search_path {