Compare commits

...

3 Commits

  1. 1
      src/bootsupport/modules/punk/mix/commandset/repo-0.1.0.tm
  2. 72
      src/bootsupport/modules/punk/repo-0.1.1.tm
  3. 2
      src/modules/punk/basictelnet-999999.0a1.0.tm
  4. 39
      src/modules/punk/console-999999.0a1.0.tm
  5. 2
      src/modules/punk/lib-999999.0a1.0.tm
  6. 18
      src/modules/punk/repl-0.1.tm
  7. 1
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/repo-0.1.0.tm
  8. 72
      src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm
  9. 1
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/repo-0.1.0.tm
  10. 72
      src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm
  11. 1
      src/vfs/_vfscommon/modules/punk/mix/commandset/repo-0.1.0.tm
  12. 55
      src/vfs/_vfscommon/modules/punk/repl-0.1.tm
  13. 72
      src/vfs/_vfscommon/modules/punk/repo-0.1.1.tm

1
src/bootsupport/modules/punk/mix/commandset/repo-0.1.0.tm

@ -25,6 +25,7 @@
namespace eval punk::mix::commandset::repo {
namespace export *
proc tickets {{project ""}} {
#todo
set result ""
if {[string length $project]} {
puts stderr "project status unimplemented"

72
src/bootsupport/modules/punk/repo-0.1.1.tm

@ -346,6 +346,11 @@ namespace eval punk::repo {
#does a dual git/fossil repo make sense if both are committing??
# see: https://fossil-scm.org/home/doc/trunk/www/inout.wiki for bidirectional sync info
proc workingdir_state {{abspath {}} args} {
#we should try to minimize executable calls
#an extra git/fossil executable call required for tags
#git seems to require more executable calls
set defaults [list\
-repotypes [list fossil git]\
-repopaths ""\
@ -408,6 +413,8 @@ namespace eval punk::repo {
set revision ""
set revision_iso8601 ""
set pathdict [dict create]
set branch ""
set tags ""
if {![llength $repotypes_to_query]} {
error "No tracking information available for project at $repodir with the chosen repotypes '$opt_repotypes'. Ensure project workingdir is a fossil (or git) checkout"
@ -437,6 +444,38 @@ namespace eval punk::repo {
}
set revision_iso8601 "${revision_ymd}T${revision_hms}${revision_tz}"
#REVIEW! what are the semantic difference between tags in fossil v git?
#fossil has tagtypes such as propagated and singleton(onetime)
#if we get all tag info for the revision - we can get the current branch (branch=somename tag) at the same time
#by retrieving with --raw - we have to process some prefixes such as sym- but probably best not done here
#we will return all tags that apply to the current revision and let the caller decide the meanings
if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$fossil_cmd tag ls --raw $revision]} cmdresult]} {
set branchinfo [lindex [grep {branch=*} $cmdresult] 0] ;#first line match - should only be one
set branch [lindex [split $branchinfo =] 1]
set tags [list]
foreach ln [split $cmdresult \n] {
if {[string trim $ln] eq ""} {
continue
}
lappend tags [string trim $ln]
}
}
#set tags_info [lindex [grep {tags:*} $fossilstate 0] ;#first line match - should only be one
#we get lines like:
#tags: trunk, main
#tags: trunk
#set rawtags [lrange $tags_info 1 end] ;#REVIEW
#set tags [list]
#foreach t $rawtags {
# lappend tags [string trimright $t ,]
#}
#if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$fossil_cmd branch current]} cmdresult]} {
# set branch $cmdresult ;#command result doesn't include newline etc
#}
dict set resultdict ahead ""
dict set resultdict behind ""
@ -490,6 +529,7 @@ namespace eval punk::repo {
set git_cmd [auto_execok git]
# -uno = suppress ? lines.
# -b = show ranch and tracking info
#our basic parsing/grepping assumes --porcelain=2
if {[catch {punk::mix::util::do_in_path $repodir [list exec {*}$git_cmd status --porcelain=2 -b -- $abspath]} gitstate]} {
error "workingdir_state error: Unable to retrieve workingdir state using git. Errormsg: $gitstate"
}
@ -499,6 +539,13 @@ namespace eval punk::repo {
puts stderr "workingdir_state: git revision is (initial) - no file state to gather"
break
}
# line: # branch.head somebranchname
set branch [lindex [grep {# branch.head *} $gitstate] 0 2]
if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$git_cmd describe --exact-match --tags]} cmdresult]} {
set tags $cmdresult ;#review - we have short tags vs longer.. e.g v0.1a vs v0.1a-184-g856fab4 - which is returned? Also how are multiple separated?
}
#often there will be no tag - so the common case is actually an error "fatal: not ag exactly matchs 'xxxx...'"
# -- --- --- --- ---
#could use %ci for ISO8601 data - see git-show manpage, but this will be in timezone of developer's machine - we need it in UTC for comparison to fossil outputs and other devs
@ -600,9 +647,11 @@ namespace eval punk::repo {
puts stderr "workingdir_state - repotype $rt not supported"
}
}
dict set resultdict revision $revision
dict set resultdict revision_iso8601 $revision_iso8601
dict set resultdict paths $pathdict
dict set resultdict branch $branch
dict set resultdict tags $tags
dict set resultdict revision $revision
dict set resultdict revision_iso8601 $revision_iso8601
dict set resultdict paths $pathdict
return $resultdict
}
proc workingdir_state_summary {repostate args} {
@ -610,8 +659,13 @@ namespace eval punk::repo {
error "workingdir_state_summary error repostate doesn't appear to be a repostate dict. (use workingdir_state <path> to create)"
}
package require overtype
#the revision branch and tags are highly relevant to the file state - and workingdir_state currently retrieves them anyway
# - so we'll include them in the defaults
# - when we are including working dir state as part of other output - we could be duplicating branch/tag retrievals
# - todo - flags to stop duplicating effort ??
set defaults [dict create\
-fields {ahead behind unchanged changed new missing extra}\
-fields {revision branch tags ahead behind unchanged changed new missing extra}\
]
set opts [dict merge $defaults $args]
# -- --- --- --- --- --- --- --- --- ---
@ -625,6 +679,8 @@ namespace eval punk::repo {
subpath subpath\
revision revision\
revision_iso8601 revision_iso8601\
branch branch\
tags tags\
ahead ahead\
behind behind\
repotype repotype\
@ -662,13 +718,15 @@ namespace eval punk::repo {
set result [string trimright $result \n]
return $result
}
#todo - describe purpose and possibly rename
proc workingdir_state_summary_dict {repostate} {
if {![dict exists $repostate repotype] || ![dict exists $repostate paths]} {
error "workingdir_state_summary_dict error repostate doesn't appear to be a repostate dict. (use workingdir_state <path> to create)"
}
set filestates [dict values [dict get $repostate paths]]
set path_count_fields [list unchanged changed new missing extra]
set state_fields [list ahead behind repodir subpath repotype revision revision_iso8601]
set state_fields [list ahead behind repodir subpath repotype revision revision_iso8601 branch tags]
set dresult [dict create]
if {[dict exists $repostate error]} {
foreach f $state_fields {
@ -1182,7 +1240,7 @@ namespace eval punk::repo {
#------------------------------------
#limit to exec so full punk shell not required in scripts
proc git_revision {{path {}}} {
proc git_revision {{path ""}} {
if {$path eq {}} { set path [pwd] }
# ::kettle::path::revision.git
do_in_path $path {
@ -1196,7 +1254,7 @@ namespace eval punk::repo {
}
return [string trim $v]
}
proc git_remote {{path {{}}}} {
proc git_remote {{path ""}} {
if {$path eq {}} { set path [pwd] }
do_in_path $path {
try {

2
src/modules/punk/basictelnet-999999.0a1.0.tm

@ -525,7 +525,7 @@ namespace eval punk::basictelnet {
# - review
#if we didn't make agreement that server would echo and we're in raw mode
if {![dict get $server_option_state 1] && $::punk::console::is_raw} {
if {![dict get $server_option_state 1] && [tsv::get console is_raw]} {
puts -nonewline stdout $chunk
}
# -- --- --- ---

39
src/modules/punk/console-999999.0a1.0.tm

@ -44,6 +44,7 @@
#[list_begin itemized]
package require Tcl 8.6-
package require Thread ;#tsv required to sync is_raw
package require punk::ansi
#*** !doctools
#[item] [package {Tcl 8.6-}]
@ -84,7 +85,12 @@ namespace eval punk::console {
variable previous_stty_state_stdin ""
variable previous_stty_state_stdout ""
variable previous_stty_state_stderr ""
variable is_raw 0
#variable is_raw 0
if {![tsv::exists console is_raw]} {
tsv::set console is_raw 0
}
variable input_chunks_waiting
if {![info exists input_chunks_waiting(stdin)]} {
set input_chunks_waiting(stdin) [list]
@ -183,7 +189,8 @@ namespace eval punk::console {
#NOTE - the is_raw is only being set in current interp - but the channel is shared.
#this is problematic with the repl thread being separate. - must be a tsv? REVIEW
proc enableRaw {{channel stdin}} {
variable is_raw
#variable is_raw
variable previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] eq ""} {
@ -193,21 +200,21 @@ namespace eval punk::console {
}
exec {*}$sttycmd raw -echo <@$channel
set is_raw 1
tsv::set console is_raw 1
return [dict create previous [set previous_stty_state_$channel]]
}
proc disableRaw {{channel stdin}} {
variable is_raw
#variable is_raw
variable previous_stty_state_$channel
set sttycmd [auto_execok stty]
if {[set previous_stty_state_$channel] ne ""} {
exec {*}$sttycmd [set previous_stty_state_$channel]
set previous_stty_state_$channel ""
set is_raw 0
tsv::set console is_raw 0
return restored
}
exec {*}$sttycmd -raw echo <@$channel
set is_raw 0
tsv::set console is_raw 0
return done
}
proc enableVirtualTerminal {{channels {input output}}} {
@ -249,11 +256,11 @@ namespace eval punk::console {
}
proc mode {{raw_or_line query}} {
variable is_raw
#variable is_raw
variable ansi_available
set raw_or_line [string tolower $raw_or_line]
if {$raw_or_line eq "query"} {
if {$is_raw} {
if {[tsv::get console is_raw]} {
return "raw"
} else {
return "line"
@ -493,7 +500,7 @@ namespace eval punk::console {
}
proc [namespace parent]::enableRaw {{channel stdin}} {
variable is_raw
#variable is_raw
variable previous_stty_state_$channel
if {[package provide twapi] ne ""} {
@ -506,7 +513,7 @@ namespace eval punk::console {
#set newmode [dict merge $oldmode [dict create -lineinput 0 -echoinput 0]]
set newmode [twapi::get_console_input_mode]
set is_raw 1
tsv::set console is_raw 1
#don't disable handler - it will detect is_raw
### twapi::set_console_control_handler {}
return [list stdin [list from $oldmode to $newmode]]
@ -516,7 +523,7 @@ namespace eval punk::console {
}
exec {*}$sttycmd raw -echo <@$channel
set is_raw 1
tsv::set console is_raw 1
#review - inconsistent return dict
return [dict create stdin [list from [set previous_stty_state_$channel] to "" note "fixme - to state not shown"]]
} else {
@ -528,7 +535,7 @@ namespace eval punk::console {
#could be we were missing a step in reopening stdin and console configuration?
proc [namespace parent]::disableRaw {{channel stdin}} {
variable is_raw
#variable is_raw
variable previous_stty_state_$channel
if {[package provide twapi] ne ""} {
@ -537,7 +544,7 @@ namespace eval punk::console {
# Turn on the echo and line-editing bits
twapi::modify_console_input_mode $console_handle -lineinput 1 -echoinput 1
set newmode [twapi::get_console_input_mode]
set is_raw 0
tsv::set console is_raw 0
return [list stdin [list from $oldmode to $newmode]]
} elseif {[set sttycmd [auto_execok stty]] ne ""} {
#stty can return info on windows - but doesn't seem to be able to set anything.
@ -550,7 +557,7 @@ namespace eval punk::console {
return restored
}
exec {*}$sttycmd -raw echo <@$channel
set is_raw 0
tsv::set console is_raw 0
#do we really want to exec stty yet again to show final 'to' state?
#probably not. We should work out how to read the stty result flags and set a result.. or just limit from,to to showing echo and lineedit states.
return [list stdin [list from "[set previous_stty_state_$channel]" to "" note "fixme - to state not shown"]]
@ -634,7 +641,7 @@ namespace eval punk::console {
puts -nonewline $output $query;flush $output
#todo - test and save rawstate so we don't disableRaw if console was already raw
if {!$::punk::console::is_raw} {
if {![tsv::get console is_raw]} {
set was_raw 0
punk::console::enableRaw
} else {
@ -1378,7 +1385,7 @@ namespace eval punk::console {
#todo - compare speed with get_cursor_pos - work out why the big difference
proc test_cursor_pos {} {
if {!$::punk::console::is_raw} {
if {![tsv::get console is_raw]} {
set was_raw 0
enableRaw
} else {

2
src/modules/punk/lib-999999.0a1.0.tm

@ -2387,7 +2387,7 @@ namespace eval punk::lib {
set stdin_state [fconfigure stdin]
if {[catch {
package require punk::console
set console_raw [set ::punk::console::is_raw]
set console_raw [tsv::get console is_raw]
} err_console]} {
#assume normal line mode
set console_raw 0

18
src/modules/punk/repl-0.1.tm

@ -73,6 +73,7 @@ namespace eval repl {
#variable last_unknown ""
tsv::set repl last_unknown ""
tsv::set console is_raw 0
variable output ""
#important not to initialize - as it can be preset by cooperating package before app-punk has been package required
#(this is an example of a deaddrop)
@ -149,7 +150,7 @@ proc ::punk::repl::init_signal_handlers {} {
flush stderr
incr signal_control_c
#rputs stderr "* console_control: $args"
if {$::punk::console::is_raw} {
if {[tsv::get console is_raw]} {
if {[lindex $::errorCode 0] eq "CHILDKILLED"} {
#rputs stderr "\n|repl> ctrl-c errorCode: $::errorCode"
#avoid spurious triggers after interrupting a command..
@ -615,7 +616,8 @@ proc repl::doprompt {prompt {col {green bold}}} {
flush stdout; #we are writing this prompt on stderr, but stdout could still be writing to screen
#our first char on stderr is based on the 'lastchar' of stdout which we have recorded but may not have arrived on screen.
#The issue we're trying to avoid is the (stderr)prompt arriving midway through a large stdout chunk
#REVIEW - this basic attempt to get stderr/stdout to cooperate is experimental and unlikely to achieve the desired effect
#REVIEW - this basic attempt to get stderr/stdout to cooperate is experimental and unlikely to achieve the desired effect in all situations
#It the above flush does seem to help though.
#note that our 'flush stdout' tcl call does not wait if stdout is non-blocking
#todo - investigate if the overhead is reasonable for a special channel that accepts stdout and stderr records with a reader to send to console in chunk-sizes we know will be emitted correctly
# - reader of such channel could be ok to be blocking (on read? on write to real channels?)... except everything still needs to be interruptable by things like signals?
@ -1296,9 +1298,11 @@ proc repl::repl_handler {inputchan prompt_config} {
if {[dict get $original_input_conf -inputmode] eq "raw"} {
#user or script has apparently put stdin into raw mode - update punk::console::is_raw to match
set rawmode 1
set ::punk::console::is_raw 1
#set ::punk::console::is_raw 1
tsv::set console is_raw 1
} else {
set ::punk::console::is_raw 0
#set ::punk::console::is_raw 0
tsv::set console is_raw 0
}
#what about enable/disable virtualTerminal ?
#using stdin -inputmode to switch modes won't set virtualterminal input state appropriately
@ -1308,7 +1312,8 @@ proc repl::repl_handler {inputchan prompt_config} {
} else {
#JMN FIX!
#this returns 0 in rawmode on 8.6 after repl thread changes
set rawmode [set ::punk::console::is_raw]
#set rawmode [set ::punk::console::is_raw]
set rawmode [tsv::get console is_raw]
}
if {!$rawmode} {
@ -1672,7 +1677,8 @@ proc repl::repl_process_data {inputchan chunktype chunk stdinlines prompt_config
set debugprompt [dict get $prompt_config debugprompt]
set rawmode [set ::punk::console::is_raw]
#set rawmode [set ::punk::console::is_raw]
set rawmode [tsv::get console is_raw]
if {!$rawmode} {
#puts stderr "-->got [ansistring VIEW -lf 1 $stdinlines]<--"

1
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/mix/commandset/repo-0.1.0.tm

@ -25,6 +25,7 @@
namespace eval punk::mix::commandset::repo {
namespace export *
proc tickets {{project ""}} {
#todo
set result ""
if {[string length $project]} {
puts stderr "project status unimplemented"

72
src/project_layouts/custom/_project/punk.project-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm

@ -346,6 +346,11 @@ namespace eval punk::repo {
#does a dual git/fossil repo make sense if both are committing??
# see: https://fossil-scm.org/home/doc/trunk/www/inout.wiki for bidirectional sync info
proc workingdir_state {{abspath {}} args} {
#we should try to minimize executable calls
#an extra git/fossil executable call required for tags
#git seems to require more executable calls
set defaults [list\
-repotypes [list fossil git]\
-repopaths ""\
@ -408,6 +413,8 @@ namespace eval punk::repo {
set revision ""
set revision_iso8601 ""
set pathdict [dict create]
set branch ""
set tags ""
if {![llength $repotypes_to_query]} {
error "No tracking information available for project at $repodir with the chosen repotypes '$opt_repotypes'. Ensure project workingdir is a fossil (or git) checkout"
@ -437,6 +444,38 @@ namespace eval punk::repo {
}
set revision_iso8601 "${revision_ymd}T${revision_hms}${revision_tz}"
#REVIEW! what are the semantic difference between tags in fossil v git?
#fossil has tagtypes such as propagated and singleton(onetime)
#if we get all tag info for the revision - we can get the current branch (branch=somename tag) at the same time
#by retrieving with --raw - we have to process some prefixes such as sym- but probably best not done here
#we will return all tags that apply to the current revision and let the caller decide the meanings
if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$fossil_cmd tag ls --raw $revision]} cmdresult]} {
set branchinfo [lindex [grep {branch=*} $cmdresult] 0] ;#first line match - should only be one
set branch [lindex [split $branchinfo =] 1]
set tags [list]
foreach ln [split $cmdresult \n] {
if {[string trim $ln] eq ""} {
continue
}
lappend tags [string trim $ln]
}
}
#set tags_info [lindex [grep {tags:*} $fossilstate 0] ;#first line match - should only be one
#we get lines like:
#tags: trunk, main
#tags: trunk
#set rawtags [lrange $tags_info 1 end] ;#REVIEW
#set tags [list]
#foreach t $rawtags {
# lappend tags [string trimright $t ,]
#}
#if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$fossil_cmd branch current]} cmdresult]} {
# set branch $cmdresult ;#command result doesn't include newline etc
#}
dict set resultdict ahead ""
dict set resultdict behind ""
@ -490,6 +529,7 @@ namespace eval punk::repo {
set git_cmd [auto_execok git]
# -uno = suppress ? lines.
# -b = show ranch and tracking info
#our basic parsing/grepping assumes --porcelain=2
if {[catch {punk::mix::util::do_in_path $repodir [list exec {*}$git_cmd status --porcelain=2 -b -- $abspath]} gitstate]} {
error "workingdir_state error: Unable to retrieve workingdir state using git. Errormsg: $gitstate"
}
@ -499,6 +539,13 @@ namespace eval punk::repo {
puts stderr "workingdir_state: git revision is (initial) - no file state to gather"
break
}
# line: # branch.head somebranchname
set branch [lindex [grep {# branch.head *} $gitstate] 0 2]
if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$git_cmd describe --exact-match --tags]} cmdresult]} {
set tags $cmdresult ;#review - we have short tags vs longer.. e.g v0.1a vs v0.1a-184-g856fab4 - which is returned? Also how are multiple separated?
}
#often there will be no tag - so the common case is actually an error "fatal: not ag exactly matchs 'xxxx...'"
# -- --- --- --- ---
#could use %ci for ISO8601 data - see git-show manpage, but this will be in timezone of developer's machine - we need it in UTC for comparison to fossil outputs and other devs
@ -600,9 +647,11 @@ namespace eval punk::repo {
puts stderr "workingdir_state - repotype $rt not supported"
}
}
dict set resultdict revision $revision
dict set resultdict revision_iso8601 $revision_iso8601
dict set resultdict paths $pathdict
dict set resultdict branch $branch
dict set resultdict tags $tags
dict set resultdict revision $revision
dict set resultdict revision_iso8601 $revision_iso8601
dict set resultdict paths $pathdict
return $resultdict
}
proc workingdir_state_summary {repostate args} {
@ -610,8 +659,13 @@ namespace eval punk::repo {
error "workingdir_state_summary error repostate doesn't appear to be a repostate dict. (use workingdir_state <path> to create)"
}
package require overtype
#the revision branch and tags are highly relevant to the file state - and workingdir_state currently retrieves them anyway
# - so we'll include them in the defaults
# - when we are including working dir state as part of other output - we could be duplicating branch/tag retrievals
# - todo - flags to stop duplicating effort ??
set defaults [dict create\
-fields {ahead behind unchanged changed new missing extra}\
-fields {revision branch tags ahead behind unchanged changed new missing extra}\
]
set opts [dict merge $defaults $args]
# -- --- --- --- --- --- --- --- --- ---
@ -625,6 +679,8 @@ namespace eval punk::repo {
subpath subpath\
revision revision\
revision_iso8601 revision_iso8601\
branch branch\
tags tags\
ahead ahead\
behind behind\
repotype repotype\
@ -662,13 +718,15 @@ namespace eval punk::repo {
set result [string trimright $result \n]
return $result
}
#todo - describe purpose and possibly rename
proc workingdir_state_summary_dict {repostate} {
if {![dict exists $repostate repotype] || ![dict exists $repostate paths]} {
error "workingdir_state_summary_dict error repostate doesn't appear to be a repostate dict. (use workingdir_state <path> to create)"
}
set filestates [dict values [dict get $repostate paths]]
set path_count_fields [list unchanged changed new missing extra]
set state_fields [list ahead behind repodir subpath repotype revision revision_iso8601]
set state_fields [list ahead behind repodir subpath repotype revision revision_iso8601 branch tags]
set dresult [dict create]
if {[dict exists $repostate error]} {
foreach f $state_fields {
@ -1182,7 +1240,7 @@ namespace eval punk::repo {
#------------------------------------
#limit to exec so full punk shell not required in scripts
proc git_revision {{path {}}} {
proc git_revision {{path ""}} {
if {$path eq {}} { set path [pwd] }
# ::kettle::path::revision.git
do_in_path $path {
@ -1196,7 +1254,7 @@ namespace eval punk::repo {
}
return [string trim $v]
}
proc git_remote {{path {{}}}} {
proc git_remote {{path ""}} {
if {$path eq {}} { set path [pwd] }
do_in_path $path {
try {

1
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/mix/commandset/repo-0.1.0.tm

@ -25,6 +25,7 @@
namespace eval punk::mix::commandset::repo {
namespace export *
proc tickets {{project ""}} {
#todo
set result ""
if {[string length $project]} {
puts stderr "project status unimplemented"

72
src/project_layouts/custom/_project/punk.shell-0.1/src/bootsupport/modules/punk/repo-0.1.1.tm

@ -346,6 +346,11 @@ namespace eval punk::repo {
#does a dual git/fossil repo make sense if both are committing??
# see: https://fossil-scm.org/home/doc/trunk/www/inout.wiki for bidirectional sync info
proc workingdir_state {{abspath {}} args} {
#we should try to minimize executable calls
#an extra git/fossil executable call required for tags
#git seems to require more executable calls
set defaults [list\
-repotypes [list fossil git]\
-repopaths ""\
@ -408,6 +413,8 @@ namespace eval punk::repo {
set revision ""
set revision_iso8601 ""
set pathdict [dict create]
set branch ""
set tags ""
if {![llength $repotypes_to_query]} {
error "No tracking information available for project at $repodir with the chosen repotypes '$opt_repotypes'. Ensure project workingdir is a fossil (or git) checkout"
@ -437,6 +444,38 @@ namespace eval punk::repo {
}
set revision_iso8601 "${revision_ymd}T${revision_hms}${revision_tz}"
#REVIEW! what are the semantic difference between tags in fossil v git?
#fossil has tagtypes such as propagated and singleton(onetime)
#if we get all tag info for the revision - we can get the current branch (branch=somename tag) at the same time
#by retrieving with --raw - we have to process some prefixes such as sym- but probably best not done here
#we will return all tags that apply to the current revision and let the caller decide the meanings
if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$fossil_cmd tag ls --raw $revision]} cmdresult]} {
set branchinfo [lindex [grep {branch=*} $cmdresult] 0] ;#first line match - should only be one
set branch [lindex [split $branchinfo =] 1]
set tags [list]
foreach ln [split $cmdresult \n] {
if {[string trim $ln] eq ""} {
continue
}
lappend tags [string trim $ln]
}
}
#set tags_info [lindex [grep {tags:*} $fossilstate 0] ;#first line match - should only be one
#we get lines like:
#tags: trunk, main
#tags: trunk
#set rawtags [lrange $tags_info 1 end] ;#REVIEW
#set tags [list]
#foreach t $rawtags {
# lappend tags [string trimright $t ,]
#}
#if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$fossil_cmd branch current]} cmdresult]} {
# set branch $cmdresult ;#command result doesn't include newline etc
#}
dict set resultdict ahead ""
dict set resultdict behind ""
@ -490,6 +529,7 @@ namespace eval punk::repo {
set git_cmd [auto_execok git]
# -uno = suppress ? lines.
# -b = show ranch and tracking info
#our basic parsing/grepping assumes --porcelain=2
if {[catch {punk::mix::util::do_in_path $repodir [list exec {*}$git_cmd status --porcelain=2 -b -- $abspath]} gitstate]} {
error "workingdir_state error: Unable to retrieve workingdir state using git. Errormsg: $gitstate"
}
@ -499,6 +539,13 @@ namespace eval punk::repo {
puts stderr "workingdir_state: git revision is (initial) - no file state to gather"
break
}
# line: # branch.head somebranchname
set branch [lindex [grep {# branch.head *} $gitstate] 0 2]
if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$git_cmd describe --exact-match --tags]} cmdresult]} {
set tags $cmdresult ;#review - we have short tags vs longer.. e.g v0.1a vs v0.1a-184-g856fab4 - which is returned? Also how are multiple separated?
}
#often there will be no tag - so the common case is actually an error "fatal: not ag exactly matchs 'xxxx...'"
# -- --- --- --- ---
#could use %ci for ISO8601 data - see git-show manpage, but this will be in timezone of developer's machine - we need it in UTC for comparison to fossil outputs and other devs
@ -600,9 +647,11 @@ namespace eval punk::repo {
puts stderr "workingdir_state - repotype $rt not supported"
}
}
dict set resultdict revision $revision
dict set resultdict revision_iso8601 $revision_iso8601
dict set resultdict paths $pathdict
dict set resultdict branch $branch
dict set resultdict tags $tags
dict set resultdict revision $revision
dict set resultdict revision_iso8601 $revision_iso8601
dict set resultdict paths $pathdict
return $resultdict
}
proc workingdir_state_summary {repostate args} {
@ -610,8 +659,13 @@ namespace eval punk::repo {
error "workingdir_state_summary error repostate doesn't appear to be a repostate dict. (use workingdir_state <path> to create)"
}
package require overtype
#the revision branch and tags are highly relevant to the file state - and workingdir_state currently retrieves them anyway
# - so we'll include them in the defaults
# - when we are including working dir state as part of other output - we could be duplicating branch/tag retrievals
# - todo - flags to stop duplicating effort ??
set defaults [dict create\
-fields {ahead behind unchanged changed new missing extra}\
-fields {revision branch tags ahead behind unchanged changed new missing extra}\
]
set opts [dict merge $defaults $args]
# -- --- --- --- --- --- --- --- --- ---
@ -625,6 +679,8 @@ namespace eval punk::repo {
subpath subpath\
revision revision\
revision_iso8601 revision_iso8601\
branch branch\
tags tags\
ahead ahead\
behind behind\
repotype repotype\
@ -662,13 +718,15 @@ namespace eval punk::repo {
set result [string trimright $result \n]
return $result
}
#todo - describe purpose and possibly rename
proc workingdir_state_summary_dict {repostate} {
if {![dict exists $repostate repotype] || ![dict exists $repostate paths]} {
error "workingdir_state_summary_dict error repostate doesn't appear to be a repostate dict. (use workingdir_state <path> to create)"
}
set filestates [dict values [dict get $repostate paths]]
set path_count_fields [list unchanged changed new missing extra]
set state_fields [list ahead behind repodir subpath repotype revision revision_iso8601]
set state_fields [list ahead behind repodir subpath repotype revision revision_iso8601 branch tags]
set dresult [dict create]
if {[dict exists $repostate error]} {
foreach f $state_fields {
@ -1182,7 +1240,7 @@ namespace eval punk::repo {
#------------------------------------
#limit to exec so full punk shell not required in scripts
proc git_revision {{path {}}} {
proc git_revision {{path ""}} {
if {$path eq {}} { set path [pwd] }
# ::kettle::path::revision.git
do_in_path $path {
@ -1196,7 +1254,7 @@ namespace eval punk::repo {
}
return [string trim $v]
}
proc git_remote {{path {{}}}} {
proc git_remote {{path ""}} {
if {$path eq {}} { set path [pwd] }
do_in_path $path {
try {

1
src/vfs/_vfscommon/modules/punk/mix/commandset/repo-0.1.0.tm

@ -25,6 +25,7 @@
namespace eval punk::mix::commandset::repo {
namespace export *
proc tickets {{project ""}} {
#todo
set result ""
if {[string length $project]} {
puts stderr "project status unimplemented"

55
src/vfs/_vfscommon/modules/punk/repl-0.1.tm

@ -609,9 +609,19 @@ proc repl::newout2 {} {
proc repl::doprompt {prompt {col {green bold}}} {
#prompt to stderr.
#We can pipe commands into repl's stdin without the prompt interfering with the output.
#Although all command output for each line goes to stdout - not just what is emmited with puts
#Although all command output for each line goes to stdout - not just what is emitted with puts
if {$::tcl_interactive} {
flush stdout; #we are writing this prompt on stderr, but stdout could still be writing to screen
#our first char on stderr is based on the 'lastchar' of stdout which we have recorded but may not have arrived on screen.
#The issue we're trying to avoid is the (stderr)prompt arriving midway through a large stdout chunk
#REVIEW - this basic attempt to get stderr/stdout to cooperate is experimental and unlikely to achieve the desired effect
#note that our 'flush stdout' tcl call does not wait if stdout is non-blocking
#todo - investigate if the overhead is reasonable for a special channel that accepts stdout and stderr records with a reader to send to console in chunk-sizes we know will be emitted correctly
# - reader of such channel could be ok to be blocking (on read? on write to real channels?)... except everything still needs to be interruptable by things like signals?
#? - we want ordinary puts to stderr to be prioritized? to arrive on-screen - just not at arbitrary locations within stdout, and still must be correctly ordered wrt all other stderr
# - in our repl and code threads we don't want to put stderr/stdout writes in blocking mode and have code waiting on it
set last_char_info [screen_last_char_getinfo]
if {![llength $last_char_info]} {
set needs_clearance 1
@ -1364,24 +1374,53 @@ proc repl::repl_handler {inputchan prompt_config} {
lassign [dict get $outconf -winsize] cols rows
} else {
#fallback - try external executable. Which is a bit ugly
#tput can work on windows too if it's installed e.g from msys2
#tput can't seem to get dimensions (on FreeBSD at least) when not run interactively - ie via exec. (always returns 80x24 no matter if run with <@stdin)
#bizarrely - tput can work with exec on windows if it's installed e.g from msys2
#but can be *slow* compared to unix e.g 400ms+ vs <2ms on FreeBSD !
set tputcmd [auto_execok tput]
if {$tputcmd ne ""} {
if {![catch {exec {*}$tputcmd cols lines} values} {
lassign $values cols rows
}
#stty -a is 400ms+ vs 500us+ on FreeBSD
if {"windows" eq $::tcl_platform(platform)} {
set tputcmd [auto_execok tput]
if {$tputcmd ne ""} {
if {![catch {exec {*}$tputcmd cols lines} values]} {
lassign $values cols rows
}
}
}
if {![string is integer -strict $cols] || ![string is integer -strict $rows]} {
#same for all platforms? tested on windows, wsl, FreeBSD
#exec stty -a gives a result on the first line like:
#speed xxxx baud; rows rr; columns cc;
#review - more robust parsing - do we know it's first line?
set sttycmd [auto_execok stty]
if {$sttycmd ne ""} {
#the more parseable: stty -g doesn't give rows/columns
if {![catch {exec {*}$sttycmd -a} result]} {
lassign [split $result \n] firstline
set lineparts [split $firstline {;}] ;#we seem to get segments that look well behaved enough to be treated as tcl lists - review - regex?
set rowinfo [lsearch -index end -inline $lineparts rows]
if {[llength $rowinfo] == 2} {
set rows [lindex $rowinfo 0]
}
set colinfo [lsearch -index end -inline $lineparts columns]
if {[llength $colinfo] == 2} {
set cols [lindex $colinfo 0]
}
}
}
}
}
if {[string is integer -strict $cols] && [string is integer -strict $rows]} {
#got_dimensions - todo - try spinner?
#puts -nonewline stdout [punk::ansi::move $rows 4]$msg
#use cursorsave_ version which avoids get_cursor_pos_list call
set msglen [ansistring length $msg]
punk::console::cursorsave_move_emitblock_return $rows [expr {$cols - $msglen -1}] $msg
} else {
#no mechanism to get console dimensions
#we are reduced to continuously spewing lines.
set msglen [ansistring length $msg]
puts stderr $msg
}

72
src/vfs/_vfscommon/modules/punk/repo-0.1.1.tm

@ -346,6 +346,11 @@ namespace eval punk::repo {
#does a dual git/fossil repo make sense if both are committing??
# see: https://fossil-scm.org/home/doc/trunk/www/inout.wiki for bidirectional sync info
proc workingdir_state {{abspath {}} args} {
#we should try to minimize executable calls
#an extra git/fossil executable call required for tags
#git seems to require more executable calls
set defaults [list\
-repotypes [list fossil git]\
-repopaths ""\
@ -408,6 +413,8 @@ namespace eval punk::repo {
set revision ""
set revision_iso8601 ""
set pathdict [dict create]
set branch ""
set tags ""
if {![llength $repotypes_to_query]} {
error "No tracking information available for project at $repodir with the chosen repotypes '$opt_repotypes'. Ensure project workingdir is a fossil (or git) checkout"
@ -437,6 +444,38 @@ namespace eval punk::repo {
}
set revision_iso8601 "${revision_ymd}T${revision_hms}${revision_tz}"
#REVIEW! what are the semantic difference between tags in fossil v git?
#fossil has tagtypes such as propagated and singleton(onetime)
#if we get all tag info for the revision - we can get the current branch (branch=somename tag) at the same time
#by retrieving with --raw - we have to process some prefixes such as sym- but probably best not done here
#we will return all tags that apply to the current revision and let the caller decide the meanings
if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$fossil_cmd tag ls --raw $revision]} cmdresult]} {
set branchinfo [lindex [grep {branch=*} $cmdresult] 0] ;#first line match - should only be one
set branch [lindex [split $branchinfo =] 1]
set tags [list]
foreach ln [split $cmdresult \n] {
if {[string trim $ln] eq ""} {
continue
}
lappend tags [string trim $ln]
}
}
#set tags_info [lindex [grep {tags:*} $fossilstate 0] ;#first line match - should only be one
#we get lines like:
#tags: trunk, main
#tags: trunk
#set rawtags [lrange $tags_info 1 end] ;#REVIEW
#set tags [list]
#foreach t $rawtags {
# lappend tags [string trimright $t ,]
#}
#if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$fossil_cmd branch current]} cmdresult]} {
# set branch $cmdresult ;#command result doesn't include newline etc
#}
dict set resultdict ahead ""
dict set resultdict behind ""
@ -490,6 +529,7 @@ namespace eval punk::repo {
set git_cmd [auto_execok git]
# -uno = suppress ? lines.
# -b = show ranch and tracking info
#our basic parsing/grepping assumes --porcelain=2
if {[catch {punk::mix::util::do_in_path $repodir [list exec {*}$git_cmd status --porcelain=2 -b -- $abspath]} gitstate]} {
error "workingdir_state error: Unable to retrieve workingdir state using git. Errormsg: $gitstate"
}
@ -499,6 +539,13 @@ namespace eval punk::repo {
puts stderr "workingdir_state: git revision is (initial) - no file state to gather"
break
}
# line: # branch.head somebranchname
set branch [lindex [grep {# branch.head *} $gitstate] 0 2]
if {![catch {punk::mix::util::do_in_path $repodir [list exec {*}$git_cmd describe --exact-match --tags]} cmdresult]} {
set tags $cmdresult ;#review - we have short tags vs longer.. e.g v0.1a vs v0.1a-184-g856fab4 - which is returned? Also how are multiple separated?
}
#often there will be no tag - so the common case is actually an error "fatal: not ag exactly matchs 'xxxx...'"
# -- --- --- --- ---
#could use %ci for ISO8601 data - see git-show manpage, but this will be in timezone of developer's machine - we need it in UTC for comparison to fossil outputs and other devs
@ -600,9 +647,11 @@ namespace eval punk::repo {
puts stderr "workingdir_state - repotype $rt not supported"
}
}
dict set resultdict revision $revision
dict set resultdict revision_iso8601 $revision_iso8601
dict set resultdict paths $pathdict
dict set resultdict branch $branch
dict set resultdict tags $tags
dict set resultdict revision $revision
dict set resultdict revision_iso8601 $revision_iso8601
dict set resultdict paths $pathdict
return $resultdict
}
proc workingdir_state_summary {repostate args} {
@ -610,8 +659,13 @@ namespace eval punk::repo {
error "workingdir_state_summary error repostate doesn't appear to be a repostate dict. (use workingdir_state <path> to create)"
}
package require overtype
#the revision branch and tags are highly relevant to the file state - and workingdir_state currently retrieves them anyway
# - so we'll include them in the defaults
# - when we are including working dir state as part of other output - we could be duplicating branch/tag retrievals
# - todo - flags to stop duplicating effort ??
set defaults [dict create\
-fields {ahead behind unchanged changed new missing extra}\
-fields {revision branch tags ahead behind unchanged changed new missing extra}\
]
set opts [dict merge $defaults $args]
# -- --- --- --- --- --- --- --- --- ---
@ -625,6 +679,8 @@ namespace eval punk::repo {
subpath subpath\
revision revision\
revision_iso8601 revision_iso8601\
branch branch\
tags tags\
ahead ahead\
behind behind\
repotype repotype\
@ -662,13 +718,15 @@ namespace eval punk::repo {
set result [string trimright $result \n]
return $result
}
#todo - describe purpose and possibly rename
proc workingdir_state_summary_dict {repostate} {
if {![dict exists $repostate repotype] || ![dict exists $repostate paths]} {
error "workingdir_state_summary_dict error repostate doesn't appear to be a repostate dict. (use workingdir_state <path> to create)"
}
set filestates [dict values [dict get $repostate paths]]
set path_count_fields [list unchanged changed new missing extra]
set state_fields [list ahead behind repodir subpath repotype revision revision_iso8601]
set state_fields [list ahead behind repodir subpath repotype revision revision_iso8601 branch tags]
set dresult [dict create]
if {[dict exists $repostate error]} {
foreach f $state_fields {
@ -1182,7 +1240,7 @@ namespace eval punk::repo {
#------------------------------------
#limit to exec so full punk shell not required in scripts
proc git_revision {{path {}}} {
proc git_revision {{path ""}} {
if {$path eq {}} { set path [pwd] }
# ::kettle::path::revision.git
do_in_path $path {
@ -1196,7 +1254,7 @@ namespace eval punk::repo {
}
return [string trim $v]
}
proc git_remote {{path {{}}}} {
proc git_remote {{path ""}} {
if {$path eq {}} { set path [pwd] }
do_in_path $path {
try {

Loading…
Cancel
Save