# -*- tcl -*- # Maintenance Instruction: leave the 999999.xxx.x as is and use 'deck 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. # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # (C) 2023 # # @@ Meta Begin # Application punk::mix::commandset::project 0.1.0 # Meta platform tcl # Meta license # @@ Meta End # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ # doctools header # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[manpage_begin punkshell_module_punk::mix::commandset::project 0 0.1.0] #[copyright "2023"] #[titledesc {dec commandset - project}] [comment {-- Name section and table of contents description --}] #[moddesc {deck CLI commandset - project}] [comment {-- Description at end of page heading --}] #[require punk::mix::commandset::project] #[description] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section Overview] #[para] overview of punk::mix::commandset::project #[para]Import into an ensemble namespace similarly to the way it is done with punk::mix::cli e.g #[example { # namespace eval myproject::cli { # namespace export * # namespace ensemble create # package require punk::overlay # # package require punk::mix::commandset::project # punk::overlay::import_commandset project . ::punk::mix::commandset::project # punk::overlay::import_commandset projects . ::punk::mix::commandset::project::collection # } #}] #[para] Where the . in the above example is the prefix/command separator #[para]The prefix ('project' in the above example) can be any string desired to disambiguate commands imported from other commandsets. #[para]The above results in the availability of the ensemble command: ::myproject::cli project.new, which is implemented in ::punk::mix::commandset::project::new #[para]Similarly, procs under ::punk::mix::commandset::project::collection will be available as subcommands of the ensemble as projects. #[para] #[subsection Concepts] #[para] see punk::overlay # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Requirements # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[subsection dependencies] #[para] packages used by punk::mix::commandset::project #[list_begin itemized] package require Tcl 8.6- #*** !doctools #[item] [package {Tcl 8.6-}] #[item] [package punk::ns] #[item] [package sqlite3] (binary) #[item] [package overtype] #[item] [package textutil] (tcllib) # #package require frobz # #*** !doctools # #[item] [package {frobz}] #*** !doctools #[list_end] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ #*** !doctools #[section API] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ namespace eval punk::mix::commandset::project { namespace export * #*** !doctools #[subsection {Namespace punk::mix::commandset::project}] #[para] core commandset functions for punk::mix::commandset::project #[list_begin definitions] proc _default {} { package require punk::ns set dispatched_to [lindex [info level 2] 0] ;#e.g ::punk::mix::cli::project set dispatch_tail [punk::ns::nstail $dispatched_to] set dispatch_ensemble [punk::ns::nsprefix $dispatched_to] ;#e.g ::punk::mix::cli set sibling_commands [namespace eval $dispatch_ensemble {namespace export}] #todo - get separator? set sep "." set result [list] foreach sib $sibling_commands { if {[string match ${dispatch_tail}${sep}* $sib]} { lappend result $sib } } return [lsort $result] } proc new {newprojectpath_or_name args} { #*** !doctools # [call [fun new] [arg newprojectpath_or_name] [opt args]] #new project structure - may be dedicated to one module, or contain many. #create minimal folder structure only by specifying in args: -modules {} if {[file pathtype $newprojectpath_or_name] eq "absolute"} { set projectfullpath [file normalize $newprojectpath_or_name] set projectname [file tail $projectfullpath] set projectparentdir [file dirname $newprojectpath_or_name] } else { set projectfullpath [file join [pwd] $newprojectpath_or_name] set projectname [file tail $projectfullpath] set projectparentdir [file dirname $projectfullpath] } if {[file type $projectparentdir] ne "directory"} { error "punk::mix::cli::new error: unable to determine containing folder for '$newprojectpath_or_name'" } punk::mix::cli::lib::validate_projectname $projectname -errorprefix "punk mix project.new" set defaults [list\ -type plain\ -empty 0\ -force 0\ -update 0\ -confirm 1\ -modules \uFFFF\ -layout punk.project ] ;#todo set known_opts [dict keys $defaults] foreach {k v} $args { if {$k ni $known_opts} { error "project.new error: option '$k' not known. Known options: $known_opts" } } set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- --- set opt_type [dict get $opts -type] if {$opt_type ni [punk::mix::cli::lib::module_types]} { error "deck new error - unknown type '$opt_type' known types: [punk::mix::cli::lib::module_types]" } # -- --- --- --- --- --- --- --- --- --- --- --- --- set opt_force [dict get $opts -force] set opt_confirm [string tolower [dict get $opts -confirm]] # -- --- --- --- --- --- --- --- --- --- --- --- --- set opt_modules [dict get $opts -modules] if {[llength $opt_modules] == 1 && [lindex $opt_modules 0] eq "\uFFFF"} { #if not specified - add a single module matching project name if {$opt_force || $opt_update} { #generally undesirable to add default project module during an update. #user can use dev module.new manually or supply module name in -modules set opt_modules [list] } else { set opt_modules [list [string tolower $projectname]] ;#default modules to lowercase as is the modern (tip 590) recommendation for Tcl } } # -- --- --- --- --- --- --- --- --- --- --- --- --- set opt_layout [dict get $opts -layout] set opt_update [dict get $opts -update] # -- --- --- --- --- --- --- --- --- --- --- --- --- #todo - install support binaries on a per-project basis in a way that doesn't impact machine (e.g not added to path) - cache in user config dir if possible, supply mechanism to clear cache # set fossil_prog [auto_execok fossil] if {![string length $fossil_prog]} { puts stderr "The fossil program was not found. A fossil executable is required to use most deck features." if {[string length [set scoop_prog [auto_execok scoop]]]} { #restrict to windows? set answer [util::askuser "scoop detected. Would you like deck to install fossil now using scoop? Y|N"] if {[string tolower $answer] ne "y"} { puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -confirm 0 to avoid prompts." return } #we don't assume 'unknown' is configured to run shell commands if {[string length [package provide shellrun]]} { set exitinfo [run {*}$scoop_prog install fossil] #scoop tends to return successful exitcode (0) even when packages not found etc. - so exitinfo not much use. puts stdout "scoop install fossil ran with result: $exitinfo" } else { puts stdout "Please wait while scoop runs - there may be a slight delay and then scoop output will be shown. (use punk shellrun package for )" set result [exec {*}$scoop_prog install fossil] puts stdout $result } catch {::auto_reset} ;#can be missing (unsure under what circumstances - but I've seen it raise error 'invalid command name "auto_reset"') if {![string length [auto_execok fossil]]} { puts stderr "Fossil still not detected. If it was successfully installed, try restarting your punk/tcl shell." return } #todo - ask user if they want to configure fosssil first.. set answer [util::askuser "Fossil command now appears to be available. You may wish to answer N to exit and customize it - but default config may be ok. Type the word 'continue' to proceed with default configuration."] if {[string tolower $answer] ne "continue"} { return } } else { puts stdout "See: https://fossil-scm.org/home/uv/download.html" if {"windows" eq $::tcl_platform(platform)} { puts stdout "Consider using a package manager such as scoop: https://scoop.sh" puts stdout "(Then: scoop install fossil)" } return } } set startdir [pwd] if {[set in_project [punk::repo::find_project $startdir]] ne ""} { # use this project as source of templates puts stdout "-------------------------------------------" puts stdout "Currently in a project directory '$in_project'" puts stdout "This project will be searched for templates" puts stdout "-------------------------------------------" } package require punk::cap if {[punk::cap::capability_has_handler punk.templates]} { set layout_dict [punk::cap::call_handler punk.templates get_itemdict_projectlayouts] } else { put stderr "commandset::project::new WARNING - no handler available for the 'punk.templates' capability - template providers will be unable to provide layout locations" return } if {[dict exists $layout_dict $opt_layout]} { set layout_name $opt_layout set layout_info [dict get $layout_dict $layout_name] set layout_path [dict get $layout_info path] set layout_sourceinfo [dict get $layout_info sourceinfo] } else { puts stderr "commandset::project::new - no exact match for specified layout-name $opt_layout found" puts stderr "layout names found: [dict keys $layout_dict]" return #todo - pick highest version layout that matches opt_layout if version not specified but multiple exist #set layout_name ... #set layout_info .. #set layout_path ... } #todo - detect whether inside cwd-project or inside a different project set projectdir $projectparentdir/$projectname if {[set target_in_project [punk::repo::find_project $projectparentdir]] ne ""} { puts stderr "Target location for new project is already within a project: $target_in_project" error "Nested projects not yet supported aborting" } if {[punk::repo::is_git $projectparentdir]} { puts stderr "mix new WARNING: target project location is within a git repo based at [punk::repo::find_git $projectparentdir]" puts stderr "The new project will create a fossil repository (which you are free to ignore - but but will be used to confirm project base)" puts stderr "If you intend to use both git and fossil in the same project space - you should research and understand the details and any possible interactions/issues" set answer [util::askuser "Do you want to proceed to create a project based at: $projectdir? Y|N"] if {[string tolower $answer] ne "y"} { puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -confirm 0 to avoid prompts." return } } set is_nested_fossil 0 ;#default assumption if {[punk::repo::is_fossil $projectparentdir]} { puts stderr "mix new WARNING: target project location is within an open fossil repo based at [punk::repo::find_fossil $projectparentdir] NESTED fossil repository" if {$opt_confirm ni [list 0 no false]} { puts stderr "If you proceed - the new project's fossil repo will be created using the --nested flag" set answer [util::askuser "Do you want to proceed to create a NESTED project based at: $projectdir? Y|N"] if {[string tolower $answer] ne "y"} { puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -confirm 0 to avoid prompts." return } set is_nested_fossil 1 } } set project_dir_exists [file exists $projectdir] if {$project_dir_exists && !($opt_force || $opt_update)} { puts stderr "Unable to create new project at $projectdir - file/folder already exists use -update 1 to fill in missing items from template use -force 1 to overwrite from template" return } elseif {$project_dir_exists && $opt_force} { puts stderr "mix new WARNING: -force 1 was supplied. Will copy layout $layout_path using -force option to overwrite from template" if {$opt_confirm ni [list 0 no false]} { set answer [util::askuser "Do you want to proceed to possibly overwrite existing files in $projectdir? Y|N"] if {[string tolower $answer] ne "y"} { puts stderr "mix new aborting due to user response '$answer' (required Y|y to proceed) use -confirm 0 to avoid prompts." return } } } elseif {$project_dir_exists && $opt_update} { puts stderr "mix new WARNING: -update 1 was supplied. Will copy layout $layout_path using -update option to add missing items" } set fossil_repo_file "" set is_fossil_root 0 if {$project_dir_exists && [punk::repo::is_fossil_root $projectdir]} { set is_fossil_root 1 set fossil_repo_file [punk::repo::fossil_get_repository_file $projectdir] if {$fossil_repo_file ne ""} { set repodb_folder [file dirname $fossil_repo_file] } } if {$fossil_repo_file eq ""} { set repodb_folder [punk::repo::fossil_get_repository_folder_for_project $projectname -parentfolder $startdir] if {![string length $repodb_folder]} { puts stderr "No usable repository database folder selected for $projectname.fossil file" return } } if {[file exists $repodb_folder/$projectname.fossil]} { puts stdout "NOTICE: $repodb_folder/$projectname.fossil already exists" if {!($opt_force || $opt_update)} { puts stderr "-force 1 or -update 1 not specified - aborting" return } #review set fossil_repo_file $repodb_folder/$projectname.fossil } if {$fossil_repo_file eq ""} { puts stdout "Initialising fossil repo: $repodb_folder/$projectname.fossil" set fossilinit [runx -n {*}$fossil_prog init $repodb_folder/$projectname.fossil -project-name $projectname] if {[dict get $fossilinit exitcode] != 0} { puts stderr "fossil init failed:" puts stderr [dict get $fossilinit stderr] return } else { puts stdout "fossil init result:" puts stdout [dict get $fossilinit stdout] } } # file mkdir $projectdir puts stdout ">>> about to call punkcheck::install $layout_path $projectdir" set resultdict [dict create] set antipaths [list\ src/doc/*\ src/doc/include/*\ src/PROJECT_LAYOUTS_*\ ] #set antiglob_dir [list\ # _ignore_*\ #] set antiglob_dir [list\ ] #default antiglob_dir_core will stop .fossil* from being updated - which is generally desirable as these are likely to be customized if {$opt_force} { puts stdout "copying layout files - with force applied - overwrite all-targets" set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite ALL-TARGETS -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } else { puts stdout "copying layout files - (if source file changed)" set resultdict [punkcheck::install $layout_path $projectdir -installer project.new -overwrite installedsourcechanged-targets -antiglob_paths $antipaths -antiglob_dir $antiglob_dir] } puts stdout [punkcheck::summarize_install_resultdict $resultdict] puts stdout "copying layout src/doc files (if target missing)" set resultdict [punkcheck::install $layout_path/src/doc $projectdir/src/doc -punkcheck_folder $projectdir -installer project.new -overwrite SYNCED-TARGETS] puts stdout [punkcheck::summarize_install_resultdict $resultdict] #target folders .fossil-custom and .fossil-settings may not exist. use -createdir 1 to ensure existence. #In this case we need to override the default dir antiglob - as .fossil-xxx folders need to be installed from template if missing, or if target is uncustomized. ## default_antiglob_dir_core [list "#*" "_aside" ".git" ".fossil*"] set override_antiglob_dir_core [list #* _aside .git] puts stdout "copying layout src/.fossil-custom files (if target missing or uncustomised)" set resultdict [punkcheck::install $layout_path/.fossil-custom $projectdir/.fossil-custom -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] puts stdout [punkcheck::summarize_install_resultdict $resultdict] puts stdout "copying layout src/.fossil-settings files (if target missing or uncustomised)" set resultdict [punkcheck::install $layout_path/.fossil-settings $projectdir/.fossil-settings -createdir 1 -punkcheck_folder $projectdir -installer project.new -antiglob_dir_core $override_antiglob_dir_core -overwrite SYNCED-TARGETS] puts stdout [punkcheck::summarize_install_resultdict $resultdict] #scan all files in template # #TODO - deck command to substitute templates? set templatefiles [punk::mix::commandset::layout::lib::layout_scan_for_template_files $opt_layout] set stripprefix [file normalize $layout_path] set tagmap [list [lib::template_tag project] $projectname] if {[llength $templatefiles]} { puts stdout "Filling template file placeholders with the following tag map:" foreach {placeholder value} $tagmap { puts stdout " $placeholder -> $value" } } foreach templatefullpath $templatefiles { set templatetail [punk::repo::path_strip_alreadynormalized_prefixdepth $templatefullpath $stripprefix] set fpath [file join $projectdir $templatetail] if {[file exists $fpath]} { set fd [open $fpath r]; fconfigure $fd -translation binary; set data [read $fd]; close $fd set data2 [string map $tagmap $data] if {$data2 ne $data} { puts stdout "updated template file: $fpath" set fdout [open $fpath w]; fconfigure $fdout -translation binary; puts -nonewline $fdout $data2; close $fdout } } else { puts stderr "warning: Missing template file $fpath" } } #todo - tag substitutions in src/doc tree ::cd $projectdir if {[file exists $projectdir/src/modules]} { foreach m $opt_modules { #check if mod-ver.tm file or #modpod-mod-ver folder exist set tmfile $projectdir/src/modules/$m-[punk::mix::util::magic_tm_version].tm set podfile $projectdir/src/modules/#modpod-$m-[punk::mix::util::magic_tm_version]/$m-[punk::mix::util::magic_tm_version].tm set has_tm [file exists $tmfile] set has_pod [file exists $podfile] #puts stderr "=====> has_tm: $has_tm has_pod: $has_pod" if {!$has_tm && !$has_pod} { #todo - option for -module_template - and check existence at top? or change opt_modules to be a list of dicts with configuration info -template -type etc punk::mix::commandset::module::new -project $projectname -type $opt_type $m } else { #we should rarely if ever want to force any src/modules to be overwritten if {$opt_force} { if {$has_pod} { set answer [util::askuser "OVERWRITE the src/modules file $podfile ?? (generally not desirable) Y|N"] set overwrite_type zip } else { set answer [util::askuser "OVERWRITE the src/modules file $tmfile ?? (generally not desirable) Y|N"] set overwrite_type $opt_type } if {[string tolower $answer] eq "y"} { #REVIEW - all pods zip - for now punk::mix::commandset::module::new -project $projectname -type $overwrite_type -force 1 $m } } } } } else { puts stderr "project.new WARNING template hasn't created src/modules - skipping creation of new module(s) for project" } #generate www/man/md output in 'embedded' folder which should be checked into repo for online documentation if {[file exists $projectdir/src]} { ::cd $projectdir/src #---------- set installer [punkcheck::installtrack new project.new $projectdir/src/.punkcheck] $installer set_source_target $projectdir/src/doc $projectdir/src/embedded set event [$installer start_event {-install_step kettledoc}] $event targetset_init VIRTUAL kettle_build_doc ;#VIRTUAL - since there is no specific target file - and we don't know all the files that will be generated $event targetset_addsource $projectdir/src/doc ;#whole doc tree is considered the source #---------- if {\ [llength [dict get [$event targetset_source_changes] changed]]\ } { $event targetset_started # -- --- --- --- --- --- puts stdout "BUILDING DOCS at src/embedded from src/doc" if {[catch { punk::mix::cli::lib::kettle_call lib doc #Kettle doc } errM]} { $event targetset_end FAILED -note "kettle_build_doc failed: $errM" } else { $event targetset_end OK } # -- --- --- --- --- --- } else { puts stderr "No change detected in src/doc" $event targetset_end SKIPPED } $event end $event destroy $installer destroy } ::cd $projectdir if {![punk::repo::is_fossil_root $projectdir]} { set first_fossil 1 #-k = keep. (only modify the manifest file(s)) if {$is_nested_fossil} { set fossilopen [runx -n {*}$fossil_prog open --nested $repodb_folder/$projectname.fossil -k --workdir $projectdir] } else { set fossilopen [runx -n {*}$fossil_prog open $repodb_folder/$projectname.fossil -k --workdir $projectdir] } if {[file exists $projectdir/_FOSSIL_] && ![file exists $projectdir/.fslckout]} { file rename $projectdir/_FOSSIL_ $projectdir/.fslckout } if {[dict get $fossilopen exitcode] != 0} { puts stderr "fossil open in project workdir '$projectdir' FAILED:" puts stderr [dict get $fossilopen stderr] return } else { puts stdout "fossil open in project workdir '$projectdir' OK:" puts stdout [dict get $fossilopen stdout] } } else { set first_fossil 0 } set fossiladd [runx -n {*}$fossil_prog add --dotfiles $projectdir] if {[dict get $fossiladd exitcode] != 0} { puts stderr "fossil add workfiles in workdir '$projectdir' FAILED:" puts stderr [dict get $fossiladd stderr] return } else { puts stdout "fossil add workfiles in workdir '$projectdir' OK:" puts stdout [dict get $fossiladd stdout] } if {$first_fossil} { #fossil commit may prompt user for input.. runx runout etc will pause with no prompts util::do_in_path $projectdir { set fossilcommit [run -n {*}$fossil_prog commit -m "initial project commit"] } if {[dict get $fossilcommit exitcode] != 0} { puts stderr "fossil commit in workdir '$projectdir' FAILED" return } else { puts stdout "fossil commit in workdir '$projectdir' OK" } } puts stdout "-done- project:$projectname projectdir: $projectdir" } #*** !doctools #[list_end] [comment {--- end definitions namespace punk::mix::commandset::project ---}] namespace eval collection { #*** !doctools #[subsection {Namespace punk::mix::commandset::project::collection}] #[para] commandset functions for operating with multiple projects. #[para] It would usually be imported with the prefix "projects" and separator "." to result in commands such as: projects.detail #[list_begin definitions] namespace export * namespace path [namespace parent] #e.g imported as 'projects' proc _default {{glob {}} args} { #*** !doctools #[call [fun _default] [arg glob] [opt {option value...}]] #[para]List projects under fossil management, showing fossil db location and number of checkouts #[para]The glob argument is optional unless option/value pairs are also supplied, in which case * should be explicitly supplied #[para]glob restricts output based on the name of the fossil db file e.g s* for all projects beginning with s #[para]The _default function is made available in the ensemble by the name of the prefix used when importing the commandset. #[para]e.g #[para] punk::overlay::import_commandset projects . ::punk::mix::commandset::project::collection #[para]Will result in the command being available as projects package require overtype set db_projects [lib::get_projects $glob] set col1items [lsearch -all -inline -index 0 -subindices $db_projects *] set col2items [lsearch -all -inline -index 1 -subindices $db_projects *] set checkouts [lsearch -all -inline -index 2 -subindices $db_projects *] set col3items [lmap v $checkouts {llength $v}] set title1 "Fossil Repo DB" set widest1 [tcl::mathfunc::max {*}[lmap v [concat [list $title1] $col1items] {punk::strlen $v}]] set col1 [string repeat " " $widest1] set title2 "File Name" set widest2 [tcl::mathfunc::max {*}[lmap v [concat [list $title2] $col2items] {punk::strlen $v}]] set col2 [string repeat " " $widest2] set title3 "Checkouts" set widest3 [tcl::mathfunc::max {*}[lmap v [concat [list $title3] $col3items] {string length $v}]] set col3 [string repeat " " $widest3] set tablewidth [expr {$widest1 + 1 + $widest2 + 1 + $widest3}] append msg "[overtype::left $col1 $title1] [overtype::left $col2 $title2] [overtype::left $col3 $title3]" \n append msg [string repeat "=" $tablewidth] \n foreach p $col1items n $col2items c $col3items { append msg "[overtype::left $col1 $p] [overtype::left $col2 $n] [overtype::right $col3 $c]" \n } return $msg #return [list_as_lines [lib::get_projects $glob]] } proc detail {{glob {}} args} { package require overtype package require textutil set defaults [dict create\ -description 0\ ] set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- set opt_description [dict get $opts -description] # -- --- --- --- --- --- --- set db_projects [lib::get_projects $glob] set col1_dbfiles [lsearch -all -inline -index 0 -subindices $db_projects *] set col2items [lsearch -all -inline -index 1 -subindices $db_projects *] set checkouts [lsearch -all -inline -index 2 -subindices $db_projects *] set col3items [lmap v $checkouts {llength $v}] set col4_pnames [list] set col5_pcodes [list] set col6_dupids [list] set col7_pdescs [list] set codes [dict create] set file_idx 0 foreach dbfile $col1_dbfiles { set project_name "" set project_code "" set project_desc "" set db_error "" if {[file exists $dbfile]} { if {[catch { sqlite3 dbp $dbfile dbp eval {select name,value from config where name like 'project-%';} r { if {$r(name) eq "project-name"} { set project_name $r(value) } elseif {$r(name) eq "project-code"} { set project_code $r(value) } elseif {$r(name) eq "project-description"} { set project_desc $r(value) } } } errM]} { set db_error $errM } catch {dbp close} } else { set db_error "fossil file $dbfile missing" } lappend col4_pnames $project_name lappend col5_pcodes $project_code dict lappend codes $project_code $dbfile lappend col7_pdescs $project_desc if {$db_error ne ""} { lset col1_dbfiles $file_idx "[a+ web-red]$dbfile[a]" } incr file_idx } set setid 1 set codeset [dict create] dict for {code dbs} $codes { if {[llength $dbs]>1} { dict set codeset $code setid $setid dict set codeset $code count [llength $dbs] dict set codeset $code seen 0 incr setid } } set dupid 1 foreach pc $col5_pcodes { if {[dict exists $codeset $pc]} { set seen [dict get $codeset $pc seen] set this_seen [expr {$seen + 1}] dict set codeset $pc seen $this_seen lappend col6_dupids "[dict get $codeset $pc setid].${this_seen}/[dict get $codeset $pc count]" } else { lappend col6_dupids "" } } set title1 "Fossil Repo DB" set widest1 [tcl::mathfunc::max {*}[lmap v [concat [list $title1] $col1_dbfiles] {punk::strlen $v}]] set col1 [string repeat " " $widest1] set title2 "File Name" set widest2 [tcl::mathfunc::max {*}[lmap v [concat [list $title2] $col2items] {punk::strlen $v}]] set col2 [string repeat " " $widest2] set title3 "Checkouts" set widest3 [tcl::mathfunc::max {*}[lmap v [concat [list $title3] $col3items] {string length $v}]] set col3 [string repeat " " $widest3] set title4 "Project Name" set widest4 [tcl::mathfunc::max {*}[lmap v [concat [list $title4] $col4_pnames] {string length $v}]] set col4 [string repeat " " $widest4] set title5 "Project Code" set widest5 [tcl::mathfunc::max {*}[lmap v [concat [list $title5] $col5_pcodes] {string length $v}]] set col5 [string repeat " " $widest5] set title6 "Dup" set widest6 [tcl::mathfunc::max {*}[lmap v [concat [list $title6] $col6_dupids] {string length $v}]] set col6 [string repeat " " $widest6] set title7 "Description" #set widest7 [tcl::mathfunc::max {*}[lmap v [concat [list $title4] $col7_pdescs] {string length $v}]] set widest7 35 set col7 [string repeat " " $widest7] set tablewidth [expr {$widest1 + 1 + $widest2 + 1 + $widest3 +1 + $widest4 + 1 + $widest5 + 1 + $widest6}] append msg "[overtype::left $col1 $title1] [overtype::left $col2 $title2] [overtype::left $col3 $title3]\ [overtype::left $col4 $title4] [overtype::left $col5 $title5] [overtype::left $col6 $title6]" if {!$opt_description} { append msg \n } else { append msg "[overtype::left $col7 $title7]" \n set tablewidth [expr {$tablewidth + 1 + $widest7}] } append msg [string repeat "=" $tablewidth] \n foreach p $col1_dbfiles n $col2items c $col3items pn $col4_pnames pc $col5_pcodes dup $col6_dupids desc $col7_pdescs { set desclines [split [textutil::adjust $desc -length $widest7] \n] set desc1 [lindex $desclines 0] append msg "[overtype::left $col1 $p] [overtype::left $col2 $n] [overtype::right $col3 $c]\ [overtype::left $col4 $pn] [overtype::left $col5 $pc] [overtype::left $col6 $dup]" if {!$opt_description} { append msg \n } else { append msg " [overtype::left $col7 $desc1]" \n foreach dline [lrange $desclines 1 end] { append msg "$col1 $col2 $col3 $col4 $col5 $col6 [overtype::left $col7 $dline]" \n } } } return $msg #return [list_as_lines [lib::get_projects $glob]] } proc cd {{glob {}} args} { dict set args -cd 1 work $glob {*}$args } proc work {{glob {}} args} { package require sqlite3 set db_projects [lib::get_projects $glob] if {[llength $db_projects] == 0} { puts stderr "::punk::mix::commandset::project::work No Repo DB name matches found for '$glob'" return "" } #list of lists of the form: #{fosdb fname workdirlist} set defaults [dict create\ -cd 0\ -detail "\uFFFF"\ ] set opts [dict merge $defaults $args] # -- --- --- --- --- --- --- set opt_cd [dict get $opts -cd] # -- --- --- --- --- --- --- set opt_detail [dict get $opts -detail] set opt_detail_explicit_zero 1 ;#default assumption only if {$opt_detail eq "\uFFFF"} { set opt_detail_explicit_zero 0 set opt_detail 0; #default } # -- --- --- --- --- --- --- set workdir_dict [dict create] set all_workdirs [list] foreach pinfo $db_projects { lassign $pinfo fosdb name workdirs foreach wdir $workdirs { dict set workdir_dict $wdir $pinfo lappend all_workdirs $wdir } } set col_rowids [list] set workdirs [lsort -index 0 $all_workdirs] set col_dupids [list] set col_fnames [list] set col_pnames [list] set col_pcodes [list] set col_dupids [list] set fosdb_count [dict create] set fosdb_dupset [dict create] set fosdb_cache [dict create] set dupset 0 set rowid 1 foreach wd $workdirs { set wdinfo [dict get $workdir_dict $wd] lassign $wdinfo fosdb nm siblingworkdirs dict incr fosdb_count $fosdb set dbcount [dict get $fosdb_count $fosdb] if {[llength $siblingworkdirs] > 1} { if {![dict exists $fosdb_dupset $fosdb]} { #first time this multi-checkout fosdb seen dict set fosdb_dupset $fosdb [incr dupset] } set dupid "[dict get $fosdb_dupset $fosdb].$dbcount/[llength $siblingworkdirs]" } else { set dupid "" } if {$dbcount == 1} { set pname "" set pcode "" if {[file exists $fosdb]} { if {[catch { sqlite3 fdb $fosdb set pname [lindex [fdb eval {select value from config where name = 'project-name'}] 0] set pcode [lindex [fdb eval {select value from config where name = 'project-code'}] 0] fdb close dict set fosdb_cache $fosdb [list name $pname code $pcode] } errM]} { puts stderr "!!! problem with fossil db: $fosdb when examining workdir $wd" puts stderr "!!! error: $errM" } } else { puts stderr "!!! missing fossil db $fosdb" } } else { set info [dict get $fosdb_cache $fosdb] lassign $info _name pname _code pcode } lappend col_rowids $rowid lappend col_fnames $nm lappend col_dupids $dupid lappend col_pnames $pname lappend col_pcodes [string range $pcode 0 9] incr rowid } set col_states [list] set state_title "" #if only one set of fossil checkouts in the resultset and opt_detail is 0 and not explicit - retrieve workingdir state for each co if {([llength [dict keys $fosdb_cache]] == 1)} { if {!$opt_detail_explicit_zero} { set opt_detail 1 } puts stderr "Result is from a single repo db [dict keys $fosdb_cache]" } if {$opt_detail} { if {!$opt_detail_explicit_zero} { set detailmsg "Use -detail 0 to omit file state" } else { set detailmsg "" } puts stderr "Gathering file state for [llength $workdirs] checkout folder(s). $detailmsg" set c_rev [list] set c_rev_iso [list] set c_unchanged [list] set c_changed [list] set c_new [list] set c_missing [list] set c_extra [list] foreach wd $workdirs { set wd_state [punk::repo::workingdir_state $wd] set state_dict [punk::repo::workingdir_state_summary_dict $wd_state] lappend c_rev [string range [dict get $state_dict revision] 0 9] lappend c_rev_iso [dict get $state_dict revision_iso8601] lappend c_unchanged [dict get $state_dict unchanged] lappend c_changed [dict get $state_dict changed] lappend c_new [dict get $state_dict new] lappend c_missing [dict get $state_dict missing] lappend c_extra [dict get $state_dict extra] puts -nonewline stderr "." } puts -nonewline stderr \n set t0 "Revision" set w0 [tcl::mathfunc::max {*}[lmap v [concat [list $t0] $c_rev] {string length $v}]] set c0 [string repeat " " $w0] set t0b "Revision iso8601" set w0b [tcl::mathfunc::max {*}[lmap v [concat [list $t0] $c_rev_iso] {string length $v}]] set c0b [string repeat " " $w0b] set t1 "Unch" set w1 [tcl::mathfunc::max {*}[lmap v [concat [list $t1] $c_unchanged] {string length $v}]] set c1 [string repeat " " $w1] set t2 "Chgd" set w2 [tcl::mathfunc::max {*}[lmap v [concat [list $t2] $c_changed] {string length $v}]] set c2 [string repeat " " $w2] set t3 "New" set w3 [tcl::mathfunc::max {*}[lmap v [concat [list $t3] $c_new] {string length $v}]] set c3 [string repeat " " $w3] set t4 "Miss" set w4 [tcl::mathfunc::max {*}[lmap v [concat [list $t4] $c_missing] {string length $v}]] set c4 [string repeat " " $w4] set t5 "Extr" set w5 [tcl::mathfunc::max {*}[lmap v [concat [list $t5] $c_extra] {string length $v}]] set c5 [string repeat " " $w5] set state_title "[overtype::left $c0 $t0] [overtype::left $c0b $t0b] [overtype::right $c1 $t1] [overtype::right $c2 $t2] [overtype::right $c3 $t3] [overtype::right $c4 $t4] [overtype::right $c5 $t5]" foreach r $c_rev iso $c_rev_iso u $c_unchanged c $c_changed n $c_new m $c_missing e $c_extra { lappend col_states "[overtype::left $c0 $r] [overtype::left $c0b $iso] [overtype::right $c1 $u] [overtype::right $c2 $c] [overtype::right $c3 $n] [overtype::right $c4 $m] [overtype::right $c5 $e]" } } set msg "" if {$opt_cd} { set title0 "CD" } else { set title0 "" } set widest0 [tcl::mathfunc::max {*}[lmap v [concat [list $title0] $col_rowids] {punk::strlen $v}]] set col0 [string repeat " " $widest0] set title1 "Checkout dir" set widest1 [tcl::mathfunc::max {*}[lmap v [concat [list $title1] $workdirs] {punk::strlen $v}]] set col1 [string repeat " " $widest1] set title2 "Repo DB name" set widest2 [tcl::mathfunc::max {*}[lmap v [concat [list $title2] $col_fnames] {string length $v}]] set col2 [string repeat " " $widest2] set title3 "CO dup" set widest3 [tcl::mathfunc::max {*}[lmap v [concat [list $title3] $col_dupids] {string length $v}]] set col3 [string repeat " " $widest3] set title4 "Project Name" set widest4 [tcl::mathfunc::max {*}[lmap v [concat [list $title4] $col_pnames] {string length $v}]] set col4 [string repeat " " $widest4] set title5 "Project Code" set widest5 [tcl::mathfunc::max {*}[lmap v [concat [list $title5] $col_pcodes] {string length $v}]] set col5 [string repeat " " $widest5] set tablewidth [expr {$widest0 + 1 + $widest1 + 1 + $widest2 + 1 + $widest3 +1 + $widest4 + 1 + $widest5}] append msg "[overtype::right $col0 $title0] [overtype::left $col1 $title1] [overtype::left $col2 $title2] [overtype::left $col3 $title3] [overtype::left $col4 $title4] [overtype::left $col5 $title5]" if {[llength $col_states]} { set title6 $state_title set widest6 [tcl::mathfunc::max {*}[lmap v [concat [list $title6] $col_states] {string length $v}]] set col6 [string repeat " " $widest6] incr tablewidth [expr {$widest6 + 1}] append msg " [overtype::left $col6 $title6]" \n } else { append msg \n } append msg [string repeat "=" $tablewidth] \n if {[llength $col_states]} { foreach row $col_rowids wd $workdirs db $col_fnames dup $col_dupids pname $col_pnames pcode $col_pcodes s $col_states { if {![file exists $wd]} { set row [punk::ansi::a+ strike red]$row[a] set wd [punk::ansi::a+ red]$wd[a] } append msg "[overtype::right $col0 $row] [overtype::left $col1 $wd] [overtype::left $col2 $db] [overtype::right $col3 $dup] [overtype::left $col4 $pname] [overtype::left $col5 $pcode] [overtype::left $col6 $s]" \n } } else { foreach row $col_rowids wd $workdirs db $col_fnames dup $col_dupids pname $col_pnames pcode $col_pcodes { if {![file exists $wd]} { set row [punk::ansi::a+ strike red]$row[a] set wd [punk::ansi::a+ red]$wd[a] } append msg "[overtype::right $col0 $row] [overtype::left $col1 $wd] [overtype::left $col2 $db] [overtype::right $col3 $dup] [overtype::left $col4 $pname] [overtype::left $col5 $pcode]" \n } } set numrows [llength $col_rowids] if {$opt_cd && $numrows >= 1} { puts stdout $msg if {$numrows == 1} { set workingdir [lindex $workdirs 0] puts stdout "1 result. Changing dir to $workingdir" if {[file exists $workingdir]} { ::cd $workingdir return $workingdir } else { puts stderr "path $workingdir doesn't appear to exist" return [pwd] } } else { set answer [util::askuser "Change directory to working folder - select a number from 1 to [llength $col_rowids] or any other key to cancel."] if {[string trim $answer] in $col_rowids} { set index [expr {$answer - 1}] set workingdir [lindex $workdirs $index] ::cd $workingdir puts stdout [deck stat] return $workingdir } } } return $msg } #*** !doctools #[list_end] [comment {-- end collection namespace definitions --}] } namespace eval lib { proc template_tag {tagname} { #todo - support different tagwrappers - it shouldn't be so likely to collide with common code idioms etc. #we need to detect presence of tags intended for punk::mix system #consider using punk::cap to enable multiple template-substitution providers with their own set of tagnames and/or tag wrappers, where substitution providers are all run return [string cat % $tagname %] } #get project info only by opening the central confg-db #(will not have proper project-name etc) proc get_projects {{globlist {}} args} { if {![llength $globlist]} { set globlist [list *] } set fossil_prog [auto_execok fossil] set configdb [punk::repo::fossil_get_configdb] package require sqlite3 ::sqlite3 fosconf $configdb #set testresult [fosconf eval {select name,value from global_config;}] #puts stderr $testresult set project_repos [fosconf eval {select name from global_config where name like 'repo:%';}] set paths_and_names [list] foreach pr $project_repos { set path [string trim [string range $pr 5 end]] set nm [file rootname [file tail $path]] set ckouts [fosconf eval {select name from global_config where value = $path;}] set checkout_paths [list] #strip "ckout:" foreach ck $ckouts { lappend checkout_paths [string trim [string range $ck 6 end]] } lappend paths_and_names [list $path $nm $checkout_paths] } set filtered_list [list] foreach glob $globlist { set matches [lsearch -all -inline -index 1 $paths_and_names $glob] foreach m $matches { if {$m ni $filtered_list} { lappend filtered_list $m } } } set projects [lsort -index 1 $filtered_list] return $projects } } } #*** !doctools #[manpage_end] # ++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ ## Ready package provide punk::mix::commandset::project [namespace eval punk::mix::commandset::project { variable version set version 0.1.0 }] return