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.
 
 
 
 
 
 

359 lines
11 KiB

# -*- tcl -*-
# Maintenance Instruction: leave the 999999.xxx.x as is and use punkshell 'dev make' or bin/punkmake to update from <pkg>-buildversion.txt
# module template: punkshell/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 poshinfo 999999.0a1.0
# Meta platform tcl
# Meta license <unspecified>
# @@ Meta End
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# doctools header
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[manpage_begin punkshell_module_poshinfo 0 999999.0a1.0]
#[copyright "2024"]
#[titledesc {poshinfo prompt theme tool}] [comment {-- Name section and table of contents description --}]
#[moddesc {POSH-related prompt tool}] [comment {-- Description at end of page heading --}]
#[require poshinfo]
#[keywords module terminal console theme prompt {prompt theme} POSH]
#[description]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Overview]
#[para] overview of poshinfo
#[subsection Concepts]
#[para] -
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Requirements
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[subsection dependencies]
#[para] packages used by poshinfo
#[list_begin itemized]
package require Tcl 8.6-
package require punk::config
package require json ;#tcllib
#toml, yaml?
package require punk::args
#*** !doctools
#[item] [package {Tcl 8.6}]
#[item] [package {punk::config}]
#[item] [package {json}]
# #package require frobz
# #*** !doctools
# #[item] [package {frobz}]
#*** !doctools
#[list_end]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section API]
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# oo::class namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#tcl::namespace::eval poshinfo::class {
#*** !doctools
#[subsection {Namespace poshinfo::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 poshinfo {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
#variable xyz
#*** !doctools
#[subsection {Namespace poshinfo}]
#[para] Core API functions for poshinfo
#[list_begin definitions]
proc info_from_filename {fname} {
#string based filename processing: we are deliberately avoiding test of file existence etc here
if {$fname eq ""} {
error "poshinfo::info_from_filename unable to determine name from empty string"
}
if {[string first . $fname] < 0} {
#theoretically we could have a file without dots - but it's more likely an error in this context
error "poshinfo::info_from_filename supplied value '$fname' doesn't look like a filename. Cowardly refusing to guess a shortname."
}
set ftail [file tail $fname]
set rootname [file rootname $ftail]
set extension [string trimleft [file extension $ftail] .]
if {$extension eq "yml"} {
set format "yaml"
} else {
set format $extension
}
set parts [split $rootname .]
if {[lindex $parts end] eq "omp"} {
set type omp
set shortname [join [lrange $parts 0 end-1] .]
} else {
if {$rootname eq "schema"} {
set type schema
} else {
#review - we can't tell diff betw <themename_with_dots>.<format> and <themename>.<unknowntype>.<format>
set type unknown
}
set shortname $rootname
}
return [dict create shortname $shortname format $format extension $extension type $type]
}
#restrict glob to filename in filename.<type>.<format>
proc Themes_dict {{globlist *}} {
set running_config [punk::config::get running-config]
set posh_themes_path [tcl::dict::get $running_config posh_themes_path]
#posh_themes_path_extra ??
set themes_dict [tcl::dict::create]
if {[string length $posh_themes_path]} {
if {[file exists $posh_themes_path]} {
set files [glob -nocomplain -directory $posh_themes_path -tails -- {*}$globlist]
foreach ftail $files {
set themeinfo [info_from_filename $ftail]
set shortname [dict get $themeinfo shortname]
set name_matched 0
foreach glob $globlist {
if {[string match -nocase $glob $shortname]} {
set name_matched 1
break
}
}
if {$name_matched} {
dict set themeinfo path [file join $posh_themes_path $ftail]
if {![dict exists $themes_dict $shortname]} {
dict set themes_dict $shortname [list $themeinfo]
} else {
dict lappend themes_dict $shortname $themeinfo
}
}
}
}
}
return $themes_dict
}
proc get_active_theme {} {
lassign [punk::config::get running posh_theme] _ themepath
set theme_info [info_from_filename $themepath]
dict set theme_info path $themepath
}
proc set_active_theme_by_name {name} {
error "unimplemented"
}
proc set_active_theme_by_path {path} {
error "unimplemented"
}
punk::args::define {
@id -id ::poshinfo::themes
@cmd -name poshinfo::themes
-format -default all -multiple 1 -choices {all yaml json}\
-help "File format of posh theme - based on file extension"
-type -default all -multiple 1\
-help "e.g omp"
-as -default "table" -choices {list showlist dict showdict table tableobject plaintext}\
-help "return type of result"
@values -min 0
globs -multiple 1 -default * -help ""
}
proc themes {args} {
set argd [punk::args::get_by_id ::poshinfo::themes $args]
set return_as [dict get $argd opts -as]
set formats [dict get $argd opts -format] ;#multiple
if {"yaml" in $formats} {
lappend formats "yml" ;#unpreferred extension for yaml - but accepted
}
set types [dict get $argd opts -type] ;#multiple
set globlist [dict get $argd values globs]
set themes_dict [Themes_dict $globlist]
set restricted_themes_dict [dict create]
dict for {shortname themeinfolist} $themes_dict {
set themeinfo [lindex $themeinfolist 0]
if {("all" in $formats || [dict get $themeinfo format] in $formats) && ("all" in $types || [dict get $themeinfo type] in $types)} {
dict set restricted_themes_dict $shortname $themeinfolist
}
}
unset themes_dict
switch -- $return_as {
dict {
return $restricted_themes_dict
}
showdict {
return [showdict $restricted_themes_dict */@*/@*.@*]
}
list {
return [dict keys $restricted_themes_dict]
}
showlist {
return [showlist [dict keys $restricted_themes_dict]]
}
}
set posh_theme [file normalize [punk::config::get_running_global posh_theme]]
set t [textblock::class::table new "Posh Themes"]
$t configure -show_header 1 -show_hseps 0
$t add_column -headers Shortname
$t add_column -headers Path
dict for {shortname themeinfolist} $restricted_themes_dict {
#hack - support just one for now
set themeinfo [lindex $themeinfolist 0]
set path [dict get $themeinfo path]
$t add_row [list $shortname $path]
set fg ""
set bg ""
switch -- [dict get $themeinfo type] {
schema {
set fg black
set bg Web-orange
}
omp {}
unknown {
set bg Web-red
}
default {
#we shouldn't be getting other values
set bg Web-yellow
}
}
if {$posh_theme eq [file normalize $path]} {
set fg web-limegreen
}
if {"$fg$bg" ne ""} {
$t configure_row [expr {[$t row_count]-1}] -ansibase [a+ {*}$fg {*}$bg]
}
}
switch -- $return_as {
plaintext {
$t configure -frametype {}
set tabletext [$t print]
set pt [punk::ansi::ansistrip $tabletext]
return [join [lines_as_list -line trimline $pt] \n]
}
table {
set tabletext [$t print]
$t destroy
return $tabletext
}
tableobject {
return $t
}
}
}
#*** !doctools
#[list_end] [comment {--- end definitions namespace poshinfo ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# Secondary API namespace
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
tcl::namespace::eval poshinfo::lib {
tcl::namespace::export {[a-z]*} ;# Convention: export all lowercase
tcl::namespace::path [tcl::namespace::parent]
#*** !doctools
#[subsection {Namespace poshinfo::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 poshinfo::lib ---}]
}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
#*** !doctools
#[section Internal]
#tcl::namespace::eval poshinfo::system {
#*** !doctools
#[subsection {Namespace poshinfo::system}]
#[para] Internal functions that are not part of the API
#}
# ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
## Ready
package provide poshinfo [tcl::namespace::eval poshinfo {
variable pkg poshinfo
variable version
set version 999999.0a1.0
}]
return
#*** !doctools
#[manpage_end]