You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
267 lines
11 KiB
267 lines
11 KiB
# -*- tcl -*- |
|
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'pmix make' or bin/punkmake to update from <pkg>-buildversion.txt |
|
# module template: shellspy/src/decktemplates/vendor/punk/modules/template_module-0.0.3.tm |
|
# |
|
# 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. |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# (C) 2024 |
|
# |
|
# @@ Meta Begin |
|
# Application punk::packagepreference 0.1.0 |
|
# Meta platform tcl |
|
# Meta license <unspecified> |
|
# @@ Meta End |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# doctools header |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
#*** !doctools |
|
#[manpage_begin shellspy_module_punk::packagepreference 0 0.1.0] |
|
#[copyright "2024"] |
|
#[titledesc {Module API}] [comment {-- Name section and table of contents description --}] |
|
#[moddesc {-}] [comment {-- Description at end of page heading --}] |
|
#[require punk::packagepreference] |
|
#[keywords module] |
|
#[description] |
|
#[para] - |
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
#*** !doctools |
|
#[section Overview] |
|
#[para] overview of punk::packagepreference |
|
#[subsection Concepts] |
|
#[para] - |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Requirements |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
#*** !doctools |
|
#[subsection dependencies] |
|
#[para] packages used by punk::packagepreference |
|
#[list_begin itemized] |
|
|
|
package require Tcl 8.6- |
|
package require commandstack |
|
#*** !doctools |
|
#[item] [package {Tcl 8.6}] |
|
#[item] [package {commandstack}] |
|
|
|
# #package require frobz |
|
# #*** !doctools |
|
# #[item] [package {frobz}] |
|
|
|
#*** !doctools |
|
#[list_end] |
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
#*** !doctools |
|
#[section API] |
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# oo::class namespace |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
#tcl::namespace::eval punk::packagepreference::class { |
|
#*** !doctools |
|
#[subsection {Namespace punk::packagepreference::class}] |
|
#[para] class definitions |
|
#if {[tcl::info::commands [tcl::namespace::current]::interface_sample1] eq ""} { |
|
#*** !doctools |
|
#[list_begin enumerated] |
|
|
|
# oo::class create interface_sample1 { |
|
# #*** !doctools |
|
# #[enum] CLASS [class interface_sample1] |
|
# #[list_begin definitions] |
|
|
|
# method test {arg1} { |
|
# #*** !doctools |
|
# #[call class::interface_sample1 [method test] [arg arg1]] |
|
# #[para] test method |
|
# puts "test: $arg1" |
|
# } |
|
|
|
# #*** !doctools |
|
# #[list_end] [comment {-- end definitions interface_sample1}] |
|
# } |
|
|
|
#*** !doctools |
|
#[list_end] [comment {--- end class enumeration ---}] |
|
#} |
|
#} |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# Base namespace |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
tcl::namespace::eval punk::packagepreference { |
|
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
|
#variable xyz |
|
|
|
#*** !doctools |
|
#[subsection {Namespace punk::packagepreference}] |
|
#[para] Core API functions for punk::packagepreference |
|
#[list_begin definitions] |
|
|
|
proc uninstall {} { |
|
#*** !doctools |
|
#[call [fun uninstall]] |
|
#[para]Return to the previous ::package implementation (This will be the builtin if no other override was present when install was called) |
|
|
|
commandstack::remove_rename {::package punk::packagepreference} |
|
} |
|
proc install {} { |
|
#*** !doctools |
|
#[call [fun install]] |
|
#[para]Override ::package builtin (or the current implementation if it has already been renamed/overridden) to check for and prefer lowercase packages/modules |
|
#[para]The overriding package command will call whatever implementation was in place before install to do the actual work - once it has modified 'package require' names to lowercase. |
|
#[para]This is intended to be in alignment with tip 590 "Recommend lowercase Package Names" |
|
#[para] https://core.tcl-lang.org/tips/doc/trunk/tip/590.md |
|
#[para]It prevents some loading errors when multiple package versions are available to an interpreter and the latest version is only provided by a lowercased module (.tm file) |
|
#[para]A package provided by the standard pkgIndex.tcl mechanism might override a later-versioned package because it may support both upper and lowercased names. |
|
#[para]The overriding of ::package only looks at 'package require' calls and preferentially tries the lowercase version (if the package isn't already loaded with either upper or lowercase name) |
|
#[para]This comes at some slight cost for packages that are only available with uppercase letters in the name - but at minimal cost for recommended lowercase package names |
|
#[para]Return to the standard ::package builtin by calling punk::packagepreference::uninstall |
|
|
|
#todo - review/update commandstack package |
|
#modern module/lib names should preferably be lower case |
|
#see tip 590 - "Recommend lowercase Package names". Where non-lowercase are deprecated (but not removed even in Tcl9) |
|
#Mixed case causes problems esp on windows where we can't have Package.tm and package.tm as they aren't distinguishable. |
|
#We enforce package to try lowercase first - at some potentially significant speed penalty if the lib actually does use uppercase |
|
#(also just overloading the package builtin comes at a cost!) |
|
#Without the lowercase-first mechanism - a lower versioned package such as Tablelist provided by a pkgIndex.tcl may be loaded in precedence to a higher versioned tablelist provided by a .tm |
|
#As punk kits launched with dev first arg may use tcl::tm::paths coming from both the system and zipkits for example - this is a problem. |
|
#(or in any environment where multiple versions of Tcl libraries may be available) |
|
#We can't provide a modernised .tm package for an old package that is commonly used with uppercase letters, in both the old form and lowercased form from a single .tm file. |
|
#It could be done by providing a redirecting .tm in a separate module path, or by providing a packageIndex.tcl to redirect it but both these solutions are error prone from a sysops perspective. |
|
set stackrecord [commandstack::rename_command -renamer punk::packagepreference package {args} { |
|
#::package override installed by punk::packagepreference::install |
|
#return to previous 'package' implementation with: punk::packagepreference::uninstall |
|
|
|
#uglier but faster than tcl::prefix::match in this instance |
|
#maintenance - check no prefixes of require are added to builtin package command |
|
switch -exact -- [lindex $args 0] { |
|
r - re - req - requi - requir - require { |
|
#puts "==>package $args" |
|
#puts "==>[info level 1]" |
|
#despite preference for lowercase - we need to handle packages that insist on providing as uppercase |
|
#(e.g we will still need to handle things like: package provide Tcl 8.6) |
|
#Where the package is already provided uppercase we shouldn't waste time deferring to lowercase |
|
if {[lindex $args 1] eq "-exact"} { |
|
set pkg [lindex $args 2] |
|
set vwant [lindex $args 3] |
|
if {[set ver [package provide $pkg]] ne ""} { |
|
if {$ver eq $vwant} { |
|
return $vwant |
|
} else { |
|
#package already provided with a different version.. we will defer to underlying implementation to return the standard error |
|
return [$COMMANDSTACKNEXT {*}$args] |
|
} |
|
} |
|
} else { |
|
set pkg [lindex $args 1] |
|
if {[set ver [package provide $pkg]] ne ""} { |
|
return $ver |
|
} |
|
} |
|
if {[regexp {[A-Z]} $pkg]} { |
|
#only apply catch & retry if there was a cap - otherwise we'll double try for errors unrelated to capitalisation |
|
if {[catch {$COMMANDSTACKNEXT {*}[string tolower $args]} v]} { |
|
return [$COMMANDSTACKNEXT {*}$args] |
|
} else { |
|
return $v |
|
} |
|
} else { |
|
return [$COMMANDSTACKNEXT {*}$args] |
|
} |
|
} |
|
default { |
|
return [$COMMANDSTACKNEXT {*}$args] |
|
} |
|
} |
|
|
|
}] |
|
if {[dict get $stackrecord implementation] ne ""} { |
|
set impl [dict get $stackrecord implementation] ;#use hardcoded name rather than slower (but more flexible) commandstack::get_next_command |
|
puts stdout "punk::packagepreference renamed ::package to $impl" |
|
} else { |
|
puts stderr "punk::packagepreference failed to rename ::package" |
|
} |
|
#puts stdout [info body ::package] |
|
} |
|
|
|
#proc sample1 {p1 n args} { |
|
# #*** !doctools |
|
# #[call [fun sample1] [arg p1] [arg n] [opt {option value...}]] |
|
# #[para]Description of sample1 |
|
# #[para] Arguments: |
|
# # [list_begin arguments] |
|
# # [arg_def tring p1] A description of string argument p1. |
|
# # [arg_def integer n] A description of integer argument n. |
|
# # [list_end] |
|
# return "ok" |
|
#} |
|
|
|
|
|
|
|
#*** !doctools |
|
#[list_end] [comment {--- end definitions namespace punk::packagepreference ---}] |
|
} |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
# Secondary API namespace |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
tcl::namespace::eval punk::packagepreference::lib { |
|
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase |
|
tcl::namespace::path [tcl::namespace::parent] |
|
#*** !doctools |
|
#[subsection {Namespace punk::packagepreference::lib}] |
|
#[para] Secondary functions that are part of the API |
|
#[list_begin definitions] |
|
|
|
#proc utility1 {p1 args} { |
|
# #*** !doctools |
|
# #[call lib::[fun utility1] [arg p1] [opt {?option value...?}]] |
|
# #[para]Description of utility1 |
|
# return 1 |
|
#} |
|
|
|
|
|
|
|
#*** !doctools |
|
#[list_end] [comment {--- end definitions namespace punk::packagepreference::lib ---}] |
|
} |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
|
|
|
|
|
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
#*** !doctools |
|
#[section Internal] |
|
#tcl::namespace::eval punk::packagepreference::system { |
|
#*** !doctools |
|
#[subsection {Namespace punk::packagepreference::system}] |
|
#[para] Internal functions that are not part of the API |
|
|
|
|
|
|
|
#} |
|
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ |
|
## Ready |
|
package provide punk::packagepreference [tcl::namespace::eval punk::packagepreference { |
|
variable pkg punk::packagepreference |
|
variable version |
|
set version 0.1.0 |
|
}] |
|
return |
|
|
|
#*** !doctools |
|
#[manpage_end] |
|
|
|
|