diff --git a/src/modules/punk-0.1.tm b/src/modules/punk-0.1.tm index 3d727e30..08fabe76 100644 --- a/src/modules/punk-0.1.tm +++ b/src/modules/punk-0.1.tm @@ -71,6 +71,7 @@ namespace eval ::repl { } package require punk::config package require punk::winpath ;# for windows paths - but has functions that can be called on unix systems +package require punk::repo namespace eval punk { interp alias {} purelist {} lreplace x 0 0 ;#required by pipe system @@ -6802,6 +6803,82 @@ namespace eval punk { interp alias {} tmhere {} .= pwd |path> {::tcl::tm::add {*}$data; set path} |> inspect -label added_to_module_path <0/#| + proc norm {path} { + #kettle::path::norm + #see also wiki + #full path normalization + return [file dirname [file normalize $path/__]] + } + + proc path_strip_prefix {path prefix} { + return [file join \ + {*}[lrange \ + [file split [norm $path]] \ + [llength [file split [norm $prefix]]] \ + end]] + } + + proc path_relative {base dst} { + # Modified copy of ::fileutil::relative (tcllib) + # Adapted to 8.5 ({*}). + # + # Taking two _directory_ paths, a base and a destination, computes the path + # of the destination relative to the base. + # + # Arguments: + # base The path to make the destination relative to. + # dst The destination path + # + # Results: + # The path of the destination, relative to the base. + + # Ensure that the link to directory 'dst' is properly done relative to + # the directory 'base'. + + if {[file pathtype $base] ne [file pathtype $dst]} { + return -code error "Unable to compute relation for paths of different pathtypes: [file pathtype $base] vs. [file pathtype $dst], ($base vs. $dst)" + } + + set base [norm $base] + set dst [norm $dst] + + set save $dst + set base [file split $base] + set dst [file split $dst] + + while {[lindex $dst 0] eq [lindex $base 0]} { + set dst [lrange $dst 1 end] + set base [lrange $base 1 end] + if {![llength $dst]} {break} + } + + set dstlen [llength $dst] + set baselen [llength $base] + + if {($dstlen == 0) && ($baselen == 0)} { + # Cases: + # (a) base == dst + + set dst . + } else { + # Cases: + # (b) base is: base/sub = sub + # dst is: base = {} + + # (c) base is: base = {} + # dst is: base/sub = sub + + while {$baselen > 0} { + set dst [linsert $dst 0 ..] + incr baselen -1 + } + set dst [file join {*}$dst] + } + + return $dst + } + + proc fcat {args} { if {$::tcl_platform(platform) ne "windows"} { @@ -7086,11 +7163,6 @@ namespace eval punk { - #git - interp alias {} gs {} git status -sb - interp alias {} gl {} git log --oneline --decorate ;#decorate so stdout consistent with what we see on console - interp alias {} glast {} git log -1 HEAD --stat - interp alias {} gconf {} git config --global -l #---------------------------------------------- interp alias {} varinfo {} punk::varinfo diff --git a/src/modules/punk/repo-999999.0a1.0.tm b/src/modules/punk/repo-999999.0a1.0.tm new file mode 100644 index 00000000..885374a2 --- /dev/null +++ b/src/modules/punk/repo-999999.0a1.0.tm @@ -0,0 +1,160 @@ +# -*- tcl -*- +# Maintenance Instruction: leave the 999999.xxx.x as is and use 'pmix make' or src/make.tcl to update from -buildversion.txt +# +# Please consider using a BSD or MIT style license for greatest compatibility with the Tcl ecosystem. +# Code using preferred Tcl licenses can be eligible for inclusion in Tcllib, Tklib and the punk package repository. +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +#Copyright (c) 2023 Julian Noble +#Copyright (c) 2012-2018 Andreas Kupries +# - code from A.K's 'kettle' project used in this module +# +# @@ Meta Begin +# Application punk::repo 999999.0a1.0 +# Meta platform tcl +# Meta license BSD +# @@ Meta End + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Requirements +##e.g package require frobz + + + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +namespace eval punk::repo { + + proc is_fossil {{path {}}} { + if {$path eq {}} { set path [pwd] } + return [expr {[find_fossil $path] ne {}}] + } + proc is_git {{path {}}} { + if {$path eq {}} { set path [pwd] } + return [expr {[find_git $path] ne {}}] + } + + proc find_fossil {{path {}}} { + if {$path eq {}} { set path [pwd] } + scanup $path is_fossil_root + } + proc find_git {{path {}}} { + if {$path eq {}} { set path [pwd] } + scanup $path is_git_root + } + + proc is_fossil_root {{path {}}} { + if {$path eq {}} { set path [pwd] } + #from kettle::path::is.fossil + foreach control { + _FOSSIL_ + .fslckout + .fos + } { + set control $path/$control + if {[file exists $control] && [file isfile $control]} {return 1} + } + return 0 + } + proc is_git_root {{path {}}} { + if {$path eq {}} { set path [pwd] } + set control $path/.git + expr {[file exists $control] && [file isdirectory $control]} + } + + proc git_revision {{path {}}} { + if {$path eq {}} { set path [pwd] } + # ::kettle::path::revision.git + do_in_path $path { + try { + set v [::exec {*}[auto_execok git] describe] + } on error {e o} { + set v [lindex [split [dict get $o -errorinfo] \n] 0] + } + } + return [string trim $v] + } + + proc fossil_revision {{path {}}} { + if {$path eq {}} { set path [pwd] } + # ::kettle::path::revision.fossil + set fossilcmd [auto_execok fossil] + if {[llength $fossilcmd]} { + do_in_path $path { + set info [::exec {*}$fossilcmd info] + } + return [lindex [grep {checkout:*} $info] 0 1] + } else { + return Unknown + } + } + + #temporarily cd to workpath to run script - return to correct path even on failure + proc do_in_path {path script} { + #from ::kettle::path::in + set here [pwd] + try { + cd $path + uplevel 1 $script + } finally { + cd $here + } + } + proc scanup {path cmd} { + if {$path eq {}} { set path [pwd] } + #based on kettle::path::scanup + set path [file normalize $path] + while {1} { + # Found the proper directory, per the predicate. + if {[{*}$cmd $path]} { return $path } + + # Not found, walk to parent + set new [file dirname $path] + + # Stop when reaching the root. + if {$new eq $path} { return {} } + if {$new eq {}} { return {} } + + # Ok, truly walk up. + set path $new + } + return {} + } + + proc grep {pattern data} { + set data [string map [list \r\n \n] $data] + return [lsearch -all -inline -glob [split $data \n] $pattern] + } + + proc rgrep {pattern data} { + set data [string map [list \r\n \n] $data] + return [lsearch -all -inline -regexp [split $data \n] $pattern] + } + + interp alias {} is_fossil {} ::punk::repo::is_fossil + interp alias {} is_fossil_root {} ::punk::repo::is_fossil_root + interp alias {} find_fossil {} ::punk::repo::find_fossil + interp alias {} fossil_revision {} ::punk::repo::fossil_revision + interp alias {} is_git {} ::punk::repo::is_git + interp alias {} is_git_root {} ::punk::repo::is_git_root + interp alias {} find_git {} ::punk::repo::find_git + interp alias {} git_revision {} ::punk::repo::git_revision + + + interp alias {} gs {} git status -sb + interp alias {} gr {} ::punk::repo::git_revision + interp alias {} gl {} git log --oneline --decorate ;#decorate so stdout consistent with what we see on console + interp alias {} glast {} git log -1 HEAD --stat + interp alias {} gconf {} git config --global -l + +} + + +# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +## Ready +package provide punk::repo [namespace eval punk::repo { + variable version + set version 999999.0a1.0 +}] +return diff --git a/src/modules/punk/repo-buildversion.txt b/src/modules/punk/repo-buildversion.txt new file mode 100644 index 00000000..f47d01c8 --- /dev/null +++ b/src/modules/punk/repo-buildversion.txt @@ -0,0 +1,3 @@ +0.1.0 +#First line must be a semantic version number +#all other lines are ignored.