comparison contrib/hgk @ 4686:39001f4b7d99

hgk: Use $HG instead of hg (see 849f011dbf79)
author Thomas Arendsen Hein <thomas@intevation.de>
date Sat, 23 Jun 2007 21:10:55 +0200
parents 1774c037fbd2
children e1d1b22bab57
comparison
equal deleted inserted replaced
4685:b5bbfa18daf7 4686:39001f4b7d99
41 lappend revargs $opt 41 lappend revargs $opt
42 } 42 }
43 } 43 }
44 if [catch { 44 if [catch {
45 set parse_args [concat --default HEAD $revargs] 45 set parse_args [concat --default HEAD $revargs]
46 set parse_temp [eval exec hg debug-rev-parse $parse_args] 46 set parse_temp [eval exec {$env(HG)} debug-rev-parse $parse_args]
47 regsub -all "\r\n" $parse_temp "\n" parse_temp 47 regsub -all "\r\n" $parse_temp "\n" parse_temp
48 set parsed_args [split $parse_temp "\n"] 48 set parsed_args [split $parse_temp "\n"]
49 } err] { 49 } err] {
50 # if git-rev-parse failed for some reason... 50 # if git-rev-parse failed for some reason...
51 if {$rargs == {}} { 51 if {$rargs == {}} {
55 } 55 }
56 if {$limit > 0} { 56 if {$limit > 0} {
57 set parsed_args [concat -n $limit $parsed_args] 57 set parsed_args [concat -n $limit $parsed_args]
58 } 58 }
59 if [catch { 59 if [catch {
60 set commfd [open "|hg debug-rev-list --header --topo-order --parents $parsed_args" r] 60 set commfd [open "|{$env(HG)} debug-rev-list --header --topo-order --parents $parsed_args" r]
61 } err] { 61 } err] {
62 puts stderr "Error executing hg debug-rev-list: $err" 62 puts stderr "Error executing hg debug-rev-list: $err"
63 exit 1 63 exit 1
64 } 64 }
65 set leftover {} 65 set leftover {}
177 fileevent $commfd readable [list getcommitlines $commfd] 177 fileevent $commfd readable [list getcommitlines $commfd]
178 } 178 }
179 } 179 }
180 180
181 proc readcommit {id} { 181 proc readcommit {id} {
182 if [catch {set contents [exec hg debug-cat-file commit $id]}] return 182 global env
183 if [catch {set contents [exec $env(HG) debug-cat-file commit $id]}] return
183 parsecommit $id $contents 0 {} 184 parsecommit $id $contents 0 {}
184 } 185 }
185 186
186 proc parsecommit {id contents listed olds} { 187 proc parsecommit {id contents listed olds} {
187 global commitinfo children nchildren parents nparents cdate ncleft 188 global commitinfo children nchildren parents nparents cdate ncleft
256 set commitinfo($id) [list $headline $auname $audate \ 257 set commitinfo($id) [list $headline $auname $audate \
257 $comname $comdate $comment $rev] 258 $comname $comdate $comment $rev]
258 } 259 }
259 260
260 proc readrefs {} { 261 proc readrefs {} {
261 global tagids idtags headids idheads tagcontents 262 global tagids idtags headids idheads tagcontents env
262 263
263 set tags [exec hg tags] 264 set tags [exec $env(HG) tags]
264 regsub -all "\r\n" $tags "\n" tags 265 regsub -all "\r\n" $tags "\n" tags
265 set lines [split $tags "\n"] 266 set lines [split $tags "\n"]
266 foreach f $lines { 267 foreach f $lines {
267 regexp {(\S+)$} $f full 268 regexp {(\S+)$} $f full
268 regsub {\s+(\S+)$} $f "" direct 269 regsub {\s+(\S+)$} $f "" direct
1711 proc findpatches {} { 1712 proc findpatches {} {
1712 global findstring selectedline numcommits 1713 global findstring selectedline numcommits
1713 global findprocpid findprocfile 1714 global findprocpid findprocfile
1714 global finddidsel ctext lineid findinprogress 1715 global finddidsel ctext lineid findinprogress
1715 global findinsertpos 1716 global findinsertpos
1717 global env
1716 1718
1717 if {$numcommits == 0} return 1719 if {$numcommits == 0} return
1718 1720
1719 # make a list of all the ids to search, starting at the one 1721 # make a list of all the ids to search, starting at the one
1720 # after the selected line (if any) 1722 # after the selected line (if any)
1730 } 1732 }
1731 append inputids $lineid($l) "\n" 1733 append inputids $lineid($l) "\n"
1732 } 1734 }
1733 1735
1734 if {[catch { 1736 if {[catch {
1735 set f [open [list | hg debug-diff-tree --stdin -s -r -S$findstring \ 1737 set f [open [list | $env(HG) debug-diff-tree --stdin -s -r -S$findstring \
1736 << $inputids] r] 1738 << $inputids] r]
1737 } err]} { 1739 } err]} {
1738 error_popup "Error starting search process: $err" 1740 error_popup "Error starting search process: $err"
1739 return 1741 return
1740 } 1742 }
1802 global selectedline numcommits lineid ctext 1804 global selectedline numcommits lineid ctext
1803 global ffileline finddidsel parents nparents 1805 global ffileline finddidsel parents nparents
1804 global findinprogress findstartline findinsertpos 1806 global findinprogress findstartline findinsertpos
1805 global treediffs fdiffids fdiffsneeded fdiffpos 1807 global treediffs fdiffids fdiffsneeded fdiffpos
1806 global findmergefiles 1808 global findmergefiles
1809 global env
1807 1810
1808 if {$numcommits == 0} return 1811 if {$numcommits == 0} return
1809 1812
1810 if {[info exists selectedline]} { 1813 if {[info exists selectedline]} {
1811 set l [expr {$selectedline + 1}] 1814 set l [expr {$selectedline + 1}]
1833 } 1836 }
1834 1837
1835 # start off a git-diff-tree process if needed 1838 # start off a git-diff-tree process if needed
1836 if {$diffsneeded ne {}} { 1839 if {$diffsneeded ne {}} {
1837 if {[catch { 1840 if {[catch {
1838 set df [open [list | hg debug-diff-tree -r --stdin << $diffsneeded] r] 1841 set df [open [list | $env(HG) debug-diff-tree -r --stdin << $diffsneeded] r]
1839 } err ]} { 1842 } err ]} {
1840 error_popup "Error starting search process: $err" 1843 error_popup "Error starting search process: $err"
1841 return 1844 return
1842 } 1845 }
1843 catch {unset fdiffids} 1846 catch {unset fdiffids}
2250 contmergediff {} 2253 contmergediff {}
2251 } 2254 }
2252 } 2255 }
2253 2256
2254 proc findgca {ids} { 2257 proc findgca {ids} {
2258 global env
2255 set gca {} 2259 set gca {}
2256 foreach id $ids { 2260 foreach id $ids {
2257 if {$gca eq {}} { 2261 if {$gca eq {}} {
2258 set gca $id 2262 set gca $id
2259 } else { 2263 } else {
2260 if {[catch { 2264 if {[catch {
2261 set gca [exec hg debug-merge-base $gca $id] 2265 set gca [exec $env(HG) debug-merge-base $gca $id]
2262 } err]} { 2266 } err]} {
2263 return {} 2267 return {}
2264 } 2268 }
2265 } 2269 }
2266 } 2270 }
2330 2334
2331 proc showmergediff {} { 2335 proc showmergediff {} {
2332 global cflist diffmergeid mergefilelist parents 2336 global cflist diffmergeid mergefilelist parents
2333 global diffopts diffinhunk currentfile currenthunk filelines 2337 global diffopts diffinhunk currentfile currenthunk filelines
2334 global diffblocked groupfilelast mergefds groupfilenum grouphunks 2338 global diffblocked groupfilelast mergefds groupfilenum grouphunks
2339 global env
2335 2340
2336 set files $mergefilelist($diffmergeid) 2341 set files $mergefilelist($diffmergeid)
2337 foreach f $files { 2342 foreach f $files {
2338 $cflist insert end $f 2343 $cflist insert end $f
2339 } 2344 }
2344 catch {unset filelines} 2349 catch {unset filelines}
2345 catch {unset groupfilenum} 2350 catch {unset groupfilenum}
2346 catch {unset grouphunks} 2351 catch {unset grouphunks}
2347 set groupfilelast -1 2352 set groupfilelast -1
2348 foreach p $parents($diffmergeid) { 2353 foreach p $parents($diffmergeid) {
2349 set cmd [list | hg debug-diff-tree -p $p $diffmergeid] 2354 set cmd [list | $env(HG) debug-diff-tree -p $p $diffmergeid]
2350 set cmd [concat $cmd $mergefilelist($diffmergeid)] 2355 set cmd [concat $cmd $mergefilelist($diffmergeid)]
2351 if {[catch {set f [open $cmd r]} err]} { 2356 if {[catch {set f [open $cmd r]} err]} {
2352 error_popup "Error getting diffs: $err" 2357 error_popup "Error getting diffs: $err"
2353 foreach f $flist { 2358 foreach f $flist {
2354 catch {close $f} 2359 catch {close $f}
2783 } 2788 }
2784 getblobdiffs $ids 2789 getblobdiffs $ids
2785 } 2790 }
2786 2791
2787 proc gettreediffs {ids} { 2792 proc gettreediffs {ids} {
2788 global treediff parents treepending 2793 global treediff parents treepending env
2789 set treepending $ids 2794 set treepending $ids
2790 set treediff {} 2795 set treediff {}
2791 set id [lindex $ids 0] 2796 set id [lindex $ids 0]
2792 set p [lindex $ids 1] 2797 set p [lindex $ids 1]
2793 if [catch {set gdtf [open "|hg debug-diff-tree -r $p $id" r]}] return 2798 if [catch {set gdtf [open "|{$env(HG)} debug-diff-tree -r $p $id" r]}] return
2794 fconfigure $gdtf -blocking 0 2799 fconfigure $gdtf -blocking 0
2795 fileevent $gdtf readable [list gettreediffline $gdtf $ids] 2800 fileevent $gdtf readable [list gettreediffline $gdtf $ids]
2796 } 2801 }
2797 2802
2798 proc gettreediffline {gdtf ids} { 2803 proc gettreediffline {gdtf ids} {
2824 global difffilestart nextupdate diffinhdr treediffs 2829 global difffilestart nextupdate diffinhdr treediffs
2825 2830
2826 set id [lindex $ids 0] 2831 set id [lindex $ids 0]
2827 set p [lindex $ids 1] 2832 set p [lindex $ids 1]
2828 set env(GIT_DIFF_OPTS) $diffopts 2833 set env(GIT_DIFF_OPTS) $diffopts
2829 set cmd [list | hg debug-diff-tree -r -p -C $p $id] 2834 set cmd [list | $env(HG) debug-diff-tree -r -p -C $p $id]
2830 if {[catch {set bdf [open $cmd r]} err]} { 2835 if {[catch {set bdf [open $cmd r]} err]} {
2831 puts "error getting diffs: $err" 2836 puts "error getting diffs: $err"
2832 return 2837 return
2833 } 2838 }
2834 set diffinhdr 0 2839 set diffinhdr 0
3407 $patchtop.$e conf -state readonly 3412 $patchtop.$e conf -state readonly
3408 } 3413 }
3409 } 3414 }
3410 3415
3411 proc mkpatchgo {} { 3416 proc mkpatchgo {} {
3412 global patchtop 3417 global patchtop env
3413 3418
3414 set oldid [$patchtop.fromsha1 get] 3419 set oldid [$patchtop.fromsha1 get]
3415 set newid [$patchtop.tosha1 get] 3420 set newid [$patchtop.tosha1 get]
3416 set fname [$patchtop.fname get] 3421 set fname [$patchtop.fname get]
3417 if {[catch {exec hg debug-diff-tree -p $oldid $newid >$fname &} err]} { 3422 if {[catch {exec $env(HG) debug-diff-tree -p $oldid $newid >$fname &} err]} {
3418 error_popup "Error creating patch: $err" 3423 error_popup "Error creating patch: $err"
3419 } 3424 }
3420 catch {destroy $patchtop} 3425 catch {destroy $patchtop}
3421 unset patchtop 3426 unset patchtop
3422 } 3427 }
3471 if {[info exists tagids($tag)]} { 3476 if {[info exists tagids($tag)]} {
3472 error_popup "Tag \"$tag\" already exists" 3477 error_popup "Tag \"$tag\" already exists"
3473 return 3478 return
3474 } 3479 }
3475 if {[catch { 3480 if {[catch {
3476 set out [exec hg tag -r $id $tag] 3481 set out [exec $env(HG) tag -r $id $tag]
3477 } err]} { 3482 } err]} {
3478 error_popup "Error creating tag: $err" 3483 error_popup "Error creating tag: $err"
3479 return 3484 return
3480 } 3485 }
3481 3486
3547 global wrcomtop 3552 global wrcomtop
3548 3553
3549 set id [$wrcomtop.sha1 get] 3554 set id [$wrcomtop.sha1 get]
3550 set cmd "echo $id | [$wrcomtop.cmd get]" 3555 set cmd "echo $id | [$wrcomtop.cmd get]"
3551 set fname [$wrcomtop.fname get] 3556 set fname [$wrcomtop.fname get]
3552 if {[catch {exec sh -c $cmd >$fname &} err]} { 3557 if {[catch {exec sh -c $cmd > $fname &} err]} {
3553 error_popup "Error writing commit: $err" 3558 error_popup "Error writing commit: $err"
3554 } 3559 }
3555 catch {destroy $wrcomtop} 3560 catch {destroy $wrcomtop}
3556 unset wrcomtop 3561 unset wrcomtop
3557 } 3562 }
3633 3638
3634 # defaults... 3639 # defaults...
3635 set datemode 0 3640 set datemode 0
3636 set boldnames 0 3641 set boldnames 0
3637 set diffopts "-U 5 -p" 3642 set diffopts "-U 5 -p"
3638 set wrcomcmd "hg debug-diff-tree --stdin -p --pretty" 3643 set wrcomcmd "\"\$HG\" debug-diff-tree --stdin -p --pretty"
3639 3644
3640 set mainfont {Helvetica 9} 3645 set mainfont {Helvetica 9}
3641 set textfont {Courier 9} 3646 set textfont {Courier 9}
3642 set findmergefiles 0 3647 set findmergefiles 0
3643 set gaudydiff 0 3648 set gaudydiff 0