# -*- tcl -*- # Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from -buildversion.txt # module template: punkshell/src/decktemplates/vendor/punk/modules/template_module-0.0.2.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::aliascore 0.1.0 # Meta platform tcl # Meta license # @@ Meta End # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[manpage_begin punkshell_module_punk::aliascore 0 0.1.0] #[copyright "2024"] #[titledesc {punkshell command aliases}] [comment {-- Name section and table of contents description --}] #[moddesc {-}] [comment {-- Description at end of page heading --}] #[require punk::aliascore] #[keywords module alias] #[description] #[para] - # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Overview] #[para] overview of punk::aliascore #[subsection Concepts] #[para] - # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[subsection dependencies] #[para] packages used by punk::aliascore #[list_begin itemized] package require Tcl 8.6- #*** !doctools #[item] [package {Tcl 8.6}] # #package require frobz # #*** !doctools # #[item] [package {frobz}] #*** !doctools #[list_end] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section API] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # oo::class namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #tcl::namespace::eval punk::aliascore::class { # #*** !doctools # #[subsection {Namespace punk::aliascore::class}] # #[para] class definitions # if {[info commands [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::aliascore { tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase variable aliases #use absolute ns ie must be prefixed with :: #single element commands are imported if source command already exists, otherwise aliased. multi element commands are aliased #functions should generally be covered by one of the export patterns of their source namespace # - if they are not - e.g (separately loaded ensemble command ?) # the aliascore::init will temporarily extend the exports list to do the import, and then reset the exports to how they were. set aliases [tcl::dict::create\ val ::punk::pipe::val\ tstr ::punk::args::lib::tstr\ list_as_lines ::punk::lib::list_as_lines\ lines_as_list ::punk::lib::lines_as_list\ linelist ::punk::lib::linelist\ linesort ::punk::lib::linesort\ pdict ::punk::lib::pdict\ plist {::punk::lib::pdict -roottype list}\ showlist {::punk::lib::showdict -roottype list}\ rehash ::punk::auto_exec::rehash\ hash ::punk::auto_exec::hash\ showdict ::punk::lib::showdict\ ansistrip ::punk::ansi::ansistrip\ stripansi ::punk::ansi::ansistrip\ ansiwrap ::punk::ansi::ansiwrap\ grepstr ::punk::ansi::grepstr\ colour ::punk::console::colour\ color ::punk::console::colour\ ansi8 ::punk::ansi8\ clear ::punk::clear\ c {::punk::clear -xs}\ cc {::punk::clear -x}\ ansi ::punk::console::ansi\ a? ::punk::console::code_a?\ A? {::punk::console::code_a? forcecolor}\ a+ ::punk::console::code_a+\ A+ {::punk::console::code_a+ forcecolour}\ a ::punk::console::code_a\ A {::punk::console::code_a forcecolour}\ smcup ::punk::console::enable_alt_screen\ rmcup ::punk::console::disable_alt_screen\ config ::punk::config\ s ::punk::ns::synopsis\ eg ::punk::ns::eg\ aliases ::punk::ns::aliases\ alias ::punk::ns::alias\ use ::punk::ns::pkguse\ ] #*** !doctools #[subsection {Namespace punk::aliascore}] #[para] Core API functions for punk::aliascore #[list_begin definitions] #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" #} proc _is_exported {ns cmd} { set exports [::tcl::namespace::eval $ns [list namespace export]] set is_exported 0 foreach p $exports { if {[string match $p $cmd]} { set is_exported 1 break } } return $is_exported } #_nsprefix accepts entire command - not just an existing namespace for which we want the parent proc _nsprefix {{nspath {}}} { #maintenance: from punk::ns::nsprefix - (without unnecessary nstail) #normalize the common case of :::: set nspath [string map {:::: ::} $nspath] set rawprefix [string range $nspath 0 end-[string length [namespace tail $nspath]]] if {$rawprefix eq "::"} { return $rawprefix } else { if {[string match *:: $rawprefix]} { return [string range $rawprefix 0 end-2] } else { return $rawprefix } } } #todo - options as to whether we should raise an error if collisions found, undo aliases etc? proc init {args} { set defaults {-force 0} set opts [dict merge $defaults $args] set opt_force [dict get $opts -force] #we never override existing aliases to ::repl::interp* even if -force = 1 #(these are our safebase aliases) set ignore_pattern "::repl::interp*" set ignore_aliases [list] variable aliases set existing [list] set conflicts [list] foreach {a cmd} $aliases { if {[tcl::info::commands ::$a] ne ""} { lappend existing $a set existing_alias [interp alias "" $a] if {$existing_alias ne ""} { set existing_target $existing_alias if {[string match $ignore_pattern $existing_target]} { #don't consider it a conflict - will use ignore_aliases to exclude it below lappend ignore_aliases $a continue } } else { if {[catch {tcl::namespace::origin $a} existing_command]} { set existing_command "" } set existing_target $existing_command } if {$existing_target ne $cmd} { #command exists in global ns but doesn't match our defined aliases/imports lappend conflicts $a } } } if {!$opt_force && [llength $conflicts]} { error "punk::aliascore::init declined to create any aliases or imports because conflicts found. Use -force == 1 conflicts:\n [join $conflicts "\n "]" } set failed [list] set tempns ::temp_[info cmdcount] ;#temp ns for renames dict for {a cmd} $aliases { #puts "aliascore $a -> $cmd" if {$a in $ignore_aliases} { continue } if {[llength $cmd] > 1} { interp alias {} $a {} {*}$cmd } else { if {[tcl::info::commands $cmd] ne ""} { #todo - ensure exported? noclobber? set container_ns [_nsprefix $cmd] set cmdtail [tcl::namespace::tail $cmd] set was_exported 1 ;#assumption if {![_is_exported $container_ns $cmdtail]} { set was_exported 0 set existing_exports [tcl::namespace::eval $container_ns [list ::namespace export]] tcl::namespace::eval $container_ns [list ::namespace export $cmdtail] } if {[tcl::namespace::tail $a] eq $cmdtail} { #puts stderr "importing $cmd" try { tcl::namespace::eval :: [list ::namespace import $cmd] } trap {} {emsg eopts} { lappend failed [list alias $a target $cmd errormsg $emsg] } } else { #target command name differs from exported name #e.g stripansi -> punk::ansi::ansistrip #import and rename #puts stderr "importing $cmd (with rename to ::$a)" try { tcl::namespace::eval $tempns [list ::namespace import $cmd] } trap {} {emsg eopst} { lappend failed [list alias $a target $cmd errormsg $emsg] } catch {rename ${tempns}::$cmdtail ::$a} } #restore original exports if {!$was_exported} { tcl::namespace::eval $container_ns [list ::namespace export -clear {*}$existing_exports] } } else { interp alias {} $a {} {*}$cmd } } } #tcl::namespace::delete $tempns return [dict create aliases [dict keys $aliases] existing $existing ignored $ignore_aliases changed $conflicts failed $failed] } #*** !doctools #[list_end] [comment {--- end definitions namespace punk::aliascore ---}] } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #interp alias {} list_as_lines {} punk::lib::list_as_lines #interp alias {} lines_as_list {} punk::lib::lines_as_list #interp alias {} ansistrip {} punk::ansi::ansistrip ;#review #interp alias {} linelist {} punk::lib::linelist ;#critical for = assignment features #interp alias {} linesort {} punk::lib::linesort # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # Secondary API namespace # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::aliascore::lib { namespace export {[a-z]*} ;# Convention: export all lowercase namespace path [namespace parent] #*** !doctools #[subsection {Namespace punk::aliascore::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::aliascore::lib ---}] } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Internal] namespace eval punk::aliascore::system { #*** !doctools #[subsection {Namespace punk::aliascore::system}] #[para] Internal functions that are not part of the API } # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::aliascore [namespace eval punk::aliascore { variable pkg punk::aliascore variable version set version 0.1.0 }] return #*** !doctools #[manpage_end]