Mercurial > hg
comparison contrib/hgk @ 4688: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
4687:b5bbfa18daf7 | 4688: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 |