Add punk::repo module

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 

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 <pkg>-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

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.