ilyagr.bsky.social
Testing tangled. Original: https://github.com/j6t/gitk
Merge branch 'g4w-gitk' of https://github.com/dscho/gitk
* 'g4w-gitk' of https://github.com/dscho/gitk:
gitk: make the "list references" default window width wider
gitk: fix arrow keys in input fields with Tcl/Tk >= 8.6
gitk: Use an external icon file on Windows
gitk: Unicode file name support
gitk(Windows): avoid inadvertently calling executables in the worktree
Signed-off-by: Johannes Sixt <j6t@kdbg.org>
+175
-30
+175
-30
gitk
+175
-30
gitk
···
9
9
10
10
package require Tk
11
11
12
+
######################################################################
13
+
##
14
+
## Enabling platform-specific code paths
15
+
16
+
proc is_MacOSX {} {
17
+
if {[tk windowingsystem] eq {aqua}} {
18
+
return 1
19
+
}
20
+
return 0
21
+
}
22
+
23
+
proc is_Windows {} {
24
+
if {$::tcl_platform(platform) eq {windows}} {
25
+
return 1
26
+
}
27
+
return 0
28
+
}
29
+
30
+
set _iscygwin {}
31
+
proc is_Cygwin {} {
32
+
global _iscygwin
33
+
if {$_iscygwin eq {}} {
34
+
if {[string match "CYGWIN_*" $::tcl_platform(os)]} {
35
+
set _iscygwin 1
36
+
} else {
37
+
set _iscygwin 0
38
+
}
39
+
}
40
+
return $_iscygwin
41
+
}
42
+
43
+
######################################################################
44
+
##
45
+
## PATH lookup
46
+
47
+
set _search_path {}
48
+
proc _which {what args} {
49
+
global env _search_exe _search_path
50
+
51
+
if {$_search_path eq {}} {
52
+
if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
53
+
set _search_path [split [exec cygpath \
54
+
--windows \
55
+
--path \
56
+
--absolute \
57
+
$env(PATH)] {;}]
58
+
set _search_exe .exe
59
+
} elseif {[is_Windows]} {
60
+
set gitguidir [file dirname [info script]]
61
+
regsub -all ";" $gitguidir "\\;" gitguidir
62
+
set env(PATH) "$gitguidir;$env(PATH)"
63
+
set _search_path [split $env(PATH) {;}]
64
+
# Skip empty `PATH` elements
65
+
set _search_path [lsearch -all -inline -not -exact \
66
+
$_search_path ""]
67
+
set _search_exe .exe
68
+
} else {
69
+
set _search_path [split $env(PATH) :]
70
+
set _search_exe {}
71
+
}
72
+
}
73
+
74
+
if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
75
+
set suffix {}
76
+
} else {
77
+
set suffix $_search_exe
78
+
}
79
+
80
+
foreach p $_search_path {
81
+
set p [file join $p $what$suffix]
82
+
if {[file exists $p]} {
83
+
return [file normalize $p]
84
+
}
85
+
}
86
+
return {}
87
+
}
88
+
89
+
proc sanitize_command_line {command_line from_index} {
90
+
set i $from_index
91
+
while {$i < [llength $command_line]} {
92
+
set cmd [lindex $command_line $i]
93
+
if {[file pathtype $cmd] ne "absolute"} {
94
+
set fullpath [_which $cmd]
95
+
if {$fullpath eq ""} {
96
+
throw {NOT-FOUND} "$cmd not found in PATH"
97
+
}
98
+
lset command_line $i $fullpath
99
+
}
100
+
101
+
# handle piped commands, e.g. `exec A | B`
102
+
for {incr i} {$i < [llength $command_line]} {incr i} {
103
+
if {[lindex $command_line $i] eq "|"} {
104
+
incr i
105
+
break
106
+
}
107
+
}
108
+
}
109
+
return $command_line
110
+
}
111
+
112
+
# Override `exec` to avoid unsafe PATH lookup
113
+
114
+
rename exec real_exec
115
+
116
+
proc exec {args} {
117
+
# skip options
118
+
for {set i 0} {$i < [llength $args]} {incr i} {
119
+
set arg [lindex $args $i]
120
+
if {$arg eq "--"} {
121
+
incr i
122
+
break
123
+
}
124
+
if {[string range $arg 0 0] ne "-"} {
125
+
break
126
+
}
127
+
}
128
+
set args [sanitize_command_line $args $i]
129
+
uplevel 1 real_exec $args
130
+
}
131
+
132
+
# Override `open` to avoid unsafe PATH lookup
133
+
134
+
rename open real_open
135
+
136
+
proc open {args} {
137
+
set arg0 [lindex $args 0]
138
+
if {[string range $arg0 0 0] eq "|"} {
139
+
set command_line [string trim [string range $arg0 1 end]]
140
+
lset args 0 "| [sanitize_command_line $command_line 0]"
141
+
}
142
+
uplevel 1 real_open $args
143
+
}
144
+
145
+
# End of safe PATH lookup stuff
146
+
12
147
proc hasworktree {} {
13
148
return [expr {[exec git rev-parse --is-bare-repository] == "false" &&
14
149
[exec git rev-parse --is-inside-git-dir] == "false"}]
···
2103
2238
global headctxmenu progresscanv progressitem progresscoords statusw
2104
2239
global fprogitem fprogcoord lastprogupdate progupdatepending
2105
2240
global rprogitem rprogcoord rownumsel numcommits
2106
-
global have_tk85 use_ttk NS
2241
+
global have_tk85 have_tk86 use_ttk NS
2107
2242
global git_version
2108
2243
global worddiff
2109
2244
···
2601
2736
bind . <Key-Down> "selnextline 1"
2602
2737
bind . <Shift-Key-Up> "dofind -1 0"
2603
2738
bind . <Shift-Key-Down> "dofind 1 0"
2604
-
bindkey <Key-Right> "goforw"
2605
-
bindkey <Key-Left> "goback"
2739
+
if {$have_tk86} {
2740
+
bindkey <<NextChar>> "goforw"
2741
+
bindkey <<PrevChar>> "goback"
2742
+
} else {
2743
+
bindkey <Key-Right> "goforw"
2744
+
bindkey <Key-Left> "goback"
2745
+
}
2606
2746
bind . <Key-Prior> "selnextpage -1"
2607
2747
bind . <Key-Next> "selnextpage 1"
2608
2748
bind . <$M1B-Home> "allcanvs yview moveto 0.0"
···
7720
7860
if {[string index $fname 0] eq "\""} {
7721
7861
set fname [lindex $fname 0]
7722
7862
}
7723
-
set fname [encoding convertfrom $fname]
7863
+
set fname [encoding convertfrom utf-8 $fname]
7724
7864
lappend treefilelist($id) $fname
7725
7865
}
7726
7866
if {![eof $gtf]} {
···
7982
8122
if {[string index $file 0] eq "\""} {
7983
8123
set file [lindex $file 0]
7984
8124
}
7985
-
set file [encoding convertfrom $file]
8125
+
set file [encoding convertfrom utf-8 $file]
7986
8126
if {$file ne [lindex $treediff end]} {
7987
8127
lappend treediff $file
7988
8128
lappend sublist $file
···
8127
8267
global ctext curdiffstart treediffs diffencoding
8128
8268
global ctext_file_names jump_to_here targetline diffline
8129
8269
8130
-
set fname [encoding convertfrom $fname]
8270
+
set fname [encoding convertfrom utf-8 $fname]
8131
8271
set diffencoding [get_path_encoding $fname]
8132
8272
set i [lsearch -exact $treediffs($ids) $fname]
8133
8273
if {$i >= 0} {
···
8189
8329
8190
8330
if {![string compare -length 5 "diff " $line]} {
8191
8331
if {![regexp {^diff (--cc|--git) } $line m type]} {
8192
-
set line [encoding convertfrom $line]
8332
+
set line [encoding convertfrom utf-8 $line]
8193
8333
$ctext insert end "$line\n" hunksep
8194
8334
continue
8195
8335
}
···
8238
8378
makediffhdr $fname $ids
8239
8379
8240
8380
} elseif {![string compare -length 16 "* Unmerged path " $line]} {
8241
-
set fname [encoding convertfrom [string range $line 16 end]]
8381
+
set fname [encoding convertfrom utf-8 [string range $line 16 end]]
8242
8382
$ctext insert end "\n"
8243
8383
set curdiffstart [$ctext index "end - 1c"]
8244
8384
lappend ctext_file_names $fname
···
8291
8431
if {[string index $fname 0] eq "\""} {
8292
8432
set fname [lindex $fname 0]
8293
8433
}
8294
-
set fname [encoding convertfrom $fname]
8434
+
set fname [encoding convertfrom utf-8 $fname]
8295
8435
set i [lsearch -exact $treediffs($ids) $fname]
8296
8436
if {$i >= 0} {
8297
8437
setinlist difffilestart $i $curdiffstart
···
8310
8450
set diffinhdr 0
8311
8451
return
8312
8452
}
8453
+
set line [encoding convertfrom utf-8 $line]
8313
8454
$ctext insert end "$line\n" filesep
8314
8455
8315
8456
} else {
···
10068
10209
text $top.list -background $bgcolor -foreground $fgcolor \
10069
10210
-selectbackground $selectbgcolor -font mainfont \
10070
10211
-xscrollcommand "$top.xsb set" -yscrollcommand "$top.ysb set" \
10071
-
-width 30 -height 20 -cursor $maincursor \
10212
+
-width 60 -height 20 -cursor $maincursor \
10072
10213
-spacing1 1 -spacing3 1 -state disabled
10073
10214
$top.list tag configure highlight -background $selectbgcolor
10074
10215
if {![lsearch -exact $bglist $top.list]} {
···
12305
12446
foreach row [split $rlist "\n"] {
12306
12447
if {[regexp "(.*): $attr: (.*)" $row m path value]} {
12307
12448
if {[string index $path 0] eq "\""} {
12308
-
set path [encoding convertfrom [lindex $path 0]]
12449
+
set path [encoding convertfrom utf-8 [lindex $path 0]]
12309
12450
}
12310
12451
set path_attr_cache($attr,$path) $value
12311
12452
}
···
12335
12476
set gitk_prefix [file dirname [file dirname [file normalize $argv0]]]
12336
12477
set gitk_libdir [file join $gitk_prefix share gitk lib]
12337
12478
set gitk_msgsdir [file join $gitk_libdir msgs]
12338
-
unset gitk_prefix
12339
12479
}
12340
12480
12341
12481
## Internationalization (i18n) through msgcat and gettext. See
···
12637
12777
set nullfile "/dev/null"
12638
12778
12639
12779
set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
12780
+
set have_tk86 [expr {[package vcompare $tk_version "8.6"] >= 0}]
12640
12781
if {![info exists have_ttk]} {
12641
12782
set have_ttk [llength [info commands ::ttk::style]]
12642
12783
}
···
12701
12842
set worktree [gitworktree]
12702
12843
setcoords
12703
12844
makewindow
12704
-
catch {
12705
-
image create photo gitlogo -width 16 -height 16
12845
+
if {$::tcl_platform(platform) eq {windows} && [file exists $gitk_prefix/etc/git.ico]} {
12846
+
wm iconbitmap . -default $gitk_prefix/etc/git.ico
12847
+
} else {
12848
+
catch {
12849
+
image create photo gitlogo -width 16 -height 16
12706
12850
12707
-
image create photo gitlogominus -width 4 -height 2
12708
-
gitlogominus put #C00000 -to 0 0 4 2
12709
-
gitlogo copy gitlogominus -to 1 5
12710
-
gitlogo copy gitlogominus -to 6 5
12711
-
gitlogo copy gitlogominus -to 11 5
12712
-
image delete gitlogominus
12851
+
image create photo gitlogominus -width 4 -height 2
12852
+
gitlogominus put #C00000 -to 0 0 4 2
12853
+
gitlogo copy gitlogominus -to 1 5
12854
+
gitlogo copy gitlogominus -to 6 5
12855
+
gitlogo copy gitlogominus -to 11 5
12856
+
image delete gitlogominus
12713
12857
12714
-
image create photo gitlogoplus -width 4 -height 4
12715
-
gitlogoplus put #008000 -to 1 0 3 4
12716
-
gitlogoplus put #008000 -to 0 1 4 3
12717
-
gitlogo copy gitlogoplus -to 1 9
12718
-
gitlogo copy gitlogoplus -to 6 9
12719
-
gitlogo copy gitlogoplus -to 11 9
12720
-
image delete gitlogoplus
12858
+
image create photo gitlogoplus -width 4 -height 4
12859
+
gitlogoplus put #008000 -to 1 0 3 4
12860
+
gitlogoplus put #008000 -to 0 1 4 3
12861
+
gitlogo copy gitlogoplus -to 1 9
12862
+
gitlogo copy gitlogoplus -to 6 9
12863
+
gitlogo copy gitlogoplus -to 11 9
12864
+
image delete gitlogoplus
12721
12865
12722
-
image create photo gitlogo32 -width 32 -height 32
12723
-
gitlogo32 copy gitlogo -zoom 2 2
12866
+
image create photo gitlogo32 -width 32 -height 32
12867
+
gitlogo32 copy gitlogo -zoom 2 2
12724
12868
12725
-
wm iconphoto . -default gitlogo gitlogo32
12869
+
wm iconphoto . -default gitlogo gitlogo32
12870
+
}
12726
12871
}
12727
12872
# wait for the window to become visible
12728
12873
if {![winfo viewable .]} {tkwait visibility .}